1package ProFTPD::Tests::Modules::mod_sftp;
2
3use lib qw(t/lib);
4use base qw(ProFTPD::TestSuite::Child);
5use strict;
6
7use Cwd;
8use Digest::MD5;
9use File::Copy;
10use File::Path qw(mkpath rmtree);
11use File::Spec;
12use IO::Handle;
13use IPC::Open3;
14use POSIX qw(:fcntl_h);
15use Socket;
16
17use ProFTPD::TestSuite::FTP;
18use ProFTPD::TestSuite::Utils qw(:auth :config :features :running :test :testsuite);
19
20$| = 1;
21
22my $order = 0;
23
24my $TESTS = {
25  ssh2_connect_bad_version_bad_format => {
26    order => ++$order,
27    test_class => [qw(bug forking ssh2)],
28  },
29
30  ssh2_connect_bad_version_unsupported_proto_version => {
31    order => ++$order,
32    test_class => [qw(bug forking ssh2)],
33  },
34
35  ssh2_connect_bad_version_too_long => {
36    order => ++$order,
37    test_class => [qw(bug forking ssh2)],
38  },
39
40  ssh2_connect_bad_version_too_short => {
41    order => ++$order,
42    test_class => [qw(bug forking ssh2)],
43  },
44
45  ssh2_connect_version_with_comments => {
46    order => ++$order,
47    test_class => [qw(bug forking ssh2)],
48  },
49
50  ssh2_connect_version_bug3918 => {
51    order => ++$order,
52    test_class => [qw(bug forking ssh2)],
53  },
54
55  ssh2_connect_timeout_login => {
56    order => ++$order,
57    test_class => [qw(forking ssh2)],
58  },
59
60  ssh2_kex_dh_group1_sha1 => {
61    order => ++$order,
62    test_class => [qw(forking ssh2)],
63  },
64
65  ssh2_kex_dh_group14_sha1 => {
66    order => ++$order,
67    test_class => [qw(forking ssh2)],
68  },
69
70  ssh2_kex_dh_gex_sha1 => {
71    order => ++$order,
72    test_class => [qw(forking ssh2)],
73  },
74
75  ssh2_ext_kex_ecdh_sha2_nistp256 => {
76    order => ++$order,
77    test_class => [qw(forking ssh2)],
78  },
79
80  ssh2_ext_kex_ecdh_sha2_nistp384 => {
81    order => ++$order,
82    test_class => [qw(forking ssh2)],
83  },
84
85  ssh2_ext_kex_ecdh_sha2_nistp521 => {
86    order => ++$order,
87    test_class => [qw(forking ssh2)],
88  },
89
90  ssh2_hostkey_rsa => {
91    order => ++$order,
92    test_class => [qw(forking ssh2)],
93  },
94
95  ssh2_hostkey_rsa_only => {
96    order => ++$order,
97    test_class => [qw(forking ssh2)],
98  },
99
100  ssh2_ext_hostkey_rsa_sha256 => {
101    order => ++$order,
102    test_class => [qw(forking ssh2)],
103  },
104
105  ssh2_ext_hostkey_rsa_sha512 => {
106    order => ++$order,
107    test_class => [qw(forking ssh2)],
108  },
109
110  ssh2_hostkey_dss => {
111    order => ++$order,
112    test_class => [qw(forking ssh2)],
113  },
114
115  ssh2_hostkey_dss_only => {
116    order => ++$order,
117    test_class => [qw(forking ssh2)],
118  },
119
120  ssh2_hostkey_dss_bug3634 => {
121    order => ++$order,
122    test_class => [qw(bug forking slow ssh2)],
123  },
124
125  ssh2_hostkey_passphraseprovider_bug3851 => {
126    order => ++$order,
127    test_class => [qw(bug forking ssh2)],
128  },
129
130  ssh2_ext_hostkey_ecdsa256 => {
131    order => ++$order,
132    test_class => [qw(forking ssh2)],
133  },
134
135  ssh2_ext_hostkey_ecdsa384 => {
136    order => ++$order,
137    test_class => [qw(forking ssh2)],
138  },
139
140  ssh2_ext_hostkey_ecdsa521 => {
141    order => ++$order,
142    test_class => [qw(forking ssh2)],
143  },
144
145  ssh2_ext_hostkey_openssh_rsa_issue793 => {
146    order => ++$order,
147    test_class => [qw(forking ssh2)],
148  },
149
150  ssh2_ext_hostkey_openssh_rsa_passphraseprovider_issue793 => {
151    order => ++$order,
152    test_class => [qw(forking ssh2)],
153  },
154
155  ssh2_ext_hostkey_openssh_dsa_issue793 => {
156    order => ++$order,
157    test_class => [qw(forking ssh2)],
158  },
159
160  ssh2_ext_hostkey_openssh_ecdsa_issue793 => {
161    order => ++$order,
162    test_class => [qw(forking ssh2)],
163  },
164
165  ssh2_ext_hostkey_openssh_ed25519_bug4221 => {
166    order => ++$order,
167    test_class => [qw(feature_sodium forking ssh2)],
168  },
169
170  ssh2_ext_hostkey_openssh_ed25519_passphraseprovider_bug4221 => {
171    order => ++$order,
172    test_class => [qw(feature_sodium forking ssh2)],
173  },
174
175  ssh2_ext_hostkey_openssh_ed25519_cbc_passphraseprovider_bug4221 => {
176    order => ++$order,
177    test_class => [qw(feature_sodium forking ssh2)],
178  },
179
180  ssh2_cipher_c2s_aes256_cbc => {
181    order => ++$order,
182    test_class => [qw(forking ssh2)],
183  },
184
185  ssh2_cipher_c2s_aes192_cbc => {
186    order => ++$order,
187    test_class => [qw(forking ssh2)],
188  },
189
190  ssh2_cipher_c2s_aes128_cbc => {
191    order => ++$order,
192    test_class => [qw(forking ssh2)],
193  },
194
195  ssh2_cipher_c2s_blowfish_cbc => {
196    order => ++$order,
197    test_class => [qw(forking ssh2)],
198  },
199
200  ssh2_cipher_c2s_arcfour => {
201    order => ++$order,
202    test_class => [qw(forking ssh2)],
203  },
204
205  ssh2_cipher_c2s_cast128_cbc => {
206    order => ++$order,
207    test_class => [qw(forking ssh2)],
208  },
209
210  ssh2_cipher_c2s_3des_cbc => {
211    order => ++$order,
212    test_class => [qw(forking ssh2)],
213  },
214
215  ssh2_cipher_c2s_none => {
216    order => ++$order,
217    test_class => [qw(forking ssh2)],
218  },
219
220  ssh2_cipher_s2c_aes256_cbc => {
221    order => ++$order,
222    test_class => [qw(forking ssh2)],
223  },
224
225  ssh2_cipher_s2c_aes192_cbc => {
226    order => ++$order,
227    test_class => [qw(forking ssh2)],
228  },
229
230  ssh2_cipher_s2c_aes128_cbc => {
231    order => ++$order,
232    test_class => [qw(forking ssh2)],
233  },
234
235  ssh2_cipher_s2c_blowfish_cbc => {
236    order => ++$order,
237    test_class => [qw(forking ssh2)],
238  },
239
240  ssh2_cipher_s2c_arcfour => {
241    order => ++$order,
242    test_class => [qw(forking ssh2)],
243  },
244
245  ssh2_cipher_s2c_cast128_cbc => {
246    order => ++$order,
247    test_class => [qw(forking ssh2)],
248  },
249
250  ssh2_cipher_s2c_3des_cbc => {
251    order => ++$order,
252    test_class => [qw(forking ssh2)],
253  },
254
255  ssh2_cipher_s2c_none => {
256    order => ++$order,
257    test_class => [qw(forking ssh2)],
258  },
259
260  ssh2_mac_c2s_hmac_sha1 => {
261    order => ++$order,
262    test_class => [qw(forking ssh2)],
263  },
264
265  ssh2_mac_c2s_hmac_sha1_96 => {
266    order => ++$order,
267    test_class => [qw(forking ssh2)],
268  },
269
270  ssh2_mac_c2s_hmac_md5 => {
271    order => ++$order,
272    test_class => [qw(forking ssh2)],
273  },
274
275  ssh2_mac_c2s_hmac_md5_96 => {
276    order => ++$order,
277    test_class => [qw(forking ssh2)],
278  },
279
280  ssh2_mac_c2s_hmac_ripemd160 => {
281    order => ++$order,
282    test_class => [qw(forking ssh2)],
283  },
284
285  ssh2_mac_c2s_none => {
286    order => ++$order,
287    test_class => [qw(forking ssh2)],
288  },
289
290  ssh2_mac_s2c_hmac_sha1 => {
291    order => ++$order,
292    test_class => [qw(forking ssh2)],
293  },
294
295  ssh2_mac_s2c_hmac_sha1_96 => {
296    order => ++$order,
297    test_class => [qw(forking ssh2)],
298  },
299
300  ssh2_mac_s2c_hmac_md5 => {
301    order => ++$order,
302    test_class => [qw(forking ssh2)],
303  },
304
305  ssh2_mac_s2c_hmac_md5_96 => {
306    order => ++$order,
307    test_class => [qw(forking ssh2)],
308  },
309
310  ssh2_mac_s2c_hmac_ripemd160 => {
311    order => ++$order,
312    test_class => [qw(forking ssh2)],
313  },
314
315  ssh2_mac_s2c_none => {
316    order => ++$order,
317    test_class => [qw(forking ssh2)],
318  },
319
320  ssh2_ext_mac_umac64_openssh => {
321    order => ++$order,
322    test_class => [qw(bug forking ssh2)],
323  },
324
325  ssh2_compress_c2s_none => {
326    order => ++$order,
327    test_class => [qw(forking ssh2)],
328  },
329
330  ssh2_compress_c2s_zlib => {
331    order => ++$order,
332    test_class => [qw(forking ssh2)],
333  },
334
335  ssh2_compress_s2c_none => {
336    order => ++$order,
337    test_class => [qw(forking ssh2)],
338  },
339
340  # XXX Currently disabled due to buggy handling of compression in libssh2.
341  ssh2_compress_s2c_zlib => {
342    order => ++$order,
343    test_class => [qw(forking ssh2 inprogress)],
344  },
345
346  # XXX Need more auth method tests: keyboard-interactive
347  # (the password method is used in other tests, so is covered).
348
349  ssh2_auth_hostbased => {
350    order => ++$order,
351    test_class => [qw(forking ssh2)],
352  },
353
354  ssh2_auth_publickey_rsa_no_match_bug3493 => {
355    order => ++$order,
356    test_class => [qw(bug forking ssh2)],
357  },
358
359  ssh2_auth_publickey_rsa_with_match_bug3493 => {
360    order => ++$order,
361    test_class => [qw(bug forking ssh2)],
362  },
363
364  ssh2_auth_publickey_rsa2048 => {
365    order => ++$order,
366    test_class => [qw(forking ssh2)],
367  },
368
369  ssh2_auth_publickey_rsa2048_min_4096_bug4233 => {
370    order => ++$order,
371    test_class => [qw(bug forking ssh2)],
372  },
373
374  ssh2_auth_publickey_rsa2048_no_nl => {
375    order => ++$order,
376    test_class => [qw(bug forking ssh2)],
377  },
378
379  ssh2_auth_publickey_rsa2048_2nd_key => {
380    order => ++$order,
381    test_class => [qw(forking ssh2)],
382  },
383
384  ssh2_auth_publickey_rsa4096 => {
385    order => ++$order,
386    test_class => [qw(forking ssh2)],
387  },
388
389  ssh2_auth_publickey_rsa8192 => {
390    order => ++$order,
391    test_class => [qw(forking ssh2)],
392  },
393
394  ssh2_auth_publickey_rsa16384 => {
395    order => ++$order,
396    test_class => [qw(forking ssh2)],
397  },
398
399  ssh2_ext_auth_publickey_rsa_sha256 => {
400    order => ++$order,
401    test_class => [qw(forking ssh2)],
402  },
403
404  ssh2_ext_auth_publickey_rsa_sha512 => {
405    order => ++$order,
406    test_class => [qw(forking ssh2)],
407  },
408
409  ssh2_auth_publickey_dsa1024 => {
410    order => ++$order,
411    test_class => [qw(forking ssh2)],
412  },
413
414  ssh2_auth_publickey_dsa2048 => {
415    order => ++$order,
416    test_class => [qw(forking ssh2)],
417  },
418
419  ssh2_auth_publickey_dsa4096 => {
420    order => ++$order,
421    test_class => [qw(forking ssh2)],
422  },
423
424  ssh2_auth_publickey_dsa8192 => {
425    order => ++$order,
426    test_class => [qw(forking ssh2)],
427  },
428
429  ssh2_auth_publickey_user_var_bug3315 => {
430    order => ++$order,
431    test_class => [qw(bug forking ssh2)],
432  },
433
434  ssh2_ext_auth_publickey_ecdsa256 => {
435    order => ++$order,
436    test_class => [qw(forking ssh2)],
437  },
438
439  ssh2_ext_auth_publickey_ecdsa384 => {
440    order => ++$order,
441    test_class => [qw(forking ssh2)],
442  },
443
444  ssh2_ext_auth_publickey_ecdsa521 => {
445    order => ++$order,
446    test_class => [qw(forking ssh2)],
447  },
448
449  ssh2_ext_auth_publickey_openssh_rsa_bug4221 => {
450    order => ++$order,
451    test_class => [qw(forking ssh2)],
452  },
453
454  ssh2_ext_auth_publickey_openssh_ed25519_bug4221 => {
455    order => ++$order,
456    test_class => [qw(forking ssh2)],
457  },
458
459  # This fails because of a bug in Net::SSH2; I've filed a bug report
460  # with fix for it:
461  #
462  #  http://rt.cpan.org/Ticket/Display.html?id=49584
463  #
464  ssh2_auth_no_authorized_keys => {
465    order => ++$order,
466    test_class => [qw(forking ssh2)],
467  },
468
469  ssh2_auth_password_failed => {
470    order => ++$order,
471    test_class => [qw(bug forking ssh2)],
472  },
473
474  ssh2_auth_kbdint_failed_password_ok => {
475    order => ++$order,
476    test_class => [qw(bug forking mod_sftp_pam ssh2)],
477  },
478
479  ssh2_auth_twice => {
480    order => ++$order,
481    test_class => [qw(forking ssh2)],
482  },
483
484  ssh2_auth_publickey_password_chain_bug4153 => {
485    order => ++$order,
486    test_class => [qw(bug forking ssh2)],
487  },
488
489  ssh2_auth_publickey_publickey_chain_bug4153 => {
490    order => ++$order,
491    test_class => [qw(bug forking ssh2)],
492  },
493
494  ssh2_interop_scanner => {
495    order => ++$order,
496    test_class => [qw(forking ssh2)],
497  },
498
499  ssh2_interop_probe => {
500    order => ++$order,
501    test_class => [qw(forking ssh2)],
502  },
503
504  ssh2_channel_failed_ptyreq => {
505    order => ++$order,
506    test_class => [qw(forking ssh2)],
507  },
508
509  ssh2_channel_failed_shell => {
510    order => ++$order,
511    test_class => [qw(forking ssh2)],
512  },
513
514  ssh2_channel_failed_exec_cmd => {
515    order => ++$order,
516    test_class => [qw(forking ssh2)],
517  },
518
519  ssh2_channel_env_default => {
520    order => ++$order,
521    test_class => [qw(forking ssh2)],
522  },
523
524  ssh2_channel_env_accept_glob_char => {
525    order => ++$order,
526    test_class => [qw(forking ssh2)],
527  },
528
529  ssh2_channel_env_accept_single_char => {
530    order => ++$order,
531    test_class => [qw(forking ssh2)],
532  },
533
534  ssh2_channel_max_exceeded => {
535    order => ++$order,
536    test_class => [qw(forking ssh2)],
537  },
538
539  ssh2_disconnect_client => {
540    order => ++$order,
541    test_class => [qw(forking ssh2)],
542  },
543
544  sftp_without_auth => {
545    order => ++$order,
546    test_class => [qw(forking sftp ssh2)],
547  },
548
549  sftp_stat => {
550    order => ++$order,
551    test_class => [qw(forking sftp ssh2)],
552  },
553
554  sftp_stat_abs_symlink => {
555    order => ++$order,
556    test_class => [qw(forking sftp ssh2)],
557  },
558
559  sftp_stat_abs_symlink_chrooted_bug4219 => {
560    order => ++$order,
561    test_class => [qw(bug forking rootprivs sftp ssh2)],
562  },
563
564  sftp_stat_abs_symlink_enoent => {
565    order => ++$order,
566    test_class => [qw(forking sftp ssh2)],
567  },
568
569  sftp_stat_abs_symlink_enoent_chrooted_bug4219 => {
570    order => ++$order,
571    test_class => [qw(bug forking rootprivs sftp ssh2)],
572  },
573
574  sftp_stat_rel_symlink => {
575    order => ++$order,
576    test_class => [qw(forking sftp ssh2)],
577  },
578
579  sftp_stat_rel_symlink_chrooted_bug4219 => {
580    order => ++$order,
581    test_class => [qw(bug forking rootprivs sftp ssh2)],
582  },
583
584  sftp_stat_rel_symlink_enoent => {
585    order => ++$order,
586    test_class => [qw(forking sftp ssh2)],
587  },
588
589  sftp_stat_rel_symlink_enoent_chrooted_bug4219 => {
590    order => ++$order,
591    test_class => [qw(bug forking rootprivs sftp ssh2)],
592  },
593
594  sftp_fstat => {
595    order => ++$order,
596    test_class => [qw(forking sftp ssh2)],
597  },
598
599  sftp_lstat => {
600    order => ++$order,
601    test_class => [qw(forking sftp ssh2)],
602  },
603
604  sftp_setstat => {
605    order => ++$order,
606    test_class => [qw(forking sftp ssh2)],
607  },
608
609  sftp_setstat_sgid => {
610    order => ++$order,
611    test_class => [qw(forking sftp ssh2)],
612  },
613
614  sftp_setstat_abs_symlink => {
615    order => ++$order,
616    test_class => [qw(forking sftp ssh2)],
617  },
618
619  sftp_setstat_abs_symlink_chrooted_bug4219 => {
620    order => ++$order,
621    test_class => [qw(bug forking rootprivs sftp ssh2)],
622  },
623
624  sftp_setstat_abs_symlink_enoent => {
625    order => ++$order,
626    test_class => [qw(forking sftp ssh2)],
627  },
628
629  sftp_setstat_abs_symlink_enoent_chrooted_bug4219 => {
630    order => ++$order,
631    test_class => [qw(bug forking rootprivs sftp ssh2)],
632  },
633
634  sftp_setstat_rel_symlink => {
635    order => ++$order,
636    test_class => [qw(forking sftp ssh2)],
637  },
638
639  sftp_setstat_rel_symlink_chrooted_bug4219 => {
640    order => ++$order,
641    test_class => [qw(bug forking rootprivs sftp ssh2)],
642  },
643
644  sftp_setstat_rel_symlink_enoent => {
645    order => ++$order,
646    test_class => [qw(forking sftp ssh2)],
647  },
648
649  sftp_setstat_rel_symlink_enoent_chrooted_bug4219 => {
650    order => ++$order,
651    test_class => [qw(bug forking rootprivs sftp ssh2)],
652  },
653
654  sftp_fsetstat => {
655    order => ++$order,
656    test_class => [qw(forking sftp ssh2)],
657  },
658
659  sftp_realpath => {
660    order => ++$order,
661    test_class => [qw(forking sftp ssh2)],
662  },
663
664  sftp_realpath_file => {
665    order => ++$order,
666    test_class => [qw(forking sftp ssh2)],
667  },
668
669  sftp_realpath_symlink_file => {
670    order => ++$order,
671    test_class => [qw(forking sftp ssh2)],
672  },
673
674  sftp_realpath_symlink_file_chrooted => {
675    order => ++$order,
676    test_class => [qw(forking rootprivs sftp ssh2)],
677  },
678
679  sftp_realpath_dir => {
680    order => ++$order,
681    test_class => [qw(forking sftp ssh2)],
682  },
683
684  sftp_realpath_symlink_dir => {
685    order => ++$order,
686    test_class => [qw(forking sftp ssh2)],
687  },
688
689  sftp_realpath_symlink_dir_chrooted => {
690    order => ++$order,
691    test_class => [qw(forking rootprivs sftp ssh2)],
692  },
693
694  sftp_open_enoent_bug3345 => {
695    order => ++$order,
696    test_class => [qw(bug forking sftp ssh2)],
697  },
698
699  sftp_open_trunc_bug3449 => {
700    order => ++$order,
701    test_class => [qw(bug forking sftp ssh2)],
702  },
703
704  sftp_open_creat => {
705    order => ++$order,
706    test_class => [qw(forking sftp ssh2)],
707  },
708
709  sftp_open_creat_excl => {
710    order => ++$order,
711    test_class => [qw(forking sftp ssh2)],
712  },
713
714  sftp_open_append_bug3450 => {
715    order => ++$order,
716    test_class => [qw(bug forking sftp ssh2)],
717  },
718
719  sftp_open_rdonly => {
720    order => ++$order,
721    test_class => [qw(forking sftp ssh2)],
722  },
723
724  sftp_open_wronly => {
725    order => ++$order,
726    test_class => [qw(forking sftp ssh2)],
727  },
728
729  sftp_open_rdwr => {
730    order => ++$order,
731    test_class => [qw(forking sftp ssh2)],
732  },
733
734  sftp_open_abs_symlink => {
735    order => ++$order,
736    test_class => [qw(forking sftp ssh2)],
737  },
738
739  sftp_open_abs_symlink_chrooted_bug4219 => {
740    order => ++$order,
741    test_class => [qw(bug forking rootprivs sftp ssh2)],
742  },
743
744  sftp_open_abs_symlink_enoent => {
745    order => ++$order,
746    test_class => [qw(forking sftp ssh2)],
747  },
748
749  sftp_open_abs_symlink_enoent_chrooted_bug4219 => {
750    order => ++$order,
751    test_class => [qw(bug forking rootprivs sftp ssh2)],
752  },
753
754  sftp_open_rel_symlink => {
755    order => ++$order,
756    test_class => [qw(forking sftp ssh2)],
757  },
758
759  sftp_open_rel_symlink_chrooted_bug4219 => {
760    order => ++$order,
761    test_class => [qw(bug forking rootprivs sftp ssh2)],
762  },
763
764  sftp_open_rel_symlink_enoent => {
765    order => ++$order,
766    test_class => [qw(forking sftp ssh2)],
767  },
768
769  sftp_open_rel_symlink_enoent_chrooted_bug4219 => {
770    order => ++$order,
771    test_class => [qw(bug forking rootprivs sftp ssh2)],
772  },
773
774  sftp_upload => {
775    order => ++$order,
776    test_class => [qw(forking sftp ssh2)],
777  },
778
779  # Requires libssh2-1.2.8 or later, with fixed compression
780  sftp_upload_with_compression => {
781    order => ++$order,
782    test_class => [qw(forking inprogress sftp ssh2)],
783  },
784
785  sftp_upload_zero_len_file => {
786    order => ++$order,
787    test_class => [qw(forking sftp ssh2)],
788  },
789
790  sftp_upload_largefile => {
791    order => ++$order,
792    test_class => [qw(forking sftp ssh2)],
793  },
794
795  sftp_upload_device_full => {
796    order => ++$order,
797    test_class => [qw(forking os_linux sftp ssh2)],
798  },
799
800  sftp_upload_fifo_bug3312 => {
801    order => ++$order,
802    test_class => [qw(forking sftp ssh2)],
803  },
804
805  sftp_upload_fifo_bug3313 => {
806    order => ++$order,
807    test_class => [qw(forking inprogress sftp ssh2)],
808  },
809
810  sftp_ext_upload_bug3550 => {
811    order => ++$order,
812    test_class => [qw(bug forking sftp ssh2)],
813  },
814
815  sftp_download => {
816    order => ++$order,
817    test_class => [qw(forking sftp ssh2)],
818  },
819
820  # Requires libssh2-1.2.8 or later, with fixed compression
821  sftp_download_with_compression => {
822    order => ++$order,
823    test_class => [qw(forking sftp ssh2)],
824  },
825
826  # See:
827  #   https://github.com/proftpd/proftpd/issues/323
828  sftp_download_with_compression_rekeying => {
829    order => ++$order,
830    test_class => [qw(forking sftp ssh2)],
831  },
832
833  sftp_download_zero_len_file => {
834    order => ++$order,
835    test_class => [qw(forking sftp ssh2)],
836  },
837
838  sftp_download_largefile => {
839    order => ++$order,
840    test_class => [qw(forking sftp ssh2)],
841  },
842
843  sftp_download_fifo_bug3314 => {
844    order => ++$order,
845    test_class => [qw(forking inprogress sftp ssh2)],
846  },
847
848  sftp_ext_download_bug3550 => {
849    order => ++$order,
850    test_class => [qw(bug forking sftp ssh2)],
851  },
852
853  sftp_ext_download_server_rekey => {
854    order => ++$order,
855    test_class => [qw(forking sftp ssh2)],
856  },
857
858  sftp_download_server_rekey => {
859    order => ++$order,
860    test_class => [qw(forking sftp ssh2)],
861  },
862
863  # TODO: sftp_ext_download_client_rekey
864  # The issues I found with this test are:
865  #   1. Net::SSH2 does not support client-initiated rekeying
866  #   2. Attempting to use the -oRekeyLimit for publickey-based auth using
867  #     sftp(1) causes login to fail; NOT using that option allows the
868  #     login to succeed.  Thus I suspect a bug in that version of
869  #     OpenSSH sftp(1).  For posterity, this is on a Mac OSX machine:
870  #       $ uname -a
871  #       Darwin Ts-MacBook-Pro.local 11.2.0 Darwin Kernel Version 11.2.0: Tue Aug  9 20:54:00 PDT 2011; root:xnu-1699.24.8~1/RELEASE_X86_64 x86_64
872  #
873  #     with OpenSSH version:
874  #       $ ssh -version
875  #       OpenSSH_5.6p1, OpenSSL 0.9.8r 8 Feb 2011
876
877  sftp_ext_download_rekey_rsa1024_hostkey_bug4097 => {
878    order => ++$order,
879    test_class => [qw(bug forking sftp ssh2)],
880  },
881
882  sftp_download_readonly_bug3787 => {
883    order => ++$order,
884    test_class => [qw(bug forking sftp ssh2)],
885  },
886
887  sftp_readdir => {
888    order => ++$order,
889    test_class => [qw(forking sftp ssh2)],
890  },
891
892  sftp_readdir_abs_symlink_dir => {
893    order => ++$order,
894    test_class => [qw(forking sftp ssh2)],
895  },
896
897  sftp_readdir_abs_symlink_dir_chrooted_bug4219 => {
898    order => ++$order,
899    test_class => [qw(bug forking rootprivs sftp ssh2)],
900  },
901
902  sftp_readdir_abs_symlink_dir_vroot => {
903    order => ++$order,
904    test_class => [qw(forking mod_vroot sftp ssh2)],
905  },
906
907  sftp_readdir_rel_symlink_dir => {
908    order => ++$order,
909    test_class => [qw(forking sftp ssh2)],
910  },
911
912  sftp_readdir_rel_symlink_dir_chrooted_bug4219 => {
913    order => ++$order,
914    test_class => [qw(bug forking rootprivs sftp ssh2)],
915  },
916
917  sftp_readdir_wide_dir => {
918    order => ++$order,
919    test_class => [qw(forking sftp ssh2)],
920  },
921
922  sftp_readdir_with_removes => {
923    order => ++$order,
924    test_class => [qw(bug forking sftp ssh2)],
925  },
926
927  sftp_mkdir => {
928    order => ++$order,
929    test_class => [qw(forking sftp ssh2)],
930  },
931
932  sftp_mkdir_eexist => {
933    order => ++$order,
934    test_class => [qw(forking sftp ssh2)],
935  },
936
937  sftp_mkdir_abs_symlink_eexist => {
938    order => ++$order,
939    test_class => [qw(forking sftp ssh2)],
940  },
941
942  sftp_mkdir_abs_symlink_eexist_chrooted_bug4219 => {
943    order => ++$order,
944    test_class => [qw(bug forking rootprivs sftp ssh2)],
945  },
946
947  sftp_mkdir_rel_symlink_eexist => {
948    order => ++$order,
949    test_class => [qw(forking sftp ssh2)],
950  },
951
952  sftp_mkdir_rel_symlink_eexist_chrooted_bug4219 => {
953    order => ++$order,
954    test_class => [qw(bug forking rootprivs sftp ssh2)],
955  },
956
957  sftp_mkdir_readdir_bug3481 => {
958    order => ++$order,
959    test_class => [qw(bug forking sftp ssh2)],
960  },
961
962  sftp_rmdir => {
963    order => ++$order,
964    test_class => [qw(forking sftp ssh2)],
965  },
966
967  sftp_rmdir_dir_not_empty => {
968    order => ++$order,
969    test_class => [qw(forking sftp ssh2)],
970  },
971
972  sftp_rmdir_abs_symlink => {
973    order => ++$order,
974    test_class => [qw(forking sftp ssh2)],
975  },
976
977  sftp_rmdir_abs_symlink_chrooted_bug4219 => {
978    order => ++$order,
979    test_class => [qw(bug forking rootprivs sftp ssh2)],
980  },
981
982  sftp_rmdir_rel_symlink => {
983    order => ++$order,
984    test_class => [qw(forking sftp ssh2)],
985  },
986
987  sftp_rmdir_rel_symlink_chrooted_bug4219 => {
988    order => ++$order,
989    test_class => [qw(bug forking rootprivs sftp ssh2)],
990  },
991
992  sftp_remove => {
993    order => ++$order,
994    test_class => [qw(forking sftp ssh2)],
995  },
996
997  sftp_rename => {
998    order => ++$order,
999    test_class => [qw(forking sftp ssh2)],
1000  },
1001
1002  sftp_symlink => {
1003    order => ++$order,
1004    test_class => [qw(forking sftp ssh2)],
1005  },
1006
1007  sftp_symlink_dst_already_exists => {
1008    order => ++$order,
1009    test_class => [qw(forking sftp ssh2)],
1010  },
1011
1012  sftp_symlink_src_does_not_exist => {
1013    order => ++$order,
1014    test_class => [qw(forking sftp ssh2)],
1015  },
1016
1017  sftp_readlink_abs_dst => {
1018    order => ++$order,
1019    test_class => [qw(forking sftp ssh2)],
1020  },
1021
1022  sftp_readlink_abs_dst_chrooted_bug4219 => {
1023    order => ++$order,
1024    test_class => [qw(bug forking rootprivs sftp ssh2)],
1025  },
1026
1027  sftp_readlink_rel_dst => {
1028    order => ++$order,
1029    test_class => [qw(forking sftp ssh2)],
1030  },
1031
1032  sftp_readlink_rel_dst_chrooted_bug4219 => {
1033    order => ++$order,
1034    test_class => [qw(bug forking rootprivs sftp ssh2)],
1035  },
1036
1037  sftp_readlink_symlink_dir_bug4140 => {
1038    order => ++$order,
1039    test_class => [qw(bug forking sftp ssh2)],
1040  },
1041
1042  sftp_config_client_alive => {
1043    order => ++$order,
1044    test_class => [qw(forking sftp ssh2)],
1045  },
1046
1047  sftp_config_createhome => {
1048    order => ++$order,
1049    test_class => [qw(forking rootprivs sftp ssh2)],
1050  },
1051
1052  sftp_config_max_login_attempts_via_password => {
1053    order => ++$order,
1054    test_class => [qw(forking sftp ssh2)],
1055  },
1056
1057  sftp_config_max_login_attempts_via_publickey => {
1058    order => ++$order,
1059    test_class => [qw(forking sftp ssh2)],
1060  },
1061
1062  sftp_config_max_login_attempts_none_bug4087 => {
1063    order => ++$order,
1064    test_class => [qw(bug forking sftp ssh2)],
1065  },
1066
1067  sftp_config_ignore_upload_perms_upload => {
1068    order => ++$order,
1069    test_class => [qw(forking sftp ssh2)],
1070  },
1071
1072  sftp_config_ignore_upload_perms_mkdir_bug3680 => {
1073    order => ++$order,
1074    test_class => [qw(bug forking sftp ssh2)],
1075  },
1076
1077  sftp_config_ignore_set_perms_bug3599 => {
1078    order => ++$order,
1079    test_class => [qw(forking sftp ssh2)],
1080  },
1081
1082  sftp_config_ignore_set_times_bug3706 => {
1083    order => ++$order,
1084    test_class => [qw(forking sftp ssh2)],
1085  },
1086
1087  sftp_config_ignore_set_owners_bug3757 => {
1088    order => ++$order,
1089    test_class => [qw(forking sftp ssh2)],
1090  },
1091
1092  sftp_config_client_match => {
1093    order => ++$order,
1094    test_class => [qw(forking ssh2)],
1095  },
1096
1097  sftp_config_allowoverwrite => {
1098    order => ++$order,
1099    test_class => [qw(forking sftp ssh2)],
1100  },
1101
1102  sftp_config_allowstorerestart => {
1103    order => ++$order,
1104    test_class => [qw(forking sftp ssh2)],
1105  },
1106
1107  sftp_config_defaultchdir => {
1108    order => ++$order,
1109    test_class => [qw(forking sftp ssh2)],
1110  },
1111
1112  sftp_config_deleteabortedstores => {
1113    order => ++$order,
1114    test_class => [qw(forking sftp ssh2)],
1115  },
1116
1117  sftp_config_dirfakemode => {
1118    order => ++$order,
1119    test_class => [qw(forking sftp ssh2)],
1120  },
1121
1122  sftp_config_hiddenstores => {
1123    order => ++$order,
1124    test_class => [qw(forking sftp ssh2)],
1125  },
1126
1127  sftp_config_hidefiles_abs_path => {
1128    order => ++$order,
1129    test_class => [qw(forking sftp ssh2)],
1130  },
1131
1132  sftp_config_hidefiles_deferred_path_bug3470 => {
1133    order => ++$order,
1134    test_class => [qw(bug forking sftp ssh2)],
1135  },
1136
1137  sftp_config_hidefiles_deferred_path_chroot_bug3470 => {
1138    order => ++$order,
1139    test_class => [qw(bug forking rootprivs sftp ssh2)],
1140  },
1141
1142  sftp_config_hidefiles_symlink_bug3924 => {
1143    order => ++$order,
1144    test_class => [qw(bug forking sftp ssh2)],
1145  },
1146
1147  sftp_config_hidenoaccess => {
1148    order => ++$order,
1149    test_class => [qw(forking sftp ssh2)],
1150  },
1151
1152  sftp_config_max_clients_per_host_bug3630 => {
1153    order => ++$order,
1154    test_class => [qw(bug forking sftp ssh2)],
1155  },
1156
1157  sftp_config_pathdenyfilter_file => {
1158    order => ++$order,
1159    test_class => [qw(forking sftp ssh2)],
1160  },
1161
1162  sftp_config_pathdenyfilter_dir => {
1163    order => ++$order,
1164    test_class => [qw(forking sftp ssh2)],
1165  },
1166
1167  sftp_config_rekey_short_timeout_failed => {
1168    order => ++$order,
1169    test_class => [qw(forking sftp ssh2)],
1170  },
1171
1172  sftp_config_rekey_long_timeout_ok => {
1173    order => ++$order,
1174    test_class => [qw(forking sftp ssh2)],
1175  },
1176
1177  sftp_config_rootlogin => {
1178    order => ++$order,
1179    test_class => [qw(forking rootprivs sftp ssh2)],
1180  },
1181
1182  sftp_config_protocols => {
1183    order => ++$order,
1184    test_class => [qw(forking sftp ssh2)],
1185  },
1186
1187  sftp_config_serverident_off => {
1188    order => ++$order,
1189    test_class => [qw(forking sftp ssh2)],
1190  },
1191
1192  sftp_config_serverident_on => {
1193    order => ++$order,
1194    test_class => [qw(forking sftp ssh2)],
1195  },
1196
1197  sftp_config_serverident_on_custom => {
1198    order => ++$order,
1199    test_class => [qw(forking sftp ssh2)],
1200  },
1201
1202  sftp_config_timeoutidle => {
1203    order => ++$order,
1204    test_class => [qw(forking sftp ssh2)],
1205  },
1206
1207  sftp_config_timeoutlogin => {
1208    order => ++$order,
1209    test_class => [qw(forking sftp ssh2)],
1210  },
1211
1212  sftp_config_timeoutnotransfer_download => {
1213    order => ++$order,
1214    test_class => [qw(forking sftp ssh2)],
1215  },
1216
1217  sftp_config_timeoutnotransfer_readdir => {
1218    order => ++$order,
1219    test_class => [qw(forking sftp ssh2)],
1220  },
1221
1222  sftp_config_timeoutnotransfer_upload => {
1223    order => ++$order,
1224    test_class => [qw(forking sftp ssh2)],
1225  },
1226
1227  sftp_config_timeoutstalled => {
1228    order => ++$order,
1229    test_class => [qw(forking sftp ssh2)],
1230  },
1231
1232  sftp_config_userowner => {
1233    order => ++$order,
1234    test_class => [qw(forking rootprivs sftp ssh2)],
1235  },
1236
1237  sftp_config_groupowner_file_nonmember => {
1238    order => ++$order,
1239    test_class => [qw(forking rootprivs sftp ssh2)],
1240  },
1241
1242  sftp_config_groupowner_file_member_norootprivs => {
1243    order => ++$order,
1244    test_class => [qw(forking norootprivs sftp ssh2)],
1245  },
1246
1247  sftp_config_groupowner_dir_member_norootprivs_bug3765 => {
1248    order => ++$order,
1249    test_class => [qw(bug forking norootprivs sftp ssh2)],
1250  },
1251
1252  sftp_config_ftpaccess_bug3460 => {
1253    order => ++$order,
1254    test_class => [qw(bug forking sftp ssh2)],
1255  },
1256
1257  sftp_config_limit_appe => {
1258    order => ++$order,
1259    test_class => [qw(forking sftp ssh2)],
1260  },
1261
1262  sftp_config_limit_chmod => {
1263    order => ++$order,
1264    test_class => [qw(forking sftp ssh2)],
1265  },
1266
1267  sftp_config_limit_chgrp_bug3757 => {
1268    order => ++$order,
1269    test_class => [qw(bug forking sftp ssh2)],
1270  },
1271
1272  sftp_config_limit_list => {
1273    order => ++$order,
1274    test_class => [qw(forking sftp ssh2)],
1275  },
1276
1277  sftp_config_limit_nlst => {
1278    order => ++$order,
1279    test_class => [qw(forking sftp ssh2)],
1280  },
1281
1282  sftp_config_limit_allowfilter_stor_allowed => {
1283    order => ++$order,
1284    test_class => [qw(forking sftp ssh2)],
1285  },
1286
1287  sftp_config_limit_allowfilter_stor_denied => {
1288    order => ++$order,
1289    test_class => [qw(forking sftp ssh2)],
1290  },
1291
1292  sftp_config_limit_dirs_realpath_bug3871 => {
1293    order => ++$order,
1294    test_class => [qw(bug forking sftp ssh2)],
1295  },
1296
1297  sftp_config_limit_readdir => {
1298    order => ++$order,
1299    test_class => [qw(bug forking sftp ssh2)],
1300  },
1301
1302  sftp_config_limit_fsetstat_bug3753 => {
1303    order => ++$order,
1304    test_class => [qw(bug forking sftp ssh2)],
1305  },
1306
1307  sftp_config_limit_mkdir_bug3753 => {
1308    order => ++$order,
1309    test_class => [qw(bug forking sftp ssh2)],
1310  },
1311
1312  sftp_config_limit_opendir_bug3753 => {
1313    order => ++$order,
1314    test_class => [qw(bug forking sftp ssh2)],
1315  },
1316
1317  sftp_config_limit_readdir_bug3753 => {
1318    order => ++$order,
1319    test_class => [qw(bug forking sftp ssh2)],
1320  },
1321
1322  sftp_config_limit_readlink_bug3753 => {
1323    order => ++$order,
1324    test_class => [qw(bug forking sftp ssh2)],
1325  },
1326
1327  sftp_config_limit_remove_bug3753 => {
1328    order => ++$order,
1329    test_class => [qw(bug forking sftp ssh2)],
1330  },
1331
1332  sftp_config_limit_rename_bug3753 => {
1333    order => ++$order,
1334    test_class => [qw(bug forking sftp ssh2)],
1335  },
1336
1337  sftp_config_limit_rmdir_bug3753 => {
1338    order => ++$order,
1339    test_class => [qw(bug forking sftp ssh2)],
1340  },
1341
1342  sftp_config_insecure_hostkey_perms_bug4098 => {
1343    order => ++$order,
1344    test_class => [qw(bug forking sftp ssh2)],
1345  },
1346
1347  sftp_config_allow_empty_passwords_off_bug4309 => {
1348    order => ++$order,
1349    test_class => [qw(bug forking sftp ssh2)],
1350  },
1351
1352  sftp_config_maxclientsperuser_issue750 => {
1353    order => ++$order,
1354    test_class => [qw(bug forking mod_digest sftp ssh2)],
1355  },
1356
1357  sftp_multi_channels => {
1358    order => ++$order,
1359    test_class => [qw(forking sftp ssh2)],
1360  },
1361
1362  sftp_multi_channel_downloads => {
1363    order => ++$order,
1364    test_class => [qw(forking sftp ssh2)],
1365  },
1366
1367  sftp_log_xferlog_download => {
1368    order => ++$order,
1369    test_class => [qw(forking sftp ssh2)],
1370  },
1371
1372  sftp_log_xferlog_download_incomplete => {
1373    order => ++$order,
1374    test_class => [qw(forking sftp ssh2)],
1375  },
1376
1377  sftp_log_xferlog_delete => {
1378    order => ++$order,
1379    test_class => [qw(forking sftp ssh2)],
1380  },
1381
1382  sftp_log_xferlog_delete_chrooted => {
1383    order => ++$order,
1384    test_class => [qw(forking rootprivs sftp ssh2)],
1385  },
1386
1387  sftp_log_xferlog_upload => {
1388    order => ++$order,
1389    test_class => [qw(forking sftp ssh2)],
1390  },
1391
1392  sftp_log_xferlog_upload_incomplete => {
1393    order => ++$order,
1394    test_class => [qw(forking sftp ssh2)],
1395  },
1396
1397  sftp_log_extlog_auth_bug3845 => {
1398    order => ++$order,
1399    test_class => [qw(bug forking sftp ssh2)],
1400  },
1401
1402  sftp_log_extlog_reads => {
1403    order => ++$order,
1404    test_class => [qw(forking sftp ssh2)],
1405  },
1406
1407  sftp_log_extlog_read_close => {
1408    order => ++$order,
1409    test_class => [qw(forking sftp ssh2)],
1410  },
1411
1412  sftp_log_extlog_write_close => {
1413    order => ++$order,
1414    test_class => [qw(forking sftp ssh2)],
1415  },
1416
1417  sftp_log_extlog_var_s_reads => {
1418    order => ++$order,
1419    test_class => [qw(forking sftp ssh2)],
1420  },
1421
1422  sftp_log_extlog_var_s_writes => {
1423    order => ++$order,
1424    test_class => [qw(forking sftp ssh2)],
1425  },
1426
1427  sftp_log_extlog_retr_file_size => {
1428    order => ++$order,
1429    test_class => [qw(bug forking sftp ssh2)],
1430  },
1431
1432  sftp_log_extlog_putty_mget_retr_file_size_bug3560 => {
1433    order => ++$order,
1434    test_class => [qw(bug forking sftp ssh2)],
1435  },
1436
1437  sftp_log_extlog_file_modified_bug3457 => {
1438    order => ++$order,
1439    test_class => [qw(bug forking sftp ssh2)],
1440  },
1441
1442  sftp_log_extlog_var_F_mkdir_rmdir_bug3591 => {
1443    order => ++$order,
1444    test_class => [qw(bug forking rootprivs sftp ssh2)],
1445  },
1446
1447  sftp_log_extlog_var_w_rename_bug3029 => {
1448    order => ++$order,
1449    test_class => [qw(bug forking sftp ssh2)],
1450  },
1451
1452  sftp_log_extlog_var_f_remove => {
1453    order => ++$order,
1454    test_class => [qw(forking sftp ssh2)],
1455  },
1456
1457  sftp_log_extlog_var_f_write => {
1458    order => ++$order,
1459    test_class => [qw(forking sftp ssh2)],
1460  },
1461
1462  sftp_log_extlog_var_f_write_chrooted => {
1463    order => ++$order,
1464    test_class => [qw(forking rootprivs sftp ssh2)],
1465  },
1466
1467  sftp_log_extlog_var_r_write => {
1468    order => ++$order,
1469    test_class => [qw(forking sftp ssh2)],
1470  },
1471
1472  sftp_log_extlog_var_note_bug3707 => {
1473    order => ++$order,
1474    test_class => [qw(bug forking sftp ssh2)],
1475  },
1476
1477  sftp_log_extlog_var_s_remove_bug3873 => {
1478    order => ++$order,
1479    test_class => [qw(bug forking sftp ssh2)],
1480  },
1481
1482  sftp_log_extlog_env_banner_bug4065 => {
1483    order => ++$order,
1484    test_class => [qw(bug forking ssh2)],
1485  },
1486
1487  sftp_log_extlog_userauth_full_request => {
1488    order => ++$order,
1489    test_class => [qw(bug forking ssh2)],
1490  },
1491
1492  sftp_sighup => {
1493    order => ++$order,
1494    test_class => [qw(forking sftp ssh2)],
1495  },
1496
1497  sftp_ifsess_protocols => {
1498    order => ++$order,
1499    test_class => [qw(forking mod_ifsession sftp ssh2)],
1500  },
1501
1502  sftp_wrap_login_allowed_bug3352 => {
1503    order => ++$order,
1504    test_class => [qw(bug forking mod_wrap sftp ssh2)],
1505  },
1506
1507  sftp_wrap_login_denied_bug3352 => {
1508    order => ++$order,
1509    test_class => [qw(bug forking mod_wrap sftp ssh2)],
1510  },
1511
1512  scp_upload => {
1513    order => ++$order,
1514    test_class => [qw(forking scp ssh2)],
1515  },
1516
1517  scp_upload_zero_len_file => {
1518    order => ++$order,
1519    test_class => [qw(forking scp ssh2)],
1520  },
1521
1522  scp_upload_largefile => {
1523    order => ++$order,
1524    test_class => [qw(forking scp ssh2)],
1525  },
1526
1527  scp_upload_abs_symlink => {
1528    order => ++$order,
1529    test_class => [qw(forking scp ssh2)],
1530  },
1531
1532  scp_upload_abs_symlink_chrooted_bug4219 => {
1533    order => ++$order,
1534    test_class => [qw(bug forking rootprivs scp ssh2)],
1535  },
1536
1537  scp_upload_rel_symlink => {
1538    order => ++$order,
1539    test_class => [qw(forking scp ssh2)],
1540  },
1541
1542  scp_upload_rel_symlink_chrooted_bug4219 => {
1543    order => ++$order,
1544    test_class => [qw(bug forking rootprivs scp ssh2)],
1545  },
1546
1547  scp_upload_subdir_enoent => {
1548    order => ++$order,
1549    test_class => [qw(forking scp ssh2)],
1550  },
1551
1552  scp_upload_subdir_enoent_with_limits => {
1553    order => ++$order,
1554    test_class => [qw(forking rootprivs scp ssh2)],
1555  },
1556
1557  scp_upload_fifo_bug3312 => {
1558    order => ++$order,
1559    test_class => [qw(forking scp ssh2)],
1560  },
1561
1562  scp_upload_fifo_bug3313 => {
1563    order => ++$order,
1564    test_class => [qw(forking inprogress scp ssh2)],
1565  },
1566
1567  scp_ext_null_ptr_issue1043 => {
1568    order => ++$order,
1569    test_class => [qw(bug forking scp ssh2)],
1570  },
1571
1572  scp_ext_upload_recursive_dir_bug3447 => {
1573    order => ++$order,
1574    test_class => [qw(bug forking scp ssh2)],
1575  },
1576
1577  scp_ext_upload_recursive_dir_bug3792 => {
1578    order => ++$order,
1579    test_class => [qw(bug forking scp ssh2)],
1580  },
1581
1582  scp_ext_upload_recursive_dir_bug4004 => {
1583    order => ++$order,
1584    test_class => [qw(bug forking scp ssh2)],
1585  },
1586
1587  scp_ext_upload_recursive_dirs_bug4257 => {
1588    order => ++$order,
1589    test_class => [qw(bug forking scp ssh2)],
1590  },
1591
1592  scp_ext_upload_different_name_bug3425 => {
1593    order => ++$order,
1594    test_class => [qw(bug forking scp ssh2)],
1595  },
1596
1597  scp_ext_upload_recursive_empty_dir => {
1598    order => ++$order,
1599    test_class => [qw(forking scp ssh2)],
1600  },
1601
1602  scp_ext_upload_shorter_file_bug4013 => {
1603    order => ++$order,
1604    test_class => [qw(forking scp ssh2)],
1605  },
1606
1607  scp_ext_upload_file_with_timestamp_bug4026 => {
1608    order => ++$order,
1609    test_class => [qw(forking rootprivs scp ssh2)],
1610  },
1611
1612  scp_download => {
1613    order => ++$order,
1614    test_class => [qw(forking scp ssh2)],
1615  },
1616
1617  scp_download_enoent_bug3798 => {
1618    order => ++$order,
1619    test_class => [qw(bug forking scp ssh2)],
1620  },
1621
1622  scp_download_zero_len_file => {
1623    order => ++$order,
1624    test_class => [qw(forking scp ssh2)],
1625  },
1626
1627  scp_download_largefile => {
1628    order => ++$order,
1629    test_class => [qw(forking scp ssh2)],
1630  },
1631
1632  scp_download_fifo_bug3314 => {
1633    order => ++$order,
1634    test_class => [qw(forking inprogress scp ssh2)],
1635  },
1636
1637  scp_download_abs_symlink => {
1638    order => ++$order,
1639    test_class => [qw(forking scp ssh2)],
1640  },
1641
1642  scp_download_abs_symlink_chrooted_bug4219 => {
1643    order => ++$order,
1644    test_class => [qw(bug forking rootprivs scp ssh2)],
1645  },
1646
1647  scp_download_rel_symlink => {
1648    order => ++$order,
1649    test_class => [qw(forking scp ssh2)],
1650  },
1651
1652  scp_download_rel_symlink_chrooted_bug4219 => {
1653    order => ++$order,
1654    test_class => [qw(bug forking rootprivs scp ssh2)],
1655  },
1656
1657  scp_ext_download_bug3544 => {
1658    order => ++$order,
1659    test_class => [qw(bug forking scp ssh2)],
1660  },
1661
1662  scp_ext_download_bug3798 => {
1663    order => ++$order,
1664    test_class => [qw(bug forking scp ssh2)],
1665  },
1666
1667  scp_ext_download_glob_single_match_bug3904 => {
1668    order => ++$order,
1669    test_class => [qw(bug forking scp ssh2)],
1670  },
1671
1672  scp_ext_download_glob_multiple_matches_bug3904 => {
1673    order => ++$order,
1674    test_class => [qw(bug forking scp ssh2)],
1675  },
1676
1677  scp_ext_download_recursive_dir_bug3456 => {
1678    order => ++$order,
1679    test_class => [qw(bug forking scp ssh2)],
1680  },
1681
1682  scp_ext_download_recursive_empty_dir => {
1683    order => ++$order,
1684    test_class => [qw(forking scp ssh2)],
1685  },
1686
1687  scp_ext_download_glob_no_matches_bug3935 => {
1688    order => ++$order,
1689    test_class => [qw(bug forking scp ssh2)],
1690  },
1691
1692  scp_config_ignore_upload_perms => {
1693    order => ++$order,
1694    test_class => [qw(forking scp ssh2)],
1695  },
1696
1697  scp_config_ignore_upload_times => {
1698    order => ++$order,
1699    test_class => [qw(forking scp ssh2)],
1700  },
1701
1702  scp_config_hiddenstores => {
1703    order => ++$order,
1704    test_class => [qw(forking scp ssh2)],
1705  },
1706
1707  scp_config_subdir_upload_allowed => {
1708    order => ++$order,
1709    test_class => [qw(forking scp ssh2)],
1710  },
1711
1712  scp_config_protocols => {
1713    order => ++$order,
1714    test_class => [qw(forking scp ssh2)],
1715  },
1716
1717  scp_config_userowner => {
1718    order => ++$order,
1719    test_class => [qw(forking rootprivs scp ssh2)],
1720  },
1721
1722  scp_config_groupowner_file_nonmember => {
1723    order => ++$order,
1724    test_class => [qw(forking rootprivs scp ssh2)],
1725  },
1726
1727  scp_config_groupowner_file_member_norootprivs => {
1728    order => ++$order,
1729    test_class => [qw(forking norootprivs scp ssh2)],
1730  },
1731
1732  scp_log_extlog_var_f_upload => {
1733    order => ++$order,
1734    test_class => [qw(forking scp ssh2)],
1735  },
1736
1737  scp_log_extlog_file_modified_bug3457 => {
1738    order => ++$order,
1739    test_class => [qw(bug forking scp ssh2)],
1740  },
1741
1742  scp_log_extlog_var_file_size_download_issue676 => {
1743    order => ++$order,
1744    test_class => [qw(bug forking scp ssh2)],
1745  },
1746
1747  scp_log_xferlog_download => {
1748    order => ++$order,
1749    test_class => [qw(forking scp ssh2)],
1750  },
1751
1752  scp_log_xferlog_upload => {
1753    order => ++$order,
1754    test_class => [qw(forking scp ssh2)],
1755  },
1756
1757  sftp_quotatab_upload_bytes_in_exceeded_soft_limit => {
1758    order => ++$order,
1759    test_class => [qw(forking mod_quotatab_sql mod_sql_sqlite sftp ssh2)],
1760  },
1761
1762  sftp_sql_custom_user_info => {
1763    order => ++$order,
1764    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1765  },
1766
1767  sftp_sql_log_retr_vars => {
1768    order => ++$order,
1769    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1770  },
1771
1772  sftp_sql_log_stor_vars => {
1773    order => ++$order,
1774    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1775  },
1776
1777  sftp_sql_log_appe_vars => {
1778    order => ++$order,
1779    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1780  },
1781
1782  sftp_sql_log_init_vars => {
1783    order => ++$order,
1784    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1785  },
1786
1787  sftp_sql_log_pass_vars => {
1788    order => ++$order,
1789    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1790  },
1791
1792  sftp_sql_log_exit_vars => {
1793    order => ++$order,
1794    test_class => [qw(forking mod_sql mod_sql_sqlite sftp ssh2)],
1795  },
1796
1797  scp_ifsess_protocols => {
1798    order => ++$order,
1799    test_class => [qw(forking mod_ifsession scp ssh2)],
1800  },
1801
1802};
1803
1804sub get_sftplog {
1805  my $db_file = shift;
1806
1807  my $sql = "SELECT user, operation, filename, full_path, filesize, xfertime FROM sftplog";
1808
1809  my $cmd = "sqlite3 $db_file \"$sql\"";
1810
1811  if ($ENV{TEST_VERBOSE}) {
1812    print STDERR "Executing sqlite3: $cmd\n";
1813  }
1814
1815  my $res = join('', `$cmd`);
1816
1817  # The default sqlite3 delimiter is '|'
1818  return split(/\|/, $res);
1819}
1820
1821sub new {
1822  return shift()->SUPER::new(@_);
1823}
1824
1825sub list_tests {
1826  # Check for the required Perl modules:
1827  #
1828  #  Net-SSH2
1829  #  Net-SSH2-SFTP
1830
1831  my $required = [qw(
1832    Net::SSH2
1833    Net::SSH2::SFTP
1834  )];
1835
1836  foreach my $req (@$required) {
1837    eval "use $req";
1838    if ($@) {
1839      print STDERR "\nWARNING:\n + Module '$req' not found, skipping all tests\n";
1840
1841      if ($ENV{TEST_VERBOSE}) {
1842        print STDERR "Unable to load $req: $@\n";
1843      }
1844
1845      return qw(testsuite_empty_test);
1846    }
1847  }
1848
1849  my @tests = testsuite_get_runnable_tests($TESTS);
1850
1851  # These tests are unstable (i.e. buggy), and should only be run manually.
1852  #
1853  # Some of them are buggy due to Net::SSH2 issues; perhaps they should be
1854  # written to use the external sftp(1) command?
1855  my $skipped_tests = {
1856    ssh2_hostkey_rsa_only => 1,
1857    ssh2_auth_no_authorized_keys => 1,
1858    ssh2_hostkey_dss_only => 1,
1859    ssh2_hostkey_dss_bug3634 => 1,
1860  };
1861
1862  foreach my $key (keys(%$skipped_tests)) {
1863    my $ntests = scalar(@tests);
1864    for (my $i = 0; $i < $ntests; $i++) {
1865      if ($tests[$i] eq $key) {
1866        splice(@tests, $i, 1);
1867        last;
1868      }
1869    }
1870  }
1871
1872  return @tests;
1873}
1874
1875sub set_up {
1876  my $self = shift;
1877  $self->SUPER::set_up(@_);
1878
1879  # Make sure that mod_sftp does not complain about permissions on the hostkey
1880  # files.
1881
1882  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1883  my $rsa1024_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa1024_key');
1884  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1885  my $ecdsa256_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa256_key');
1886  my $ecdsa384_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa384_key');
1887  my $ecdsa521_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa521_key');
1888  my $passphrase_rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_rsa_key');
1889  my $passphrase_dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_dsa_key');
1890
1891  my $openssh_rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_rsa_key');
1892  my $openssh_dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_dsa_key');
1893  my $openssh_ecdsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_ecdsa_key');
1894  my $openssh_ed25519_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_ed25519_key');
1895  my $passphrase_openssh_rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_openssh_rsa_key');
1896  my $passphrase_openssh_ed25519_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_openssh_ed25519_key');
1897  my $passphrase_openssh_ed25519_cbc_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_openssh_ed25519_cbc_key');
1898
1899  unless (chmod(0400, $rsa_host_key, $rsa1024_host_key, $dsa_host_key,
1900      $ecdsa256_host_key, $ecdsa384_host_key, $ecdsa521_host_key,
1901      $passphrase_rsa_host_key, $passphrase_dsa_host_key,
1902      $openssh_rsa_host_key, $openssh_dsa_host_key, $openssh_ecdsa_host_key,
1903      $openssh_ed25519_host_key, $passphrase_openssh_rsa_host_key,
1904      $passphrase_openssh_ed25519_host_key, $passphrase_openssh_ed25519_cbc_host_key)) {
1905    die("Can't set perms on $rsa_host_key, $rsa1024_host_key, $dsa_host_key, $ecdsa256_host_key, $ecdsa384_host_key, $ecdsa521_host_key, $passphrase_rsa_host_key, $passphrase_dsa_host_key, $openssh_rsa_host_key, $openssh_dsa_host_key, $openssh_ecdsa_host_key, $openssh_ed25519_host_key, $passphrase_openssh_rsa_host_key, $passphrase_openssh_ed25519_host_key, $passphrase_openssh_ed25519_cbc_host_key: $!");
1906  }
1907}
1908
1909sub concat_files {
1910  my $src_path = shift;
1911  my $dst_path = shift;
1912
1913  if (open(my $dst_fh, ">> $dst_path")) {
1914    if (open(my $src_fh, "< $src_path")) {
1915      while (my $line = <$src_fh>) {
1916        print $dst_fh $line;
1917      }
1918
1919      close($src_fh);
1920
1921      unless (close($dst_fh)) {
1922        die("Can't write to $dst_path: $!");
1923      }
1924
1925    } else {
1926      my $ex = $!;
1927      close($dst_fh);
1928      die("Can't read $src_path: $ex");
1929    }
1930
1931  } else {
1932    die("Can't append to $dst_path: $!");
1933  }
1934
1935  return 1;
1936}
1937
1938sub ssh2_connect_bad_version_bad_format {
1939  my $self = shift;
1940  my $tmpdir = $self->{tmpdir};
1941  my $setup = test_setup($tmpdir, 'sftp');
1942
1943  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1944  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1945
1946  my $config = {
1947    PidFile => $setup->{pid_file},
1948    ScoreboardFile => $setup->{scoreboard_file},
1949    SystemLog => $setup->{log_file},
1950    TraceLog => $setup->{log_file},
1951    Trace => 'ssh2:20',
1952
1953    AuthUserFile => $setup->{auth_user_file},
1954    AuthGroupFile => $setup->{auth_group_file},
1955
1956    IfModules => {
1957      'mod_delay.c' => {
1958        DelayEngine => 'off',
1959      },
1960
1961      'mod_sftp.c' => [
1962        "SFTPEngine on",
1963        "SFTPLog $setup->{log_file}",
1964        "SFTPHostKey $rsa_host_key",
1965        "SFTPHostKey $dsa_host_key",
1966        'SFTPOptions PessimisticKexinit',
1967      ],
1968    },
1969  };
1970
1971  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
1972    $config);
1973
1974  # Open pipes, for use between the parent and child processes.  Specifically,
1975  # the child will indicate when it's done with its test by writing a message
1976  # to the parent.
1977  my ($rfh, $wfh);
1978  unless (pipe($rfh, $wfh)) {
1979    die("Can't open pipe: $!");
1980  }
1981
1982  my $ex;
1983
1984  # Fork child
1985  $self->handle_sigchld();
1986  defined(my $pid = fork()) or die("Can't fork: $!");
1987  if ($pid) {
1988    eval {
1989      sleep(1);
1990
1991      my $proto = getprotobyname('tcp');
1992
1993      my $sock;
1994      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
1995        die("Can't create socket: $!");
1996      }
1997
1998      my $in_addr = inet_aton('127.0.0.1');
1999      my $addr = sockaddr_in($port, $in_addr);
2000
2001      unless (connect($sock, $addr)) {
2002        die("Can't connect to 127.0.0.1:$port: $!");
2003      }
2004
2005      $sock->autoflush(1);
2006      print $sock "AAAA\r\n";
2007
2008      my $resp = '';
2009      my $len = read($sock, $resp, 64);
2010      $self->assert($len > 0, test_msg("Expected response, got none"));
2011
2012      chomp($resp);
2013
2014      my $expected = 'Protocol mismatch.';
2015      $self->assert(qr/$expected/, $resp,
2016        test_msg("Expected '$expected', got '$resp'"));
2017
2018      close($sock);
2019    };
2020
2021    if ($@) {
2022      $ex = $@;
2023    }
2024
2025    $wfh->print("done\n");
2026    $wfh->flush();
2027
2028  } else {
2029    eval { server_wait($setup->{config_file}, $rfh) };
2030    if ($@) {
2031      warn($@);
2032      exit 1;
2033    }
2034
2035    exit 0;
2036  }
2037
2038  # Stop server
2039  server_stop($setup->{pid_file});
2040
2041  $self->assert_child_ok($pid);
2042  test_cleanup($setup->{log_file}, $ex);
2043}
2044
2045sub ssh2_connect_bad_version_unsupported_proto_version {
2046  my $self = shift;
2047  my $tmpdir = $self->{tmpdir};
2048  my $setup = test_setup($tmpdir, 'sftp');
2049
2050  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2051  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2052
2053  my $config = {
2054    PidFile => $setup->{pid_file},
2055    ScoreboardFile => $setup->{scoreboard_file},
2056    SystemLog => $setup->{log_file},
2057    TraceLog => $setup->{log_file},
2058    Trace => 'ssh2:20',
2059
2060    AuthUserFile => $setup->{auth_user_file},
2061    AuthGroupFile => $setup->{auth_group_file},
2062
2063    IfModules => {
2064      'mod_delay.c' => {
2065        DelayEngine => 'off',
2066      },
2067
2068      'mod_sftp.c' => [
2069        "SFTPEngine on",
2070        "SFTPLog $setup->{log_file}",
2071        "SFTPHostKey $rsa_host_key",
2072        "SFTPHostKey $dsa_host_key",
2073        'SFTPOptions PessimisticKexinit',
2074      ],
2075    },
2076  };
2077
2078  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
2079    $config);
2080
2081  # Open pipes, for use between the parent and child processes.  Specifically,
2082  # the child will indicate when it's done with its test by writing a message
2083  # to the parent.
2084  my ($rfh, $wfh);
2085  unless (pipe($rfh, $wfh)) {
2086    die("Can't open pipe: $!");
2087  }
2088
2089  my $ex;
2090
2091  # Fork child
2092  $self->handle_sigchld();
2093  defined(my $pid = fork()) or die("Can't fork: $!");
2094  if ($pid) {
2095    eval {
2096      sleep(1);
2097
2098      my $proto = getprotobyname('tcp');
2099
2100      my $sock;
2101      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
2102        die("Can't create socket: $!");
2103      }
2104
2105      my $in_addr = inet_aton('127.0.0.1');
2106      my $addr = sockaddr_in($port, $in_addr);
2107
2108      unless (connect($sock, $addr)) {
2109        die("Can't connect to 127.0.0.1:$port: $!");
2110      }
2111
2112      $sock->autoflush(1);
2113      print $sock "SSH-6.6-FOO\r\n";
2114
2115      my $resp = '';
2116      my $len = read($sock, $resp, 64);
2117      $self->assert($len > 0, test_msg("Expected response, got none"));
2118
2119      chomp($resp);
2120
2121      my $expected = 'Protocol mismatch.';
2122      $self->assert(qr/$expected/, $resp,
2123        test_msg("Expected '$expected', got '$resp'"));
2124
2125      close($sock);
2126    };
2127
2128    if ($@) {
2129      $ex = $@;
2130    }
2131
2132    $wfh->print("done\n");
2133    $wfh->flush();
2134
2135  } else {
2136    eval { server_wait($setup->{config_file}, $rfh) };
2137    if ($@) {
2138      warn($@);
2139      exit 1;
2140    }
2141
2142    exit 0;
2143  }
2144
2145  # Stop server
2146  server_stop($setup->{pid_file});
2147
2148  $self->assert_child_ok($pid);
2149  test_cleanup($setup->{log_file}, $ex);
2150}
2151
2152sub ssh2_connect_bad_version_too_long {
2153  my $self = shift;
2154  my $tmpdir = $self->{tmpdir};
2155  my $setup = test_setup($tmpdir, 'sftp');
2156
2157  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2158  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2159
2160  my $config = {
2161    PidFile => $setup->{pid_file},
2162    ScoreboardFile => $setup->{scoreboard_file},
2163    SystemLog => $setup->{log_file},
2164    TraceLog => $setup->{log_file},
2165    Trace => 'ssh2:20',
2166
2167    AuthUserFile => $setup->{auth_user_file},
2168    AuthGroupFile => $setup->{auth_group_file},
2169
2170    IfModules => {
2171      'mod_delay.c' => {
2172        DelayEngine => 'off',
2173      },
2174
2175      'mod_sftp.c' => [
2176        "SFTPEngine on",
2177        "SFTPLog $setup->{log_file}",
2178        "SFTPHostKey $rsa_host_key",
2179        "SFTPHostKey $dsa_host_key",
2180        'SFTPOptions PessimisticKexinit',
2181      ],
2182    },
2183  };
2184
2185  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
2186    $config);
2187
2188  # Open pipes, for use between the parent and child processes.  Specifically,
2189  # the child will indicate when it's done with its test by writing a message
2190  # to the parent.
2191  my ($rfh, $wfh);
2192  unless (pipe($rfh, $wfh)) {
2193    die("Can't open pipe: $!");
2194  }
2195
2196  my $ex;
2197
2198  # Fork child
2199  $self->handle_sigchld();
2200  defined(my $pid = fork()) or die("Can't fork: $!");
2201  if ($pid) {
2202    eval {
2203      sleep(1);
2204
2205      my $proto = getprotobyname('tcp');
2206
2207      my $sock;
2208      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
2209        die("Can't create socket: $!");
2210      }
2211
2212      my $in_addr = inet_aton('127.0.0.1');
2213      my $addr = sockaddr_in($port, $in_addr);
2214
2215      unless (connect($sock, $addr)) {
2216        die("Can't connect to 127.0.0.1:$port: $!");
2217      }
2218
2219      $sock->autoflush(1);
2220      print $sock "SSH-2.0-" . 'AAAA' x 1024 . "\r\n";
2221
2222      my $resp = '';
2223      my $len = read($sock, $resp, 64);
2224      $self->assert($len > 0, test_msg("Expected response, got none"));
2225
2226      chomp($resp);
2227
2228      my $expected = 'Protocol mismatch.';
2229      $self->assert(qr/$expected/, $resp,
2230        test_msg("Expected '$expected', got '$resp'"));
2231
2232      close($sock);
2233    };
2234
2235    if ($@) {
2236      $ex = $@;
2237    }
2238
2239    $wfh->print("done\n");
2240    $wfh->flush();
2241
2242  } else {
2243    eval { server_wait($setup->{config_file}, $rfh) };
2244    if ($@) {
2245      warn($@);
2246      exit 1;
2247    }
2248
2249    exit 0;
2250  }
2251
2252  # Stop server
2253  server_stop($setup->{pid_file});
2254
2255  $self->assert_child_ok($pid);
2256  test_cleanup($setup->{log_file}, $ex);
2257}
2258
2259sub ssh2_connect_bad_version_too_short {
2260  my $self = shift;
2261  my $tmpdir = $self->{tmpdir};
2262  my $setup = test_setup($tmpdir, 'sftp');
2263
2264  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2265  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2266
2267  my $config = {
2268    PidFile => $setup->{pid_file},
2269    ScoreboardFile => $setup->{scoreboard_file},
2270    SystemLog => $setup->{log_file},
2271    TraceLog => $setup->{log_file},
2272    Trace => 'ssh2:20',
2273
2274    AuthUserFile => $setup->{auth_user_file},
2275    AuthGroupFile => $setup->{auth_group_file},
2276
2277    IfModules => {
2278      'mod_delay.c' => {
2279        DelayEngine => 'off',
2280      },
2281
2282      'mod_sftp.c' => [
2283        "SFTPEngine on",
2284        "SFTPLog $setup->{log_file}",
2285        "SFTPHostKey $rsa_host_key",
2286        "SFTPHostKey $dsa_host_key",
2287        'SFTPOptions PessimisticKexinit',
2288      ],
2289    },
2290  };
2291
2292  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
2293    $config);
2294
2295  # Open pipes, for use between the parent and child processes.  Specifically,
2296  # the child will indicate when it's done with its test by writing a message
2297  # to the parent.
2298  my ($rfh, $wfh);
2299  unless (pipe($rfh, $wfh)) {
2300    die("Can't open pipe: $!");
2301  }
2302
2303  my $ex;
2304
2305  # Fork child
2306  $self->handle_sigchld();
2307  defined(my $pid = fork()) or die("Can't fork: $!");
2308  if ($pid) {
2309    eval {
2310      sleep(1);
2311
2312      my $proto = getprotobyname('tcp');
2313
2314      my $sock;
2315      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
2316        die("Can't create socket: $!");
2317      }
2318
2319      my $in_addr = inet_aton('127.0.0.1');
2320      my $addr = sockaddr_in($port, $in_addr);
2321
2322      unless (connect($sock, $addr)) {
2323        die("Can't connect to 127.0.0.1:$port: $!");
2324      }
2325
2326      $sock->autoflush(1);
2327      print $sock "SSH-2.0-\r\n";
2328
2329      my $resp = '';
2330      my $len = read($sock, $resp, 64);
2331      $self->assert($len > 0, test_msg("Expected response, got none"));
2332
2333      chomp($resp);
2334
2335      my $expected = 'Protocol mismatch.';
2336      $self->assert(qr/$expected/, $resp,
2337        test_msg("Expected '$expected', got '$resp'"));
2338
2339      close($sock);
2340    };
2341
2342    if ($@) {
2343      $ex = $@;
2344    }
2345
2346    $wfh->print("done\n");
2347    $wfh->flush();
2348
2349  } else {
2350    eval { server_wait($setup->{config_file}, $rfh) };
2351    if ($@) {
2352      warn($@);
2353      exit 1;
2354    }
2355
2356    exit 0;
2357  }
2358
2359  # Stop server
2360  server_stop($setup->{pid_file});
2361
2362  $self->assert_child_ok($pid);
2363  test_cleanup($setup->{log_file}, $ex);
2364}
2365
2366sub ssh2_connect_version_with_comments {
2367  my $self = shift;
2368  my $tmpdir = $self->{tmpdir};
2369  my $setup = test_setup($tmpdir, 'sftp');
2370
2371  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2372  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2373
2374  my $config = {
2375    PidFile => $setup->{pid_file},
2376    ScoreboardFile => $setup->{scoreboard_file},
2377    SystemLog => $setup->{log_file},
2378    TraceLog => $setup->{log_file},
2379    Trace => 'ssh2:20',
2380
2381    AuthUserFile => $setup->{auth_user_file},
2382    AuthGroupFile => $setup->{auth_group_file},
2383
2384    IfModules => {
2385      'mod_delay.c' => {
2386        DelayEngine => 'off',
2387      },
2388
2389      'mod_sftp.c' => [
2390        "SFTPEngine on",
2391        "SFTPLog $setup->{log_file}",
2392        "SFTPHostKey $rsa_host_key",
2393        "SFTPHostKey $dsa_host_key",
2394        'SFTPOptions PessimisticKexinit',
2395      ],
2396    },
2397  };
2398
2399  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
2400    $config);
2401
2402  # Open pipes, for use between the parent and child processes.  Specifically,
2403  # the child will indicate when it's done with its test by writing a message
2404  # to the parent.
2405  my ($rfh, $wfh);
2406  unless (pipe($rfh, $wfh)) {
2407    die("Can't open pipe: $!");
2408  }
2409
2410  my $ex;
2411
2412  # Fork child
2413  $self->handle_sigchld();
2414  defined(my $pid = fork()) or die("Can't fork: $!");
2415  if ($pid) {
2416    eval {
2417      sleep(1);
2418
2419      my $proto = getprotobyname('tcp');
2420
2421      my $sock;
2422      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
2423        die("Can't create socket: $!");
2424      }
2425
2426      my $in_addr = inet_aton('127.0.0.1');
2427      my $addr = sockaddr_in($port, $in_addr);
2428
2429      unless (connect($sock, $addr)) {
2430        die("Can't connect to 127.0.0.1:$port: $!");
2431      }
2432
2433      $sock->autoflush(1);
2434      print $sock "SSH-2.0-ProFTPD_TestSuite internal testing here!\r\n";
2435
2436      my $resp = '';
2437      my $len = read($sock, $resp, 64);
2438      $self->assert($len > 0, test_msg("Expected response, got none"));
2439
2440      chomp($resp);
2441
2442      my $expected = '^SSH-2.0-mod_sftp';
2443      $self->assert(qr/$expected/, $resp,
2444        test_msg("Expected '$expected', got '$resp'"));
2445
2446      close($sock);
2447    };
2448
2449    if ($@) {
2450      $ex = $@;
2451    }
2452
2453    $wfh->print("done\n");
2454    $wfh->flush();
2455
2456  } else {
2457    eval { server_wait($setup->{config_file}, $rfh) };
2458    if ($@) {
2459      warn($@);
2460      exit 1;
2461    }
2462
2463    exit 0;
2464  }
2465
2466  # Stop server
2467  server_stop($setup->{pid_file});
2468
2469  $self->assert_child_ok($pid);
2470  test_cleanup($setup->{log_file}, $ex);
2471}
2472
2473sub ssh2_connect_version_bug3918 {
2474  my $self = shift;
2475  my $tmpdir = $self->{tmpdir};
2476
2477  my $config_file = "$tmpdir/sftp.conf";
2478  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2479  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2480
2481  my $log_file = test_get_logfile();
2482
2483  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2484  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2485
2486  my $user = 'proftpd';
2487  my $passwd = 'test';
2488  my $group = 'ftpd';
2489  my $home_dir = File::Spec->rel2abs($tmpdir);
2490  my $uid = 500;
2491  my $gid = 500;
2492
2493  # Make sure that, if we're running as root, that the home directory has
2494  # permissions/privs set for the account we create
2495  if ($< == 0) {
2496    unless (chmod(0755, $home_dir)) {
2497      die("Can't set perms on $home_dir to 0755: $!");
2498    }
2499
2500    unless (chown($uid, $gid, $home_dir)) {
2501      die("Can't set owner of $home_dir to $uid/$gid: $!");
2502    }
2503  }
2504
2505  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2506    '/bin/bash');
2507  auth_group_write($auth_group_file, $group, $gid, $user);
2508
2509  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2510  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2511
2512  my $config = {
2513    PidFile => $pid_file,
2514    ScoreboardFile => $scoreboard_file,
2515    SystemLog => $log_file,
2516    TraceLog => $log_file,
2517    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2518
2519    AuthUserFile => $auth_user_file,
2520    AuthGroupFile => $auth_group_file,
2521
2522    IfModules => {
2523      'mod_delay.c' => {
2524        DelayEngine => 'off',
2525      },
2526
2527      'mod_sftp.c' => [
2528        "SFTPEngine on",
2529        "SFTPLog $log_file",
2530        "SFTPHostKey $rsa_host_key",
2531        "SFTPHostKey $dsa_host_key",
2532      ],
2533    },
2534  };
2535
2536  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2537
2538  # First, start the server.
2539  server_start($config_file);
2540
2541  # Give it a second to start up, then send the SIGHUP signal
2542  sleep(2);
2543  server_restart($pid_file);
2544
2545  # Give it another second to start up again
2546  sleep(2);
2547
2548  # Open pipes, for use between the parent and child processes.  Specifically,
2549  # the child will indicate when it's done with its test by writing a message
2550  # to the parent.
2551  my ($rfh, $wfh);
2552  unless (pipe($rfh, $wfh)) {
2553    die("Can't open pipe: $!");
2554  }
2555
2556  my $ex;
2557
2558  # Fork child
2559  $self->handle_sigchld();
2560  defined(my $pid = fork()) or die("Can't fork: $!");
2561  if ($pid) {
2562    eval {
2563      sleep(1);
2564
2565      my $proto = getprotobyname('tcp');
2566
2567      my $sock;
2568      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
2569        die("Can't create socket: $!");
2570      }
2571
2572      my $in_addr = inet_aton('127.0.0.1');
2573      my $addr = sockaddr_in($port, $in_addr);
2574
2575      unless (connect($sock, $addr)) {
2576        die("Can't connect to 127.0.0.1:$port: $!");
2577      }
2578
2579      print $sock "SSH-2.0-ProFTPD_mod_sftp_TestSuite\r\n";
2580      sleep(1);
2581
2582      close($sock);
2583    };
2584
2585    if ($@) {
2586      $ex = $@;
2587    }
2588
2589    $wfh->print("done\n");
2590    $wfh->flush();
2591
2592  } else {
2593    eval { server_wait($config_file, $rfh) };
2594    if ($@) {
2595      warn($@);
2596      exit 1;
2597    }
2598
2599    exit 0;
2600  }
2601
2602  # Stop server
2603  server_stop($pid_file);
2604
2605  $self->assert_child_ok($pid);
2606
2607  eval {
2608    if (open(my $fh, "< $log_file")) {
2609      my $segfaulted = 0;
2610
2611      while (my $line = <$fh>) {
2612        if ($line =~ /signal 11/i) {
2613          $segfaulted = 1;
2614          last;
2615        }
2616      };
2617
2618      close($fh);
2619
2620      $self->assert($segfaulted == 0, test_msg("Saw SIGSEGV unexpectedly"));
2621
2622    } else {
2623      die("Can't read $log_file: $!");
2624    }
2625  };
2626  if ($@) {
2627    $ex = $@;
2628  }
2629
2630  if ($ex) {
2631    test_append_logfile($log_file, $ex);
2632    unlink($log_file);
2633
2634    die($ex);
2635  }
2636
2637  unlink($log_file);
2638}
2639
2640sub ssh2_connect_timeout_login {
2641  my $self = shift;
2642  my $tmpdir = $self->{tmpdir};
2643
2644  my $config_file = "$tmpdir/sftp.conf";
2645  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2646  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2647
2648  my $log_file = test_get_logfile();
2649
2650  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2651  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2652
2653  my $user = 'proftpd';
2654  my $passwd = 'test';
2655  my $group = 'ftpd';
2656  my $home_dir = File::Spec->rel2abs($tmpdir);
2657  my $uid = 500;
2658  my $gid = 500;
2659
2660  # Make sure that, if we're running as root, that the home directory has
2661  # permissions/privs set for the account we create
2662  if ($< == 0) {
2663    unless (chmod(0755, $home_dir)) {
2664      die("Can't set perms on $home_dir to 0755: $!");
2665    }
2666
2667    unless (chown($uid, $gid, $home_dir)) {
2668      die("Can't set owner of $home_dir to $uid/$gid: $!");
2669    }
2670  }
2671
2672  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2673    '/bin/bash');
2674  auth_group_write($auth_group_file, $group, $gid, $user);
2675
2676  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2677  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2678
2679  my $config = {
2680    PidFile => $pid_file,
2681    ScoreboardFile => $scoreboard_file,
2682    SystemLog => $log_file,
2683    TraceLog => $log_file,
2684    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2685
2686    AuthUserFile => $auth_user_file,
2687    AuthGroupFile => $auth_group_file,
2688    TimeoutLogin => 3,
2689
2690    IfModules => {
2691      'mod_delay.c' => {
2692        DelayEngine => 'off',
2693      },
2694
2695      'mod_sftp.c' => [
2696        "SFTPEngine on",
2697        "SFTPLog $log_file",
2698        "SFTPHostKey $rsa_host_key",
2699        "SFTPHostKey $dsa_host_key",
2700      ],
2701    },
2702  };
2703
2704  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2705
2706  # Open pipes, for use between the parent and child processes.  Specifically,
2707  # the child will indicate when it's done with its test by writing a message
2708  # to the parent.
2709  my ($rfh, $wfh);
2710  unless (pipe($rfh, $wfh)) {
2711    die("Can't open pipe: $!");
2712  }
2713
2714  my $ex;
2715
2716  # Fork child
2717  $self->handle_sigchld();
2718  defined(my $pid = fork()) or die("Can't fork: $!");
2719  if ($pid) {
2720    eval {
2721      sleep(1);
2722
2723      my $proto = getprotobyname('tcp');
2724
2725      my $sock;
2726      unless (socket($sock, PF_INET, SOCK_STREAM, $proto)) {
2727        die("Can't create socket: $!");
2728      }
2729
2730      my $in_addr = inet_aton('127.0.0.1');
2731      my $addr = sockaddr_in($port, $in_addr);
2732
2733      unless (connect($sock, $addr)) {
2734        die("Can't connect to 127.0.0.1:$port: $!");
2735      }
2736
2737      sleep(4);
2738
2739      print $sock "AAAA" x 1024;
2740
2741      close($sock);
2742    };
2743
2744    if ($@) {
2745      $ex = $@;
2746    }
2747
2748    $wfh->print("done\n");
2749    $wfh->flush();
2750
2751  } else {
2752    eval { server_wait($config_file, $rfh) };
2753    if ($@) {
2754      warn($@);
2755      exit 1;
2756    }
2757
2758    exit 0;
2759  }
2760
2761  # Stop server
2762  server_stop($pid_file);
2763
2764  $self->assert_child_ok($pid);
2765
2766  if ($ex) {
2767    test_append_logfile($log_file, $ex);
2768    unlink($log_file);
2769
2770    die($ex);
2771  }
2772
2773  unlink($log_file);
2774}
2775
2776sub ssh2_kex_dh_group1_sha1 {
2777  my $self = shift;
2778  my $tmpdir = $self->{tmpdir};
2779  my $setup = test_setup($tmpdir, 'sftp');
2780
2781  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2782  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2783
2784  my $config = {
2785    PidFile => $setup->{pid_file},
2786    ScoreboardFile => $setup->{scoreboard_file},
2787    SystemLog => $setup->{log_file},
2788    TraceLog => $setup->{log_file},
2789    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2790
2791    AuthUserFile => $setup->{auth_user_file},
2792    AuthGroupFile => $setup->{auth_group_file},
2793
2794    IfModules => {
2795      'mod_delay.c' => {
2796        DelayEngine => 'off',
2797      },
2798
2799      'mod_sftp.c' => [
2800        "SFTPEngine on",
2801        "SFTPLog $setup->{log_file}",
2802        "SFTPHostKey $rsa_host_key",
2803        "SFTPHostKey $dsa_host_key",
2804
2805        "SFTPOptions AllowWeakDH",
2806      ],
2807    },
2808  };
2809
2810  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
2811    $config);
2812
2813  # Open pipes, for use between the parent and child processes.  Specifically,
2814  # the child will indicate when it's done with its test by writing a message
2815  # to the parent.
2816  my ($rfh, $wfh);
2817  unless (pipe($rfh, $wfh)) {
2818    die("Can't open pipe: $!");
2819  }
2820
2821  require Net::SSH2;
2822
2823  my $ex;
2824
2825  # Fork child
2826  $self->handle_sigchld();
2827  defined(my $pid = fork()) or die("Can't fork: $!");
2828  if ($pid) {
2829    eval {
2830      my $ssh2 = Net::SSH2->new();
2831
2832      sleep(1);
2833
2834      my $kex = 'diffie-hellman-group1-sha1';
2835      $ssh2->method('kex', $kex);
2836
2837      unless ($ssh2->connect('127.0.0.1', $port)) {
2838        my ($err_code, $err_name, $err_str) = $ssh2->error();
2839        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2840      }
2841
2842      my $kex_used = $ssh2->method('kex');
2843      $self->assert($kex eq $kex_used,
2844        test_msg("Expected '$kex', got '$kex_used'"));
2845
2846      $ssh2->disconnect();
2847    };
2848    if ($@) {
2849      $ex = $@;
2850    }
2851
2852    $wfh->print("done\n");
2853    $wfh->flush();
2854
2855  } else {
2856    eval { server_wait($setup->{config_file}, $rfh) };
2857    if ($@) {
2858      warn($@);
2859      exit 1;
2860    }
2861
2862    exit 0;
2863  }
2864
2865  # Stop server
2866  server_stop($setup->{pid_file});
2867  $self->assert_child_ok($pid);
2868
2869  test_cleanup($setup->{log_file}, $ex);
2870}
2871
2872sub ssh2_kex_dh_group14_sha1 {
2873  my $self = shift;
2874  my $tmpdir = $self->{tmpdir};
2875
2876  my $config_file = "$tmpdir/sftp.conf";
2877  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2878  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2879
2880  my $log_file = test_get_logfile();
2881
2882  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2883  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2884
2885  my $user = 'proftpd';
2886  my $passwd = 'test';
2887  my $group = 'ftpd';
2888  my $home_dir = File::Spec->rel2abs($tmpdir);
2889  my $uid = 500;
2890  my $gid = 500;
2891
2892  # Make sure that, if we're running as root, that the home directory has
2893  # permissions/privs set for the account we create
2894  if ($< == 0) {
2895    unless (chmod(0755, $home_dir)) {
2896      die("Can't set perms on $home_dir to 0755: $!");
2897    }
2898
2899    unless (chown($uid, $gid, $home_dir)) {
2900      die("Can't set owner of $home_dir to $uid/$gid: $!");
2901    }
2902  }
2903
2904  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2905    '/bin/bash');
2906  auth_group_write($auth_group_file, $group, $gid, $user);
2907
2908  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2909  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2910
2911  my $config = {
2912    PidFile => $pid_file,
2913    ScoreboardFile => $scoreboard_file,
2914    SystemLog => $log_file,
2915    TraceLog => $log_file,
2916    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2917
2918    AuthUserFile => $auth_user_file,
2919    AuthGroupFile => $auth_group_file,
2920
2921    IfModules => {
2922      'mod_delay.c' => {
2923        DelayEngine => 'off',
2924      },
2925
2926      'mod_sftp.c' => [
2927        "SFTPEngine on",
2928        "SFTPLog $log_file",
2929        "SFTPHostKey $rsa_host_key",
2930        "SFTPHostKey $dsa_host_key",
2931      ],
2932    },
2933  };
2934
2935  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2936
2937  # Open pipes, for use between the parent and child processes.  Specifically,
2938  # the child will indicate when it's done with its test by writing a message
2939  # to the parent.
2940  my ($rfh, $wfh);
2941  unless (pipe($rfh, $wfh)) {
2942    die("Can't open pipe: $!");
2943  }
2944
2945  require Net::SSH2;
2946
2947  my $ex;
2948
2949  # Fork child
2950  $self->handle_sigchld();
2951  defined(my $pid = fork()) or die("Can't fork: $!");
2952  if ($pid) {
2953    eval {
2954      my $ssh2 = Net::SSH2->new();
2955
2956      sleep(1);
2957
2958      my $kex = 'diffie-hellman-group14-sha1';
2959      $ssh2->method('kex', $kex);
2960
2961      unless ($ssh2->connect('127.0.0.1', $port)) {
2962        my ($err_code, $err_name, $err_str) = $ssh2->error();
2963        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2964      }
2965
2966      my $kex_used = $ssh2->method('kex');
2967      $self->assert($kex eq $kex_used,
2968        test_msg("Expected '$kex', got '$kex_used'"));
2969
2970      $ssh2->disconnect();
2971    };
2972
2973    if ($@) {
2974      $ex = $@;
2975    }
2976
2977    $wfh->print("done\n");
2978    $wfh->flush();
2979
2980  } else {
2981    eval { server_wait($config_file, $rfh) };
2982    if ($@) {
2983      warn($@);
2984      exit 1;
2985    }
2986
2987    exit 0;
2988  }
2989
2990  # Stop server
2991  server_stop($pid_file);
2992
2993  $self->assert_child_ok($pid);
2994
2995  if ($ex) {
2996    test_append_logfile($log_file, $ex);
2997    unlink($log_file);
2998
2999    die($ex);
3000  }
3001
3002  unlink($log_file);
3003}
3004
3005sub ssh2_kex_dh_gex_sha1 {
3006  my $self = shift;
3007  my $tmpdir = $self->{tmpdir};
3008
3009  my $config_file = "$tmpdir/sftp.conf";
3010  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3011  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3012
3013  my $log_file = test_get_logfile();
3014
3015  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3016  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3017
3018  my $user = 'proftpd';
3019  my $passwd = 'test';
3020  my $group = 'ftpd';
3021  my $home_dir = File::Spec->rel2abs($tmpdir);
3022  my $uid = 500;
3023  my $gid = 500;
3024
3025  # Make sure that, if we're running as root, that the home directory has
3026  # permissions/privs set for the account we create
3027  if ($< == 0) {
3028    unless (chmod(0755, $home_dir)) {
3029      die("Can't set perms on $home_dir to 0755: $!");
3030    }
3031
3032    unless (chown($uid, $gid, $home_dir)) {
3033      die("Can't set owner of $home_dir to $uid/$gid: $!");
3034    }
3035  }
3036
3037  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3038    '/bin/bash');
3039  auth_group_write($auth_group_file, $group, $gid, $user);
3040
3041  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3042  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3043
3044  my $config = {
3045    PidFile => $pid_file,
3046    ScoreboardFile => $scoreboard_file,
3047    SystemLog => $log_file,
3048    TraceLog => $log_file,
3049    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3050
3051    AuthUserFile => $auth_user_file,
3052    AuthGroupFile => $auth_group_file,
3053
3054    IfModules => {
3055      'mod_delay.c' => {
3056        DelayEngine => 'off',
3057      },
3058
3059      'mod_sftp.c' => [
3060        "SFTPEngine on",
3061        "SFTPLog $log_file",
3062        "SFTPHostKey $rsa_host_key",
3063        "SFTPHostKey $dsa_host_key",
3064      ],
3065    },
3066  };
3067
3068  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3069
3070  # Open pipes, for use between the parent and child processes.  Specifically,
3071  # the child will indicate when it's done with its test by writing a message
3072  # to the parent.
3073  my ($rfh, $wfh);
3074  unless (pipe($rfh, $wfh)) {
3075    die("Can't open pipe: $!");
3076  }
3077
3078  require Net::SSH2;
3079
3080  my $ex;
3081
3082  # Fork child
3083  $self->handle_sigchld();
3084  defined(my $pid = fork()) or die("Can't fork: $!");
3085  if ($pid) {
3086    eval {
3087      my $ssh2 = Net::SSH2->new();
3088
3089      sleep(1);
3090
3091      my $kex = 'diffie-hellman-group-exchange-sha1';
3092      $ssh2->method('kex', $kex);
3093
3094      unless ($ssh2->connect('127.0.0.1', $port)) {
3095        my ($err_code, $err_name, $err_str) = $ssh2->error();
3096        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
3097      }
3098
3099      my $kex_used = $ssh2->method('kex');
3100      $self->assert($kex eq $kex_used,
3101        test_msg("Expected '$kex', got '$kex_used'"));
3102
3103      $ssh2->disconnect();
3104    };
3105
3106    if ($@) {
3107      $ex = $@;
3108    }
3109
3110    $wfh->print("done\n");
3111    $wfh->flush();
3112
3113  } else {
3114    eval { server_wait($config_file, $rfh) };
3115    if ($@) {
3116      warn($@);
3117      exit 1;
3118    }
3119
3120    exit 0;
3121  }
3122
3123  # Stop server
3124  server_stop($pid_file);
3125
3126  $self->assert_child_ok($pid);
3127
3128  if ($ex) {
3129    test_append_logfile($log_file, $ex);
3130    unlink($log_file);
3131
3132    die($ex);
3133  }
3134
3135  unlink($log_file);
3136}
3137
3138sub ssh2_ext_kex_ecdh_sha2_nistp256 {
3139  my $self = shift;
3140  my $tmpdir = $self->{tmpdir};
3141
3142  my $config_file = "$tmpdir/sftp.conf";
3143  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3144  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3145
3146  my $log_file = test_get_logfile();
3147
3148  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3149  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3150
3151  my $user = 'proftpd';
3152  my $passwd = 'test';
3153  my $group = 'ftpd';
3154  my $home_dir = File::Spec->rel2abs($tmpdir);
3155  my $uid = 500;
3156  my $gid = 500;
3157
3158  # Make sure that, if we're running as root, that the home directory has
3159  # permissions/privs set for the account we create
3160  if ($< == 0) {
3161    unless (chmod(0755, $home_dir)) {
3162      die("Can't set perms on $home_dir to 0755: $!");
3163    }
3164
3165    unless (chown($uid, $gid, $home_dir)) {
3166      die("Can't set owner of $home_dir to $uid/$gid: $!");
3167    }
3168  }
3169
3170  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3171    '/bin/bash');
3172  auth_group_write($auth_group_file, $group, $gid, $user);
3173
3174  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3175  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3176  my $ecdsa256_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa256_key');
3177
3178  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
3179  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
3180  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
3181
3182  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
3183  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
3184    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
3185  }
3186
3187  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
3188  if (open(my $fh, "> $src_file")) {
3189    print $fh "Hello, World!\n";
3190
3191    unless (close($fh)) {
3192      die("Can't write $src_file: $!");
3193    }
3194
3195  } else {
3196    die("Can't open $src_file: $!");
3197  }
3198
3199  my $src_sz = (stat($src_file))[7];
3200
3201  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
3202
3203  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
3204  if (open(my $fh, "> $ssh_config")) {
3205    print $fh <<EOC;
3206HostKeyAlgorithms ssh-rsa
3207KexAlgorithms ecdh-sha2-nistp256
3208EOC
3209    unless (close($fh)) {
3210      die("Can't write $ssh_config: $!");
3211    }
3212
3213  } else {
3214    die("Can't open $ssh_config: $!");
3215  }
3216
3217  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
3218  if (open(my $fh, "> $batch_file")) {
3219    print $fh "put -P $src_file $dst_file\n";
3220
3221    unless (close($fh)) {
3222      die("Can't write $batch_file: $!");
3223    }
3224
3225  } else {
3226    die("Can't open $batch_file: $!");
3227  }
3228
3229  my $config = {
3230    PidFile => $pid_file,
3231    ScoreboardFile => $scoreboard_file,
3232    SystemLog => $log_file,
3233    TraceLog => $log_file,
3234    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3235
3236    AuthUserFile => $auth_user_file,
3237    AuthGroupFile => $auth_group_file,
3238
3239    IfModules => {
3240      'mod_delay.c' => {
3241        DelayEngine => 'off',
3242      },
3243
3244      'mod_sftp.c' => [
3245        "SFTPEngine on",
3246        "SFTPLog $log_file",
3247
3248        "SFTPHostKey $rsa_host_key",
3249        "SFTPHostKey $dsa_host_key",
3250        "SFTPHostKey $ecdsa256_host_key",
3251
3252        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
3253      ],
3254    },
3255  };
3256
3257  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3258
3259  # Open pipes, for use between the parent and child processes.  Specifically,
3260  # the child will indicate when it's done with its test by writing a message
3261  # to the parent.
3262  my ($rfh, $wfh);
3263  unless (pipe($rfh, $wfh)) {
3264    die("Can't open pipe: $!");
3265  }
3266
3267  require Net::SSH2;
3268
3269  my $ex;
3270
3271  # Fork child
3272  $self->handle_sigchld();
3273  defined(my $pid = fork()) or die("Can't fork: $!");
3274  if ($pid) {
3275    eval {
3276
3277      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
3278      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
3279
3280      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
3281
3282      my @cmd = (
3283        $sftp,
3284        '-F',
3285        $ssh_config,
3286        '-oBatchMode=yes',
3287        '-oCheckHostIP=no',
3288        '-oCompression=yes',
3289        "-oPort=$port",
3290        "-oIdentityFile=$rsa_priv_key",
3291        '-oPubkeyAuthentication=yes',
3292        '-oStrictHostKeyChecking=no',
3293        '-vvv',
3294        '-b',
3295        $batch_file,
3296        "$user\@127.0.0.1",
3297      );
3298
3299      my $sftp_rh = IO::Handle->new();
3300      my $sftp_wh = IO::Handle->new();
3301      my $sftp_eh = IO::Handle->new();
3302
3303      $sftp_wh->autoflush(1);
3304
3305      sleep(1);
3306
3307      local $SIG{CHLD} = 'DEFAULT';
3308
3309      # Make sure that the perms on the priv key are what OpenSSH wants
3310      unless (chmod(0400, $rsa_priv_key)) {
3311        die("Can't set perms on $rsa_priv_key to 0400: $!");
3312      }
3313
3314      if ($ENV{TEST_VERBOSE}) {
3315        print STDERR "Executing: ", join(' ', @cmd), "\n";
3316      }
3317
3318      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
3319      waitpid($sftp_pid, 0);
3320      my $exit_status = $?;
3321
3322      # Restore the perms on the priv key
3323      unless (chmod(0644, $rsa_priv_key)) {
3324        die("Can't set perms on $rsa_priv_key to 0644: $!");
3325      }
3326
3327      my ($res, $errstr);
3328      if ($exit_status >> 8 == 0) {
3329        $errstr = join('', <$sftp_eh>);
3330        $res = 0;
3331
3332      } else {
3333        $errstr = join('', <$sftp_eh>);
3334        if ($ENV{TEST_VERBOSE}) {
3335          print STDERR "Stderr: $errstr\n";
3336        }
3337
3338        $res = 1;
3339      }
3340
3341      unless ($res == 0) {
3342        die("Can't upload $src_file to server: $errstr");
3343      }
3344
3345      unless (-f $dst_file) {
3346        die("File '$dst_file' does not exist as expected");
3347      }
3348
3349      my $sz = (stat($dst_file))[7];
3350      my $expected_sz = $src_sz;
3351      $self->assert($expected_sz == $sz,
3352        test_msg("Expected file size $expected_sz, got $sz"));
3353
3354    };
3355
3356    if ($@) {
3357      $ex = $@;
3358    }
3359
3360    $wfh->print("done\n");
3361    $wfh->flush();
3362
3363  } else {
3364    eval { server_wait($config_file, $rfh) };
3365    if ($@) {
3366      warn($@);
3367      exit 1;
3368    }
3369
3370    exit 0;
3371  }
3372
3373  # Stop server
3374  server_stop($pid_file);
3375
3376  $self->assert_child_ok($pid);
3377
3378  if ($ex) {
3379    test_append_logfile($log_file, $ex);
3380    unlink($log_file);
3381
3382    die($ex);
3383  }
3384
3385  unlink($log_file);
3386}
3387
3388sub ssh2_ext_kex_ecdh_sha2_nistp384 {
3389  my $self = shift;
3390  my $tmpdir = $self->{tmpdir};
3391
3392  my $config_file = "$tmpdir/sftp.conf";
3393  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3394  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3395
3396  my $log_file = test_get_logfile();
3397
3398  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3399  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3400
3401  my $user = 'proftpd';
3402  my $passwd = 'test';
3403  my $group = 'ftpd';
3404  my $home_dir = File::Spec->rel2abs($tmpdir);
3405  my $uid = 500;
3406  my $gid = 500;
3407
3408  # Make sure that, if we're running as root, that the home directory has
3409  # permissions/privs set for the account we create
3410  if ($< == 0) {
3411    unless (chmod(0755, $home_dir)) {
3412      die("Can't set perms on $home_dir to 0755: $!");
3413    }
3414
3415    unless (chown($uid, $gid, $home_dir)) {
3416      die("Can't set owner of $home_dir to $uid/$gid: $!");
3417    }
3418  }
3419
3420  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3421    '/bin/bash');
3422  auth_group_write($auth_group_file, $group, $gid, $user);
3423
3424  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3425  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3426  my $ecdsa384_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa384_key');
3427
3428  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
3429  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
3430  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
3431
3432  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
3433  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
3434    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
3435  }
3436
3437  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
3438  if (open(my $fh, "> $src_file")) {
3439    print $fh "Hello, World!\n";
3440
3441    unless (close($fh)) {
3442      die("Can't write $src_file: $!");
3443    }
3444
3445  } else {
3446    die("Can't open $src_file: $!");
3447  }
3448
3449  my $src_sz = (stat($src_file))[7];
3450
3451  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
3452
3453  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
3454  if (open(my $fh, "> $ssh_config")) {
3455    print $fh <<EOC;
3456HostKeyAlgorithms ssh-rsa
3457KexAlgorithms ecdh-sha2-nistp384
3458EOC
3459    unless (close($fh)) {
3460      die("Can't write $ssh_config: $!");
3461    }
3462
3463  } else {
3464    die("Can't open $ssh_config: $!");
3465  }
3466
3467  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
3468  if (open(my $fh, "> $batch_file")) {
3469    print $fh "put -P $src_file $dst_file\n";
3470
3471    unless (close($fh)) {
3472      die("Can't write $batch_file: $!");
3473    }
3474
3475  } else {
3476    die("Can't open $batch_file: $!");
3477  }
3478
3479  my $config = {
3480    PidFile => $pid_file,
3481    ScoreboardFile => $scoreboard_file,
3482    SystemLog => $log_file,
3483    TraceLog => $log_file,
3484    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3485
3486    AuthUserFile => $auth_user_file,
3487    AuthGroupFile => $auth_group_file,
3488
3489    IfModules => {
3490      'mod_delay.c' => {
3491        DelayEngine => 'off',
3492      },
3493
3494      'mod_sftp.c' => [
3495        "SFTPEngine on",
3496        "SFTPLog $log_file",
3497
3498        "SFTPHostKey $rsa_host_key",
3499        "SFTPHostKey $dsa_host_key",
3500        "SFTPHostKey $ecdsa384_host_key",
3501
3502        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
3503      ],
3504    },
3505  };
3506
3507  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3508
3509  # Open pipes, for use between the parent and child processes.  Specifically,
3510  # the child will indicate when it's done with its test by writing a message
3511  # to the parent.
3512  my ($rfh, $wfh);
3513  unless (pipe($rfh, $wfh)) {
3514    die("Can't open pipe: $!");
3515  }
3516
3517  require Net::SSH2;
3518
3519  my $ex;
3520
3521  # Fork child
3522  $self->handle_sigchld();
3523  defined(my $pid = fork()) or die("Can't fork: $!");
3524  if ($pid) {
3525    eval {
3526
3527      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
3528      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
3529
3530      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
3531
3532      my @cmd = (
3533        $sftp,
3534        '-F',
3535        $ssh_config,
3536        '-oBatchMode=yes',
3537        '-oCheckHostIP=no',
3538        '-oCompression=yes',
3539        "-oPort=$port",
3540        "-oIdentityFile=$rsa_priv_key",
3541        '-oPubkeyAuthentication=yes',
3542        '-oStrictHostKeyChecking=no',
3543        '-vvv',
3544        '-b',
3545        $batch_file,
3546        "$user\@127.0.0.1",
3547      );
3548
3549      my $sftp_rh = IO::Handle->new();
3550      my $sftp_wh = IO::Handle->new();
3551      my $sftp_eh = IO::Handle->new();
3552
3553      $sftp_wh->autoflush(1);
3554
3555      sleep(1);
3556
3557      local $SIG{CHLD} = 'DEFAULT';
3558
3559      # Make sure that the perms on the priv key are what OpenSSH wants
3560      unless (chmod(0400, $rsa_priv_key)) {
3561        die("Can't set perms on $rsa_priv_key to 0400: $!");
3562      }
3563
3564      if ($ENV{TEST_VERBOSE}) {
3565        print STDERR "Executing: ", join(' ', @cmd), "\n";
3566      }
3567
3568      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
3569      waitpid($sftp_pid, 0);
3570      my $exit_status = $?;
3571
3572      # Restore the perms on the priv key
3573      unless (chmod(0644, $rsa_priv_key)) {
3574        die("Can't set perms on $rsa_priv_key to 0644: $!");
3575      }
3576
3577      my ($res, $errstr);
3578      if ($exit_status >> 8 == 0) {
3579        $errstr = join('', <$sftp_eh>);
3580        $res = 0;
3581
3582      } else {
3583        $errstr = join('', <$sftp_eh>);
3584        if ($ENV{TEST_VERBOSE}) {
3585          print STDERR "Stderr: $errstr\n";
3586        }
3587
3588        $res = 1;
3589      }
3590
3591      unless ($res == 0) {
3592        die("Can't upload $src_file to server: $errstr");
3593      }
3594
3595      unless (-f $dst_file) {
3596        die("File '$dst_file' does not exist as expected");
3597      }
3598
3599      my $sz = (stat($dst_file))[7];
3600      my $expected_sz = $src_sz;
3601      $self->assert($expected_sz == $sz,
3602        test_msg("Expected file size $expected_sz, got $sz"));
3603
3604    };
3605
3606    if ($@) {
3607      $ex = $@;
3608    }
3609
3610    $wfh->print("done\n");
3611    $wfh->flush();
3612
3613  } else {
3614    eval { server_wait($config_file, $rfh) };
3615    if ($@) {
3616      warn($@);
3617      exit 1;
3618    }
3619
3620    exit 0;
3621  }
3622
3623  # Stop server
3624  server_stop($pid_file);
3625
3626  $self->assert_child_ok($pid);
3627
3628  if ($ex) {
3629    test_append_logfile($log_file, $ex);
3630    unlink($log_file);
3631
3632    die($ex);
3633  }
3634
3635  unlink($log_file);
3636}
3637
3638sub ssh2_ext_kex_ecdh_sha2_nistp521 {
3639  my $self = shift;
3640  my $tmpdir = $self->{tmpdir};
3641
3642  my $config_file = "$tmpdir/sftp.conf";
3643  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3644  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3645
3646  my $log_file = test_get_logfile();
3647
3648  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3649  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3650
3651  my $user = 'proftpd';
3652  my $passwd = 'test';
3653  my $group = 'ftpd';
3654  my $home_dir = File::Spec->rel2abs($tmpdir);
3655  my $uid = 500;
3656  my $gid = 500;
3657
3658  # Make sure that, if we're running as root, that the home directory has
3659  # permissions/privs set for the account we create
3660  if ($< == 0) {
3661    unless (chmod(0755, $home_dir)) {
3662      die("Can't set perms on $home_dir to 0755: $!");
3663    }
3664
3665    unless (chown($uid, $gid, $home_dir)) {
3666      die("Can't set owner of $home_dir to $uid/$gid: $!");
3667    }
3668  }
3669
3670  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3671    '/bin/bash');
3672  auth_group_write($auth_group_file, $group, $gid, $user);
3673
3674  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3675  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3676  my $ecdsa521_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa521_key');
3677
3678  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
3679  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
3680  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
3681
3682  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
3683  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
3684    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
3685  }
3686
3687  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
3688  if (open(my $fh, "> $src_file")) {
3689    print $fh "Hello, World!\n";
3690
3691    unless (close($fh)) {
3692      die("Can't write $src_file: $!");
3693    }
3694
3695  } else {
3696    die("Can't open $src_file: $!");
3697  }
3698
3699  my $src_sz = (stat($src_file))[7];
3700
3701  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
3702
3703  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
3704  if (open(my $fh, "> $ssh_config")) {
3705    print $fh <<EOC;
3706HostKeyAlgorithms ssh-rsa
3707KexAlgorithms ecdh-sha2-nistp521
3708EOC
3709    unless (close($fh)) {
3710      die("Can't write $ssh_config: $!");
3711    }
3712
3713  } else {
3714    die("Can't open $ssh_config: $!");
3715  }
3716
3717  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
3718  if (open(my $fh, "> $batch_file")) {
3719    print $fh "put -P $src_file $dst_file\n";
3720
3721    unless (close($fh)) {
3722      die("Can't write $batch_file: $!");
3723    }
3724
3725  } else {
3726    die("Can't open $batch_file: $!");
3727  }
3728
3729  my $config = {
3730    PidFile => $pid_file,
3731    ScoreboardFile => $scoreboard_file,
3732    SystemLog => $log_file,
3733    TraceLog => $log_file,
3734    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3735
3736    AuthUserFile => $auth_user_file,
3737    AuthGroupFile => $auth_group_file,
3738
3739    IfModules => {
3740      'mod_delay.c' => {
3741        DelayEngine => 'off',
3742      },
3743
3744      'mod_sftp.c' => [
3745        "SFTPEngine on",
3746        "SFTPLog $log_file",
3747
3748        "SFTPHostKey $rsa_host_key",
3749        "SFTPHostKey $dsa_host_key",
3750        "SFTPHostKey $ecdsa521_host_key",
3751
3752        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
3753      ],
3754    },
3755  };
3756
3757  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3758
3759  # Open pipes, for use between the parent and child processes.  Specifically,
3760  # the child will indicate when it's done with its test by writing a message
3761  # to the parent.
3762  my ($rfh, $wfh);
3763  unless (pipe($rfh, $wfh)) {
3764    die("Can't open pipe: $!");
3765  }
3766
3767  require Net::SSH2;
3768
3769  my $ex;
3770
3771  # Fork child
3772  $self->handle_sigchld();
3773  defined(my $pid = fork()) or die("Can't fork: $!");
3774  if ($pid) {
3775    eval {
3776
3777      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
3778      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
3779
3780      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
3781
3782      my @cmd = (
3783        $sftp,
3784        '-F',
3785        $ssh_config,
3786        '-oBatchMode=yes',
3787        '-oCheckHostIP=no',
3788        '-oCompression=yes',
3789        "-oPort=$port",
3790        "-oIdentityFile=$rsa_priv_key",
3791        '-oPubkeyAuthentication=yes',
3792        '-oStrictHostKeyChecking=no',
3793        '-vvv',
3794        '-b',
3795        $batch_file,
3796        "$user\@127.0.0.1",
3797      );
3798
3799      my $sftp_rh = IO::Handle->new();
3800      my $sftp_wh = IO::Handle->new();
3801      my $sftp_eh = IO::Handle->new();
3802
3803      $sftp_wh->autoflush(1);
3804
3805      sleep(1);
3806
3807      local $SIG{CHLD} = 'DEFAULT';
3808
3809      # Make sure that the perms on the priv key are what OpenSSH wants
3810      unless (chmod(0400, $rsa_priv_key)) {
3811        die("Can't set perms on $rsa_priv_key to 0400: $!");
3812      }
3813
3814      if ($ENV{TEST_VERBOSE}) {
3815        print STDERR "Executing: ", join(' ', @cmd), "\n";
3816      }
3817
3818      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
3819      waitpid($sftp_pid, 0);
3820      my $exit_status = $?;
3821
3822      # Restore the perms on the priv key
3823      unless (chmod(0644, $rsa_priv_key)) {
3824        die("Can't set perms on $rsa_priv_key to 0644: $!");
3825      }
3826
3827      my ($res, $errstr);
3828      if ($exit_status >> 8 == 0) {
3829        $errstr = join('', <$sftp_eh>);
3830        $res = 0;
3831
3832      } else {
3833        $errstr = join('', <$sftp_eh>);
3834        if ($ENV{TEST_VERBOSE}) {
3835          print STDERR "Stderr: $errstr\n";
3836        }
3837
3838        $res = 1;
3839      }
3840
3841      unless ($res == 0) {
3842        die("Can't upload $src_file to server: $errstr");
3843      }
3844
3845      unless (-f $dst_file) {
3846        die("File '$dst_file' does not exist as expected");
3847      }
3848
3849      my $sz = (stat($dst_file))[7];
3850      my $expected_sz = $src_sz;
3851      $self->assert($expected_sz == $sz,
3852        test_msg("Expected file size $expected_sz, got $sz"));
3853
3854    };
3855
3856    if ($@) {
3857      $ex = $@;
3858    }
3859
3860    $wfh->print("done\n");
3861    $wfh->flush();
3862
3863  } else {
3864    eval { server_wait($config_file, $rfh) };
3865    if ($@) {
3866      warn($@);
3867      exit 1;
3868    }
3869
3870    exit 0;
3871  }
3872
3873  # Stop server
3874  server_stop($pid_file);
3875
3876  $self->assert_child_ok($pid);
3877
3878  if ($ex) {
3879    test_append_logfile($log_file, $ex);
3880    unlink($log_file);
3881
3882    die($ex);
3883  }
3884
3885  unlink($log_file);
3886}
3887
3888sub ssh2_hostkey_rsa {
3889  my $self = shift;
3890  my $tmpdir = $self->{tmpdir};
3891
3892  my $config_file = "$tmpdir/sftp.conf";
3893  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3894  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3895
3896  my $log_file = test_get_logfile();
3897
3898  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3899  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3900
3901  my $user = 'proftpd';
3902  my $passwd = 'test';
3903  my $group = 'ftpd';
3904  my $home_dir = File::Spec->rel2abs($tmpdir);
3905  my $uid = 500;
3906  my $gid = 500;
3907
3908  # Make sure that, if we're running as root, that the home directory has
3909  # permissions/privs set for the account we create
3910  if ($< == 0) {
3911    unless (chmod(0755, $home_dir)) {
3912      die("Can't set perms on $home_dir to 0755: $!");
3913    }
3914
3915    unless (chown($uid, $gid, $home_dir)) {
3916      die("Can't set owner of $home_dir to $uid/$gid: $!");
3917    }
3918  }
3919
3920  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3921    '/bin/bash');
3922  auth_group_write($auth_group_file, $group, $gid, $user);
3923
3924  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3925  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3926
3927  my $config = {
3928    PidFile => $pid_file,
3929    ScoreboardFile => $scoreboard_file,
3930    SystemLog => $log_file,
3931    TraceLog => $log_file,
3932    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3933
3934    AuthUserFile => $auth_user_file,
3935    AuthGroupFile => $auth_group_file,
3936
3937    IfModules => {
3938      'mod_delay.c' => {
3939        DelayEngine => 'off',
3940      },
3941
3942      'mod_sftp.c' => [
3943        "SFTPEngine on",
3944        "SFTPLog $log_file",
3945        "SFTPHostKey $rsa_host_key",
3946        "SFTPHostKey $dsa_host_key",
3947      ],
3948    },
3949  };
3950
3951  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3952
3953  # Open pipes, for use between the parent and child processes.  Specifically,
3954  # the child will indicate when it's done with its test by writing a message
3955  # to the parent.
3956  my ($rfh, $wfh);
3957  unless (pipe($rfh, $wfh)) {
3958    die("Can't open pipe: $!");
3959  }
3960
3961  require Net::SSH2;
3962
3963  my $ex;
3964
3965  # Fork child
3966  $self->handle_sigchld();
3967  defined(my $pid = fork()) or die("Can't fork: $!");
3968  if ($pid) {
3969    eval {
3970      my $ssh2 = Net::SSH2->new();
3971
3972      sleep(1);
3973
3974      my $hostkey = 'ssh-rsa';
3975      $ssh2->method('hostkey', $hostkey);
3976
3977      unless ($ssh2->connect('127.0.0.1', $port)) {
3978        my ($err_code, $err_name, $err_str) = $ssh2->error();
3979        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
3980      }
3981
3982      my $hostkey_used = $ssh2->method('hostkey');
3983      $self->assert($hostkey eq $hostkey_used,
3984        test_msg("Expected '$hostkey', got '$hostkey_used'"));
3985
3986      $ssh2->disconnect();
3987    };
3988
3989    if ($@) {
3990      $ex = $@;
3991    }
3992
3993    $wfh->print("done\n");
3994    $wfh->flush();
3995
3996  } else {
3997    eval { server_wait($config_file, $rfh) };
3998    if ($@) {
3999      warn($@);
4000      exit 1;
4001    }
4002
4003    exit 0;
4004  }
4005
4006  # Stop server
4007  server_stop($pid_file);
4008
4009  $self->assert_child_ok($pid);
4010
4011  if ($ex) {
4012    test_append_logfile($log_file, $ex);
4013    unlink($log_file);
4014
4015    die($ex);
4016  }
4017
4018  unlink($log_file);
4019}
4020
4021sub ssh2_hostkey_rsa_only {
4022  my $self = shift;
4023  my $tmpdir = $self->{tmpdir};
4024
4025  my $config_file = "$tmpdir/sftp.conf";
4026  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
4027  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
4028
4029  my $log_file = test_get_logfile();
4030
4031  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
4032  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
4033
4034  my $user = 'proftpd';
4035  my $passwd = 'test';
4036  my $group = 'ftpd';
4037  my $home_dir = File::Spec->rel2abs($tmpdir);
4038  my $uid = 500;
4039  my $gid = 500;
4040
4041  # Make sure that, if we're running as root, that the home directory has
4042  # permissions/privs set for the account we create
4043  if ($< == 0) {
4044    unless (chmod(0755, $home_dir)) {
4045      die("Can't set perms on $home_dir to 0755: $!");
4046    }
4047
4048    unless (chown($uid, $gid, $home_dir)) {
4049      die("Can't set owner of $home_dir to $uid/$gid: $!");
4050    }
4051  }
4052
4053  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
4054    '/bin/bash');
4055  auth_group_write($auth_group_file, $group, $gid, $user);
4056
4057  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
4058
4059  my $config = {
4060    PidFile => $pid_file,
4061    ScoreboardFile => $scoreboard_file,
4062    SystemLog => $log_file,
4063    TraceLog => $log_file,
4064    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
4065
4066    AuthUserFile => $auth_user_file,
4067    AuthGroupFile => $auth_group_file,
4068
4069    IfModules => {
4070      'mod_delay.c' => {
4071        DelayEngine => 'off',
4072      },
4073
4074      'mod_sftp.c' => [
4075        "SFTPEngine on",
4076        "SFTPLog $log_file",
4077        "SFTPHostKey $rsa_host_key",
4078      ],
4079    },
4080  };
4081
4082  my ($port, $config_user, $config_group) = config_write($config_file, $config);
4083
4084  # Open pipes, for use between the parent and child processes.  Specifically,
4085  # the child will indicate when it's done with its test by writing a message
4086  # to the parent.
4087  my ($rfh, $wfh);
4088  unless (pipe($rfh, $wfh)) {
4089    die("Can't open pipe: $!");
4090  }
4091
4092  require Net::SSH2;
4093
4094  my $ex;
4095
4096  # Fork child
4097  $self->handle_sigchld();
4098  defined(my $pid = fork()) or die("Can't fork: $!");
4099  if ($pid) {
4100    eval {
4101      my $ssh2 = Net::SSH2->new();
4102
4103      sleep(1);
4104
4105      my $hostkey = 'ssh-rsa';
4106      $ssh2->method('hostkey', $hostkey);
4107
4108      unless ($ssh2->connect('127.0.0.1', $port)) {
4109        my ($err_code, $err_name, $err_str) = $ssh2->error();
4110        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
4111      }
4112
4113      my $hostkey_used = $ssh2->method('hostkey');
4114      $self->assert($hostkey eq $hostkey_used,
4115        test_msg("Expected '$hostkey', got '$hostkey_used'"));
4116
4117      $ssh2->disconnect();
4118
4119      # Test that using ssh-dss does NOT work
4120      $hostkey = 'ssh-dss';
4121      $ssh2->method('hostkey', $hostkey);
4122
4123      if ($ssh2->connect('127.0.0.1', $port)) {
4124        die("Connect to SSH2 server unexpectedly");
4125      }
4126
4127      my ($err_code, $err_name, $err_str) = $ssh2->error();
4128
4129      # The expected error messages depend on the version of libssh2 being
4130      # used.
4131      $self->assert($err_name eq 'LIBSSH2_ERROR_KEX_FAILURE' or
4132                    $err_name eq 'LIBSSH2_ERROR_KEY_EXCHANGE_FAILURE',
4133        test_msg("Expected 'LIBSSH2_ERROR_KEX_FAILURE' or 'LIBSSH2_ERROR_KEY_EXCHANGE_FAILURE', got '$err_name'"));
4134    };
4135
4136    if ($@) {
4137      $ex = $@;
4138    }
4139
4140    $wfh->print("done\n");
4141    $wfh->flush();
4142
4143  } else {
4144    eval { server_wait($config_file, $rfh) };
4145    if ($@) {
4146      warn($@);
4147      exit 1;
4148    }
4149
4150    exit 0;
4151  }
4152
4153  # Stop server
4154  server_stop($pid_file);
4155
4156  $self->assert_child_ok($pid);
4157
4158  if ($ex) {
4159    test_append_logfile($log_file, $ex);
4160    unlink($log_file);
4161
4162    die($ex);
4163  }
4164
4165  unlink($log_file);
4166}
4167
4168sub ssh2_ext_hostkey_rsa_sha256 {
4169  my $self = shift;
4170  my $tmpdir = $self->{tmpdir};
4171  my $setup = test_setup($tmpdir, 'sftp');
4172
4173  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
4174
4175  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
4176  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
4177  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
4178
4179  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
4180  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
4181    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
4182  }
4183
4184  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
4185  if (open(my $fh, "> $ssh_config")) {
4186    print $fh <<EOC;
4187HostKeyAlgorithms rsa-sha2-256
4188IdentityAgent none
4189PubkeyAcceptedKeyTypes rsa-sha2-256
4190EOC
4191    unless (close($fh)) {
4192      die("Can't write $ssh_config: $!");
4193    }
4194
4195  } else {
4196    die("Can't open $ssh_config: $!");
4197  }
4198
4199  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
4200  if (open(my $fh, "> $batch_file")) {
4201    print $fh "ls\n";
4202
4203    unless (close($fh)) {
4204      die("Can't write $batch_file: $!");
4205    }
4206
4207  } else {
4208    die("Can't open $batch_file: $!");
4209  }
4210
4211  my $config = {
4212    PidFile => $setup->{pid_file},
4213    ScoreboardFile => $setup->{scoreboard_file},
4214    SystemLog => $setup->{log_file},
4215    TraceLog => $setup->{log_file},
4216    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
4217
4218    AuthUserFile => $setup->{auth_user_file},
4219    AuthGroupFile => $setup->{auth_group_file},
4220
4221    IfModules => {
4222      'mod_delay.c' => {
4223        DelayEngine => 'off',
4224      },
4225
4226      'mod_sftp.c' => [
4227        "SFTPEngine on",
4228        "SFTPLog $setup->{log_file}",
4229
4230        "SFTPHostKey $rsa_host_key",
4231        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
4232      ],
4233    },
4234  };
4235
4236  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
4237    $config);
4238
4239  # Open pipes, for use between the parent and child processes.  Specifically,
4240  # the child will indicate when it's done with its test by writing a message
4241  # to the parent.
4242  my ($rfh, $wfh);
4243  unless (pipe($rfh, $wfh)) {
4244    die("Can't open pipe: $!");
4245  }
4246
4247  require Net::SSH2;
4248
4249  my $ex;
4250
4251  # Fork child
4252  $self->handle_sigchld();
4253  defined(my $pid = fork()) or die("Can't fork: $!");
4254  if ($pid) {
4255    eval {
4256      # libssh2, and thus Net::SSH2, don't support rsa-sha256 yet.  So we
4257      # use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
4258      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
4259
4260      # Since we are using a non-standard sftp(1), make sure the system
4261      # ssh-agent, which may not support SHA-2 signatures, is not involved.
4262      $ENV{SSH_AUTH_SOCK} = '';
4263
4264      my @cmd = (
4265        $sftp,
4266        '-F',
4267        $ssh_config,
4268        '-oBatchMode=yes',
4269        '-oCheckHostIP=no',
4270        '-oCompression=yes',
4271        "-oPort=$port",
4272        "-oIdentityFile=$rsa_priv_key",
4273        '-oPubkeyAuthentication=yes',
4274        '-oStrictHostKeyChecking=no',
4275        '-vvv',
4276        '-b',
4277        $batch_file,
4278        "$setup->{user}\@127.0.0.1",
4279      );
4280
4281      my $sftp_rh = IO::Handle->new();
4282      my $sftp_wh = IO::Handle->new();
4283      my $sftp_eh = IO::Handle->new();
4284
4285      $sftp_wh->autoflush(1);
4286
4287      sleep(1);
4288
4289      local $SIG{CHLD} = 'DEFAULT';
4290
4291      # Make sure that the perms on the priv key are what OpenSSH wants
4292      unless (chmod(0400, $rsa_priv_key)) {
4293        die("Can't set perms on $rsa_priv_key to 0400: $!");
4294      }
4295
4296      if ($ENV{TEST_VERBOSE}) {
4297        print STDERR "Executing: ", join(' ', @cmd), "\n";
4298      }
4299
4300      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
4301      waitpid($sftp_pid, 0);
4302      my $exit_status = $?;
4303
4304      # Restore the perms on the priv key
4305      unless (chmod(0644, $rsa_priv_key)) {
4306        die("Can't set perms on $rsa_priv_key to 0644: $!");
4307      }
4308
4309      my ($res, $errstr);
4310      if ($exit_status >> 8 == 0) {
4311        $errstr = join('', <$sftp_eh>);
4312        $res = 0;
4313
4314      } else {
4315        $errstr = join('', <$sftp_eh>);
4316        if ($ENV{TEST_VERBOSE}) {
4317          print STDERR "Stderr: $errstr\n";
4318        }
4319
4320        $res = 1;
4321      }
4322
4323      unless ($res == 0) {
4324        die("Can't login to server: $errstr");
4325      }
4326    };
4327    if ($@) {
4328      $ex = $@;
4329    }
4330
4331    $wfh->print("done\n");
4332    $wfh->flush();
4333
4334  } else {
4335    eval { server_wait($setup->{config_file}, $rfh) };
4336    if ($@) {
4337      warn($@);
4338      exit 1;
4339    }
4340
4341    exit 0;
4342  }
4343
4344  # Stop server
4345  server_stop($setup->{pid_file});
4346  $self->assert_child_ok($pid);
4347
4348  test_cleanup($setup->{log_file}, $ex);
4349}
4350
4351sub ssh2_ext_hostkey_rsa_sha512 {
4352  my $self = shift;
4353  my $tmpdir = $self->{tmpdir};
4354  my $setup = test_setup($tmpdir, 'sftp');
4355
4356  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
4357
4358  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
4359  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
4360  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
4361
4362  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
4363  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
4364    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
4365  }
4366
4367  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
4368  if (open(my $fh, "> $ssh_config")) {
4369    print $fh <<EOC;
4370HostKeyAlgorithms rsa-sha2-512
4371IdentityAgent none
4372PubkeyAcceptedKeyTypes rsa-sha2-512
4373EOC
4374    unless (close($fh)) {
4375      die("Can't write $ssh_config: $!");
4376    }
4377
4378  } else {
4379    die("Can't open $ssh_config: $!");
4380  }
4381
4382  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
4383  if (open(my $fh, "> $batch_file")) {
4384    print $fh "ls\n";
4385
4386    unless (close($fh)) {
4387      die("Can't write $batch_file: $!");
4388    }
4389
4390  } else {
4391    die("Can't open $batch_file: $!");
4392  }
4393
4394  my $config = {
4395    PidFile => $setup->{pid_file},
4396    ScoreboardFile => $setup->{scoreboard_file},
4397    SystemLog => $setup->{log_file},
4398    TraceLog => $setup->{log_file},
4399    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
4400
4401    AuthUserFile => $setup->{auth_user_file},
4402    AuthGroupFile => $setup->{auth_group_file},
4403
4404    IfModules => {
4405      'mod_delay.c' => {
4406        DelayEngine => 'off',
4407      },
4408
4409      'mod_sftp.c' => [
4410        "SFTPEngine on",
4411        "SFTPLog $setup->{log_file}",
4412
4413        "SFTPHostKey $rsa_host_key",
4414        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
4415      ],
4416    },
4417  };
4418
4419  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
4420    $config);
4421
4422  # Open pipes, for use between the parent and child processes.  Specifically,
4423  # the child will indicate when it's done with its test by writing a message
4424  # to the parent.
4425  my ($rfh, $wfh);
4426  unless (pipe($rfh, $wfh)) {
4427    die("Can't open pipe: $!");
4428  }
4429
4430  require Net::SSH2;
4431
4432  my $ex;
4433
4434  # Fork child
4435  $self->handle_sigchld();
4436  defined(my $pid = fork()) or die("Can't fork: $!");
4437  if ($pid) {
4438    eval {
4439      # libssh2, and thus Net::SSH2, don't support rsa-sha512 yet.  So we
4440      # use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
4441      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
4442
4443      my @cmd = (
4444        $sftp,
4445        '-F',
4446        $ssh_config,
4447        '-oBatchMode=yes',
4448        '-oCheckHostIP=no',
4449        '-oCompression=yes',
4450        "-oPort=$port",
4451        "-oIdentityFile=$rsa_priv_key",
4452        '-oPubkeyAuthentication=yes',
4453        '-oStrictHostKeyChecking=no',
4454        '-vvv',
4455        '-b',
4456        $batch_file,
4457        "$setup->{user}\@127.0.0.1",
4458      );
4459
4460      my $sftp_rh = IO::Handle->new();
4461      my $sftp_wh = IO::Handle->new();
4462      my $sftp_eh = IO::Handle->new();
4463
4464      $sftp_wh->autoflush(1);
4465
4466      sleep(1);
4467
4468      local $SIG{CHLD} = 'DEFAULT';
4469
4470      # Make sure that the perms on the priv key are what OpenSSH wants
4471      unless (chmod(0400, $rsa_priv_key)) {
4472        die("Can't set perms on $rsa_priv_key to 0400: $!");
4473      }
4474
4475      if ($ENV{TEST_VERBOSE}) {
4476        print STDERR "Executing: ", join(' ', @cmd), "\n";
4477      }
4478
4479      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
4480      waitpid($sftp_pid, 0);
4481      my $exit_status = $?;
4482
4483      # Restore the perms on the priv key
4484      unless (chmod(0644, $rsa_priv_key)) {
4485        die("Can't set perms on $rsa_priv_key to 0644: $!");
4486      }
4487
4488      my ($res, $errstr);
4489      if ($exit_status >> 8 == 0) {
4490        $errstr = join('', <$sftp_eh>);
4491        $res = 0;
4492
4493      } else {
4494        $errstr = join('', <$sftp_eh>);
4495        if ($ENV{TEST_VERBOSE}) {
4496          print STDERR "Stderr: $errstr\n";
4497        }
4498
4499        $res = 1;
4500      }
4501
4502      unless ($res == 0) {
4503        die("Can't login to server: $errstr");
4504      }
4505    };
4506    if ($@) {
4507      $ex = $@;
4508    }
4509
4510    $wfh->print("done\n");
4511    $wfh->flush();
4512
4513  } else {
4514    eval { server_wait($setup->{config_file}, $rfh) };
4515    if ($@) {
4516      warn($@);
4517      exit 1;
4518    }
4519
4520    exit 0;
4521  }
4522
4523  # Stop server
4524  server_stop($setup->{pid_file});
4525  $self->assert_child_ok($pid);
4526
4527  test_cleanup($setup->{log_file}, $ex);
4528}
4529
4530sub ssh2_hostkey_dss {
4531  my $self = shift;
4532  my $tmpdir = $self->{tmpdir};
4533
4534  my $config_file = "$tmpdir/sftp.conf";
4535  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
4536  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
4537
4538  my $log_file = test_get_logfile();
4539
4540  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
4541  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
4542
4543  my $user = 'proftpd';
4544  my $passwd = 'test';
4545  my $group = 'ftpd';
4546  my $home_dir = File::Spec->rel2abs($tmpdir);
4547  my $uid = 500;
4548  my $gid = 500;
4549
4550  # Make sure that, if we're running as root, that the home directory has
4551  # permissions/privs set for the account we create
4552  if ($< == 0) {
4553    unless (chmod(0755, $home_dir)) {
4554      die("Can't set perms on $home_dir to 0755: $!");
4555    }
4556
4557    unless (chown($uid, $gid, $home_dir)) {
4558      die("Can't set owner of $home_dir to $uid/$gid: $!");
4559    }
4560  }
4561
4562  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
4563    '/bin/bash');
4564  auth_group_write($auth_group_file, $group, $gid, $user);
4565
4566  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
4567  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
4568
4569  my $config = {
4570    PidFile => $pid_file,
4571    ScoreboardFile => $scoreboard_file,
4572    SystemLog => $log_file,
4573    TraceLog => $log_file,
4574    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
4575
4576    AuthUserFile => $auth_user_file,
4577    AuthGroupFile => $auth_group_file,
4578
4579    IfModules => {
4580      'mod_delay.c' => {
4581        DelayEngine => 'off',
4582      },
4583
4584      'mod_sftp.c' => [
4585        "SFTPEngine on",
4586        "SFTPLog $log_file",
4587        "SFTPHostKey $rsa_host_key",
4588        "SFTPHostKey $dsa_host_key",
4589      ],
4590    },
4591  };
4592
4593  my ($port, $config_user, $config_group) = config_write($config_file, $config);
4594
4595  # Open pipes, for use between the parent and child processes.  Specifically,
4596  # the child will indicate when it's done with its test by writing a message
4597  # to the parent.
4598  my ($rfh, $wfh);
4599  unless (pipe($rfh, $wfh)) {
4600    die("Can't open pipe: $!");
4601  }
4602
4603  require Net::SSH2;
4604
4605  my $ex;
4606
4607  # Fork child
4608  $self->handle_sigchld();
4609  defined(my $pid = fork()) or die("Can't fork: $!");
4610  if ($pid) {
4611    eval {
4612      my $ssh2 = Net::SSH2->new();
4613
4614      sleep(1);
4615
4616      my $hostkey = 'ssh-dss';
4617      $ssh2->method('hostkey', $hostkey);
4618
4619      unless ($ssh2->connect('127.0.0.1', $port)) {
4620        my ($err_code, $err_name, $err_str) = $ssh2->error();
4621        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
4622      }
4623
4624      my $hostkey_used = $ssh2->method('hostkey');
4625      $self->assert($hostkey eq $hostkey_used,
4626        test_msg("Expected '$hostkey', got '$hostkey_used'"));
4627
4628      $ssh2->disconnect();
4629    };
4630
4631    if ($@) {
4632      $ex = $@;
4633    }
4634
4635    $wfh->print("done\n");
4636    $wfh->flush();
4637
4638  } else {
4639    eval { server_wait($config_file, $rfh) };
4640    if ($@) {
4641      warn($@);
4642      exit 1;
4643    }
4644
4645    exit 0;
4646  }
4647
4648  # Stop server
4649  server_stop($pid_file);
4650
4651  $self->assert_child_ok($pid);
4652
4653  if ($ex) {
4654    test_append_logfile($log_file, $ex);
4655    unlink($log_file);
4656
4657    die($ex);
4658  }
4659
4660  unlink($log_file);
4661}
4662
4663sub ssh2_hostkey_dss_only {
4664  my $self = shift;
4665  my $tmpdir = $self->{tmpdir};
4666
4667  my $config_file = "$tmpdir/sftp.conf";
4668  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
4669  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
4670
4671  my $log_file = test_get_logfile();
4672
4673  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
4674  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
4675
4676  my $user = 'proftpd';
4677  my $passwd = 'test';
4678  my $group = 'ftpd';
4679  my $home_dir = File::Spec->rel2abs($tmpdir);
4680  my $uid = 500;
4681  my $gid = 500;
4682
4683  # Make sure that, if we're running as root, that the home directory has
4684  # permissions/privs set for the account we create
4685  if ($< == 0) {
4686    unless (chmod(0755, $home_dir)) {
4687      die("Can't set perms on $home_dir to 0755: $!");
4688    }
4689
4690    unless (chown($uid, $gid, $home_dir)) {
4691      die("Can't set owner of $home_dir to $uid/$gid: $!");
4692    }
4693  }
4694
4695  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
4696    '/bin/bash');
4697  auth_group_write($auth_group_file, $group, $gid, $user);
4698
4699  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
4700
4701  my $config = {
4702    PidFile => $pid_file,
4703    ScoreboardFile => $scoreboard_file,
4704    SystemLog => $log_file,
4705    TraceLog => $log_file,
4706    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
4707
4708    AuthUserFile => $auth_user_file,
4709    AuthGroupFile => $auth_group_file,
4710
4711    IfModules => {
4712      'mod_delay.c' => {
4713        DelayEngine => 'off',
4714      },
4715
4716      'mod_sftp.c' => [
4717        "SFTPEngine on",
4718        "SFTPLog $log_file",
4719        "SFTPHostKey $dsa_host_key",
4720      ],
4721    },
4722  };
4723
4724  my ($port, $config_user, $config_group) = config_write($config_file, $config);
4725
4726  # Open pipes, for use between the parent and child processes.  Specifically,
4727  # the child will indicate when it's done with its test by writing a message
4728  # to the parent.
4729  my ($rfh, $wfh);
4730  unless (pipe($rfh, $wfh)) {
4731    die("Can't open pipe: $!");
4732  }
4733
4734  require Net::SSH2;
4735
4736  my $ex;
4737
4738  # Fork child
4739  $self->handle_sigchld();
4740  defined(my $pid = fork()) or die("Can't fork: $!");
4741  if ($pid) {
4742    eval {
4743      my $ssh2 = Net::SSH2->new();
4744
4745      sleep(1);
4746
4747      my $hostkey = 'ssh-dss';
4748      $ssh2->method('hostkey', $hostkey);
4749
4750      unless ($ssh2->connect('127.0.0.1', $port)) {
4751        my ($err_code, $err_name, $err_str) = $ssh2->error();
4752        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
4753      }
4754
4755      my $hostkey_used = $ssh2->method('hostkey');
4756      $self->assert($hostkey eq $hostkey_used,
4757        test_msg("Expected '$hostkey', got '$hostkey_used'"));
4758
4759      $ssh2->disconnect();
4760
4761      # Test that using ssh-rsa does NOT work
4762      $hostkey = 'ssh-rsa';
4763      $ssh2->method('hostkey', $hostkey);
4764
4765      if ($ssh2->connect('127.0.0.1', $port)) {
4766        die("Connect to SSH2 server unexpectedly");
4767      }
4768
4769      my ($err_code, $err_name, $err_str) = $ssh2->error();
4770
4771      # The expected error messages depend on the version of libssh2 being
4772      # used.
4773      $self->assert($err_name eq 'LIBSSH2_ERROR_KEX_FAILURE' or
4774                    $err_name eq 'LIBSSH2_ERROR_KEY_EXCHANGE_FAILURE',
4775        test_msg("Expected 'LIBSSH2_ERROR_KEX_FAILURE' or 'LIBSSH2_ERROR_KEY_EXCHANGE_FAILURE', got '$err_name'"));
4776    };
4777
4778    if ($@) {
4779      $ex = $@;
4780    }
4781
4782    $wfh->print("done\n");
4783    $wfh->flush();
4784
4785  } else {
4786    eval { server_wait($config_file, $rfh) };
4787    if ($@) {
4788      warn($@);
4789      exit 1;
4790    }
4791
4792    exit 0;
4793  }
4794
4795  # Stop server
4796  server_stop($pid_file);
4797
4798  $self->assert_child_ok($pid);
4799
4800  if ($ex) {
4801    test_append_logfile($log_file, $ex);
4802    unlink($log_file);
4803
4804    die($ex);
4805  }
4806
4807  unlink($log_file);
4808}
4809
4810sub ssh2_hostkey_dss_bug3634 {
4811  my $self = shift;
4812  my $tmpdir = $self->{tmpdir};
4813
4814  my $config_file = "$tmpdir/sftp.conf";
4815  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
4816  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
4817
4818  my $log_file = test_get_logfile();
4819
4820  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
4821  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
4822
4823  my $user = 'proftpd';
4824  my $passwd = 'test';
4825  my $group = 'ftpd';
4826  my $home_dir = File::Spec->rel2abs($tmpdir);
4827  my $uid = 500;
4828  my $gid = 500;
4829
4830  # Make sure that, if we're running as root, that the home directory has
4831  # permissions/privs set for the account we create
4832  if ($< == 0) {
4833    unless (chmod(0755, $home_dir)) {
4834      die("Can't set perms on $home_dir to 0755: $!");
4835    }
4836
4837    unless (chown($uid, $gid, $home_dir)) {
4838      die("Can't set owner of $home_dir to $uid/$gid: $!");
4839    }
4840  }
4841
4842  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
4843    '/bin/bash');
4844  auth_group_write($auth_group_file, $group, $gid, $user);
4845
4846  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
4847  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
4848
4849  my $dsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa_key');
4850  my $dsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa_key.pub');
4851  my $dsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_dsa_keys');
4852
4853  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
4854  unless (copy($dsa_rfc4716_key, $authorized_keys)) {
4855    die("Can't copy $dsa_rfc4716_key to $authorized_keys: $!");
4856  }
4857
4858  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.txt");
4859  if (open(my $fh, "> $batch_file")) {
4860    print $fh "pwd\n";
4861
4862    unless (close($fh)) {
4863      die("Can't write $batch_file: $!");
4864    }
4865
4866  } else {
4867    die("Can't open $batch_file: $!");
4868  }
4869
4870  my $count = 250;
4871  my $timeout = ($count * 2);
4872
4873  my $config = {
4874    PidFile => $pid_file,
4875    ScoreboardFile => $scoreboard_file,
4876    SystemLog => $log_file,
4877    TraceLog => $log_file,
4878    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
4879
4880    AuthUserFile => $auth_user_file,
4881    AuthGroupFile => $auth_group_file,
4882
4883    IfModules => {
4884      'mod_delay.c' => {
4885        DelayEngine => 'off',
4886      },
4887
4888      'mod_sftp.c' => [
4889        "SFTPEngine on",
4890        "SFTPLog $log_file",
4891        "SFTPHostKey $rsa_host_key",
4892        "SFTPHostKey $dsa_host_key",
4893        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
4894      ],
4895    },
4896  };
4897
4898  my ($port, $config_user, $config_group) = config_write($config_file, $config);
4899
4900  # Open pipes, for use between the parent and child processes.  Specifically,
4901  # the child will indicate when it's done with its test by writing a message
4902  # to the parent.
4903  my ($rfh, $wfh);
4904  unless (pipe($rfh, $wfh)) {
4905    die("Can't open pipe: $!");
4906  }
4907
4908  require Net::SSH2;
4909
4910  my $ex;
4911
4912  # Ignore SIGPIPE
4913  local $SIG{PIPE} = sub { };
4914
4915  # Fork child
4916  $self->handle_sigchld();
4917  defined(my $pid = fork()) or die("Can't fork: $!");
4918  if ($pid) {
4919    eval {
4920      sleep(1);
4921
4922      my @cmd = (
4923        'sftp',
4924        '-oBatchMode=yes',
4925        '-oCheckHostIP=no',
4926        '-oCompression=yes',
4927        "-oPort=$port",
4928        '-oHostKeyAlgorithms=ssh-dss',
4929        "-oIdentityFile=$dsa_priv_key",
4930        '-oPubkeyAuthentication=yes',
4931        '-oStrictHostKeyChecking=no',
4932        '-vvv',
4933        '-b',
4934        "$batch_file",
4935        "$user\@127.0.0.1",
4936      );
4937
4938      for (my $i = 0; $i < $count; $i++) {
4939        if ($ENV{TEST_VERBOSE}) {
4940          print STDERR "Connect #", $i + 1, "\n";
4941        }
4942
4943        my $sftp_rh = IO::Handle->new();
4944        my $sftp_wh = IO::Handle->new();
4945        my $sftp_eh = IO::Handle->new();
4946
4947        $sftp_wh->autoflush(1);
4948
4949        sleep(1);
4950
4951        local $SIG{CHLD} = 'DEFAULT';
4952
4953        # Make sure that the perms on the priv key are what OpenSSH wants
4954        unless (chmod(0400, $dsa_priv_key)) {
4955          die("Can't set perms on $dsa_priv_key to 0400: $!");
4956        }
4957
4958        if ($ENV{TEST_VERBOSE}) {
4959          print STDERR "Executing: ", join(' ', @cmd), "\n";
4960        }
4961
4962        my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
4963        waitpid($sftp_pid, 0);
4964        my $exit_status = $?;
4965
4966        # Restore the perms on the priv key
4967        unless (chmod(0644, $dsa_priv_key)) {
4968          die("Can't set perms on $dsa_priv_key to 0644: $!");
4969        }
4970
4971        my ($res, $errstr);
4972        if ($exit_status >> 8 == 0) {
4973          $errstr = join('', <$sftp_eh>);
4974          $res = 0;
4975
4976        } else {
4977          $errstr = join('', <$sftp_eh>);
4978          if ($ENV{TEST_VERBOSE}) {
4979            print STDERR "Stderr: $errstr\n";
4980          }
4981
4982          $res = 1;
4983        }
4984
4985        $self->assert($res == 0, test_msg("Can't pwd on server: $errstr"));
4986      }
4987    };
4988
4989    if ($@) {
4990      $ex = $@;
4991    }
4992
4993    $wfh->print("done\n");
4994    $wfh->flush();
4995
4996  } else {
4997    eval { server_wait($config_file, $rfh, $timeout) };
4998    if ($@) {
4999      warn($@);
5000      exit 1;
5001    }
5002
5003    exit 0;
5004  }
5005
5006  # Stop server
5007  server_stop($pid_file);
5008
5009  $self->assert_child_ok($pid);
5010
5011  if ($ex) {
5012    test_append_logfile($log_file, $ex);
5013    unlink($log_file);
5014
5015    die($ex);
5016  }
5017
5018  unlink($log_file);
5019}
5020
5021sub ssh2_hostkey_passphraseprovider_bug3851 {
5022  my $self = shift;
5023  my $tmpdir = $self->{tmpdir};
5024
5025  my $config_file = "$tmpdir/sftp.conf";
5026  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
5027  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
5028
5029  my $log_file = test_get_logfile();
5030
5031  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
5032  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
5033
5034  my $user = 'proftpd';
5035  my $passwd = 'test';
5036  my $group = 'ftpd';
5037  my $home_dir = File::Spec->rel2abs($tmpdir);
5038  my $uid = 500;
5039  my $gid = 500;
5040
5041  # Make sure that, if we're running as root, that the home directory has
5042  # permissions/privs set for the account we create
5043  if ($< == 0) {
5044    unless (chmod(0755, $home_dir)) {
5045      die("Can't set perms on $home_dir to 0755: $!");
5046    }
5047
5048    unless (chown($uid, $gid, $home_dir)) {
5049      die("Can't set owner of $home_dir to $uid/$gid: $!");
5050    }
5051  }
5052
5053  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
5054    '/bin/bash');
5055  auth_group_write($auth_group_file, $group, $gid, $user);
5056
5057  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_rsa_key');
5058  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_dsa_key');
5059  my $passphrase_provider = File::Spec->rel2abs('t/etc/modules/mod_sftp/sftp-get-passphrase.pl');
5060
5061  my $config = {
5062    PidFile => $pid_file,
5063    ScoreboardFile => $scoreboard_file,
5064    SystemLog => $log_file,
5065    TraceLog => $log_file,
5066    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
5067
5068    AuthUserFile => $auth_user_file,
5069    AuthGroupFile => $auth_group_file,
5070
5071    IfModules => {
5072      'mod_delay.c' => {
5073        DelayEngine => 'off',
5074      },
5075
5076      'mod_sftp.c' => [
5077        "SFTPEngine on",
5078        "SFTPLog $log_file",
5079        "SFTPHostKey $rsa_host_key",
5080        "SFTPHostKey $dsa_host_key",
5081
5082        "SFTPPassPhraseProvider $passphrase_provider",
5083      ],
5084    },
5085  };
5086
5087  my ($port, $config_user, $config_group) = config_write($config_file, $config);
5088
5089  # Open pipes, for use between the parent and child processes.  Specifically,
5090  # the child will indicate when it's done with its test by writing a message
5091  # to the parent.
5092  my ($rfh, $wfh);
5093  unless (pipe($rfh, $wfh)) {
5094    die("Can't open pipe: $!");
5095  }
5096
5097  require Net::SSH2;
5098
5099  my $ex;
5100
5101  # Fork child
5102  $self->handle_sigchld();
5103  defined(my $pid = fork()) or die("Can't fork: $!");
5104  if ($pid) {
5105    eval {
5106      my $ssh2 = Net::SSH2->new();
5107
5108      sleep(1);
5109
5110      my $hostkey = 'ssh-rsa';
5111      $ssh2->method('hostkey', $hostkey);
5112
5113      unless ($ssh2->connect('127.0.0.1', $port)) {
5114        my ($err_code, $err_name, $err_str) = $ssh2->error();
5115        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
5116      }
5117
5118      my $hostkey_used = $ssh2->method('hostkey');
5119      $self->assert($hostkey eq $hostkey_used,
5120        test_msg("Expected '$hostkey', got '$hostkey_used'"));
5121
5122      $ssh2->disconnect();
5123    };
5124
5125    if ($@) {
5126      $ex = $@;
5127    }
5128
5129    $wfh->print("done\n");
5130    $wfh->flush();
5131
5132  } else {
5133    eval { server_wait($config_file, $rfh) };
5134    if ($@) {
5135      warn($@);
5136      exit 1;
5137    }
5138
5139    exit 0;
5140  }
5141
5142  # Stop server
5143  server_stop($pid_file);
5144
5145  $self->assert_child_ok($pid);
5146
5147  if ($ex) {
5148    test_append_logfile($log_file, $ex);
5149    unlink($log_file);
5150
5151    die($ex);
5152  }
5153
5154  unlink($log_file);
5155}
5156
5157sub ssh2_ext_hostkey_ecdsa256 {
5158  my $self = shift;
5159  my $tmpdir = $self->{tmpdir};
5160
5161  my $config_file = "$tmpdir/sftp.conf";
5162  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
5163  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
5164
5165  my $log_file = test_get_logfile();
5166
5167  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
5168  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
5169
5170  my $user = 'proftpd';
5171  my $passwd = 'test';
5172  my $group = 'ftpd';
5173  my $home_dir = File::Spec->rel2abs($tmpdir);
5174  my $uid = 500;
5175  my $gid = 500;
5176
5177  # Make sure that, if we're running as root, that the home directory has
5178  # permissions/privs set for the account we create
5179  if ($< == 0) {
5180    unless (chmod(0755, $home_dir)) {
5181      die("Can't set perms on $home_dir to 0755: $!");
5182    }
5183
5184    unless (chown($uid, $gid, $home_dir)) {
5185      die("Can't set owner of $home_dir to $uid/$gid: $!");
5186    }
5187  }
5188
5189  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
5190    '/bin/bash');
5191  auth_group_write($auth_group_file, $group, $gid, $user);
5192
5193  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
5194  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
5195  my $ecdsa256_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa256_key');
5196
5197  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
5198  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
5199  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
5200
5201  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
5202  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
5203    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
5204  }
5205
5206  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
5207  if (open(my $fh, "> $src_file")) {
5208    print $fh "Hello, World!\n";
5209
5210    unless (close($fh)) {
5211      die("Can't write $src_file: $!");
5212    }
5213
5214  } else {
5215    die("Can't open $src_file: $!");
5216  }
5217
5218  my $src_sz = (stat($src_file))[7];
5219
5220  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
5221
5222  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
5223  if (open(my $fh, "> $ssh_config")) {
5224    print $fh <<EOC;
5225HostKeyAlgorithms ecdsa-sha2-nistp256
5226EOC
5227    unless (close($fh)) {
5228      die("Can't write $ssh_config: $!");
5229    }
5230
5231  } else {
5232    die("Can't open $ssh_config: $!");
5233  }
5234
5235  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
5236  if (open(my $fh, "> $batch_file")) {
5237    print $fh "put -P $src_file $dst_file\n";
5238
5239    unless (close($fh)) {
5240      die("Can't write $batch_file: $!");
5241    }
5242
5243  } else {
5244    die("Can't open $batch_file: $!");
5245  }
5246
5247  my $config = {
5248    PidFile => $pid_file,
5249    ScoreboardFile => $scoreboard_file,
5250    SystemLog => $log_file,
5251    TraceLog => $log_file,
5252    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
5253
5254    AuthUserFile => $auth_user_file,
5255    AuthGroupFile => $auth_group_file,
5256
5257    IfModules => {
5258      'mod_delay.c' => {
5259        DelayEngine => 'off',
5260      },
5261
5262      'mod_sftp.c' => [
5263        "SFTPEngine on",
5264        "SFTPLog $log_file",
5265
5266        "SFTPHostKey $rsa_host_key",
5267        "SFTPHostKey $dsa_host_key",
5268        "SFTPHostKey $ecdsa256_host_key",
5269
5270        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
5271      ],
5272    },
5273  };
5274
5275  my ($port, $config_user, $config_group) = config_write($config_file, $config);
5276
5277  # Open pipes, for use between the parent and child processes.  Specifically,
5278  # the child will indicate when it's done with its test by writing a message
5279  # to the parent.
5280  my ($rfh, $wfh);
5281  unless (pipe($rfh, $wfh)) {
5282    die("Can't open pipe: $!");
5283  }
5284
5285  require Net::SSH2;
5286
5287  my $ex;
5288
5289  # Fork child
5290  $self->handle_sigchld();
5291  defined(my $pid = fork()) or die("Can't fork: $!");
5292  if ($pid) {
5293    eval {
5294
5295      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
5296      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
5297
5298      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
5299
5300      my @cmd = (
5301        $sftp,
5302        '-F',
5303        $ssh_config,
5304        '-oBatchMode=yes',
5305        '-oCheckHostIP=no',
5306        '-oCompression=yes',
5307        "-oPort=$port",
5308        "-oIdentityFile=$rsa_priv_key",
5309        '-oPubkeyAuthentication=yes',
5310        '-oStrictHostKeyChecking=no',
5311        '-vvv',
5312        '-b',
5313        $batch_file,
5314        "$user\@127.0.0.1",
5315      );
5316
5317      my $sftp_rh = IO::Handle->new();
5318      my $sftp_wh = IO::Handle->new();
5319      my $sftp_eh = IO::Handle->new();
5320
5321      $sftp_wh->autoflush(1);
5322
5323      sleep(1);
5324
5325      local $SIG{CHLD} = 'DEFAULT';
5326
5327      # Make sure that the perms on the priv key are what OpenSSH wants
5328      unless (chmod(0400, $rsa_priv_key)) {
5329        die("Can't set perms on $rsa_priv_key to 0400: $!");
5330      }
5331
5332      if ($ENV{TEST_VERBOSE}) {
5333        print STDERR "Executing: ", join(' ', @cmd), "\n";
5334      }
5335
5336      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
5337      waitpid($sftp_pid, 0);
5338      my $exit_status = $?;
5339
5340      # Restore the perms on the priv key
5341      unless (chmod(0644, $rsa_priv_key)) {
5342        die("Can't set perms on $rsa_priv_key to 0644: $!");
5343      }
5344
5345      my ($res, $errstr);
5346      if ($exit_status >> 8 == 0) {
5347        $errstr = join('', <$sftp_eh>);
5348        $res = 0;
5349
5350      } else {
5351        $errstr = join('', <$sftp_eh>);
5352        if ($ENV{TEST_VERBOSE}) {
5353          print STDERR "Stderr: $errstr\n";
5354        }
5355
5356        $res = 1;
5357      }
5358
5359      unless ($res == 0) {
5360        die("Can't upload $src_file to server: $errstr");
5361      }
5362
5363      unless (-f $dst_file) {
5364        die("File '$dst_file' does not exist as expected");
5365      }
5366
5367      my $sz = (stat($dst_file))[7];
5368      my $expected_sz = $src_sz;
5369      $self->assert($expected_sz == $sz,
5370        test_msg("Expected file size $expected_sz, got $sz"));
5371
5372    };
5373
5374    if ($@) {
5375      $ex = $@;
5376    }
5377
5378    $wfh->print("done\n");
5379    $wfh->flush();
5380
5381  } else {
5382    eval { server_wait($config_file, $rfh) };
5383    if ($@) {
5384      warn($@);
5385      exit 1;
5386    }
5387
5388    exit 0;
5389  }
5390
5391  # Stop server
5392  server_stop($pid_file);
5393
5394  $self->assert_child_ok($pid);
5395
5396  if ($ex) {
5397    test_append_logfile($log_file, $ex);
5398    unlink($log_file);
5399
5400    die($ex);
5401  }
5402
5403  unlink($log_file);
5404}
5405
5406sub ssh2_ext_hostkey_ecdsa384 {
5407  my $self = shift;
5408  my $tmpdir = $self->{tmpdir};
5409
5410  my $config_file = "$tmpdir/sftp.conf";
5411  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
5412  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
5413
5414  my $log_file = test_get_logfile();
5415
5416  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
5417  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
5418
5419  my $user = 'proftpd';
5420  my $passwd = 'test';
5421  my $group = 'ftpd';
5422  my $home_dir = File::Spec->rel2abs($tmpdir);
5423  my $uid = 500;
5424  my $gid = 500;
5425
5426  # Make sure that, if we're running as root, that the home directory has
5427  # permissions/privs set for the account we create
5428  if ($< == 0) {
5429    unless (chmod(0755, $home_dir)) {
5430      die("Can't set perms on $home_dir to 0755: $!");
5431    }
5432
5433    unless (chown($uid, $gid, $home_dir)) {
5434      die("Can't set owner of $home_dir to $uid/$gid: $!");
5435    }
5436  }
5437
5438  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
5439    '/bin/bash');
5440  auth_group_write($auth_group_file, $group, $gid, $user);
5441
5442  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
5443  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
5444  my $ecdsa384_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa384_key');
5445
5446  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
5447  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
5448  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
5449
5450  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
5451  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
5452    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
5453  }
5454
5455  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
5456  if (open(my $fh, "> $src_file")) {
5457    print $fh "Hello, World!\n";
5458
5459    unless (close($fh)) {
5460      die("Can't write $src_file: $!");
5461    }
5462
5463  } else {
5464    die("Can't open $src_file: $!");
5465  }
5466
5467  my $src_sz = (stat($src_file))[7];
5468
5469  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
5470
5471  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
5472  if (open(my $fh, "> $ssh_config")) {
5473    print $fh <<EOC;
5474HostKeyAlgorithms ecdsa-sha2-nistp384
5475EOC
5476    unless (close($fh)) {
5477      die("Can't write $ssh_config: $!");
5478    }
5479
5480  } else {
5481    die("Can't open $ssh_config: $!");
5482  }
5483
5484  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
5485  if (open(my $fh, "> $batch_file")) {
5486    print $fh "put -P $src_file $dst_file\n";
5487
5488    unless (close($fh)) {
5489      die("Can't write $batch_file: $!");
5490    }
5491
5492  } else {
5493    die("Can't open $batch_file: $!");
5494  }
5495
5496  my $config = {
5497    PidFile => $pid_file,
5498    ScoreboardFile => $scoreboard_file,
5499    SystemLog => $log_file,
5500    TraceLog => $log_file,
5501    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
5502
5503    AuthUserFile => $auth_user_file,
5504    AuthGroupFile => $auth_group_file,
5505
5506    IfModules => {
5507      'mod_delay.c' => {
5508        DelayEngine => 'off',
5509      },
5510
5511      'mod_sftp.c' => [
5512        "SFTPEngine on",
5513        "SFTPLog $log_file",
5514
5515        "SFTPHostKey $rsa_host_key",
5516        "SFTPHostKey $dsa_host_key",
5517        "SFTPHostKey $ecdsa384_host_key",
5518
5519        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
5520      ],
5521    },
5522  };
5523
5524  my ($port, $config_user, $config_group) = config_write($config_file, $config);
5525
5526  # Open pipes, for use between the parent and child processes.  Specifically,
5527  # the child will indicate when it's done with its test by writing a message
5528  # to the parent.
5529  my ($rfh, $wfh);
5530  unless (pipe($rfh, $wfh)) {
5531    die("Can't open pipe: $!");
5532  }
5533
5534  require Net::SSH2;
5535
5536  my $ex;
5537
5538  # Fork child
5539  $self->handle_sigchld();
5540  defined(my $pid = fork()) or die("Can't fork: $!");
5541  if ($pid) {
5542    eval {
5543
5544      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
5545      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
5546
5547      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
5548
5549      my @cmd = (
5550        $sftp,
5551        '-F',
5552        $ssh_config,
5553        '-oBatchMode=yes',
5554        '-oCheckHostIP=no',
5555        '-oCompression=yes',
5556        "-oPort=$port",
5557        "-oIdentityFile=$rsa_priv_key",
5558        '-oPubkeyAuthentication=yes',
5559        '-oStrictHostKeyChecking=no',
5560        '-vvv',
5561        '-b',
5562        $batch_file,
5563        "$user\@127.0.0.1",
5564      );
5565
5566      my $sftp_rh = IO::Handle->new();
5567      my $sftp_wh = IO::Handle->new();
5568      my $sftp_eh = IO::Handle->new();
5569
5570      $sftp_wh->autoflush(1);
5571
5572      sleep(1);
5573
5574      local $SIG{CHLD} = 'DEFAULT';
5575
5576      # Make sure that the perms on the priv key are what OpenSSH wants
5577      unless (chmod(0400, $rsa_priv_key)) {
5578        die("Can't set perms on $rsa_priv_key to 0400: $!");
5579      }
5580
5581      if ($ENV{TEST_VERBOSE}) {
5582        print STDERR "Executing: ", join(' ', @cmd), "\n";
5583      }
5584
5585      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
5586      waitpid($sftp_pid, 0);
5587      my $exit_status = $?;
5588
5589      # Restore the perms on the priv key
5590      unless (chmod(0644, $rsa_priv_key)) {
5591        die("Can't set perms on $rsa_priv_key to 0644: $!");
5592      }
5593
5594      my ($res, $errstr);
5595      if ($exit_status >> 8 == 0) {
5596        $errstr = join('', <$sftp_eh>);
5597        $res = 0;
5598
5599      } else {
5600        $errstr = join('', <$sftp_eh>);
5601        if ($ENV{TEST_VERBOSE}) {
5602          print STDERR "Stderr: $errstr\n";
5603        }
5604
5605        $res = 1;
5606      }
5607
5608      unless ($res == 0) {
5609        die("Can't upload $src_file to server: $errstr");
5610      }
5611
5612      unless (-f $dst_file) {
5613        die("File '$dst_file' does not exist as expected");
5614      }
5615
5616      my $sz = (stat($dst_file))[7];
5617      my $expected_sz = $src_sz;
5618      $self->assert($expected_sz == $sz,
5619        test_msg("Expected file size $expected_sz, got $sz"));
5620
5621    };
5622
5623    if ($@) {
5624      $ex = $@;
5625    }
5626
5627    $wfh->print("done\n");
5628    $wfh->flush();
5629
5630  } else {
5631    eval { server_wait($config_file, $rfh) };
5632    if ($@) {
5633      warn($@);
5634      exit 1;
5635    }
5636
5637    exit 0;
5638  }
5639
5640  # Stop server
5641  server_stop($pid_file);
5642
5643  $self->assert_child_ok($pid);
5644
5645  if ($ex) {
5646    test_append_logfile($log_file, $ex);
5647    unlink($log_file);
5648
5649    die($ex);
5650  }
5651
5652  unlink($log_file);
5653}
5654
5655sub ssh2_ext_hostkey_ecdsa521 {
5656  my $self = shift;
5657  my $tmpdir = $self->{tmpdir};
5658
5659  my $config_file = "$tmpdir/sftp.conf";
5660  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
5661  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
5662
5663  my $log_file = test_get_logfile();
5664
5665  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
5666  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
5667
5668  my $user = 'proftpd';
5669  my $passwd = 'test';
5670  my $group = 'ftpd';
5671  my $home_dir = File::Spec->rel2abs($tmpdir);
5672  my $uid = 500;
5673  my $gid = 500;
5674
5675  # Make sure that, if we're running as root, that the home directory has
5676  # permissions/privs set for the account we create
5677  if ($< == 0) {
5678    unless (chmod(0755, $home_dir)) {
5679      die("Can't set perms on $home_dir to 0755: $!");
5680    }
5681
5682    unless (chown($uid, $gid, $home_dir)) {
5683      die("Can't set owner of $home_dir to $uid/$gid: $!");
5684    }
5685  }
5686
5687  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
5688    '/bin/bash');
5689  auth_group_write($auth_group_file, $group, $gid, $user);
5690
5691  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
5692  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
5693  my $ecdsa521_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa521_key');
5694
5695  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
5696  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
5697  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
5698
5699  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
5700  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
5701    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
5702  }
5703
5704  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
5705  if (open(my $fh, "> $src_file")) {
5706    print $fh "Hello, World!\n";
5707
5708    unless (close($fh)) {
5709      die("Can't write $src_file: $!");
5710    }
5711
5712  } else {
5713    die("Can't open $src_file: $!");
5714  }
5715
5716  my $src_sz = (stat($src_file))[7];
5717
5718  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
5719
5720  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
5721  if (open(my $fh, "> $ssh_config")) {
5722    print $fh <<EOC;
5723HostKeyAlgorithms ecdsa-sha2-nistp521
5724EOC
5725    unless (close($fh)) {
5726      die("Can't write $ssh_config: $!");
5727    }
5728
5729  } else {
5730    die("Can't open $ssh_config: $!");
5731  }
5732
5733  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
5734  if (open(my $fh, "> $batch_file")) {
5735    print $fh "put -P $src_file $dst_file\n";
5736
5737    unless (close($fh)) {
5738      die("Can't write $batch_file: $!");
5739    }
5740
5741  } else {
5742    die("Can't open $batch_file: $!");
5743  }
5744
5745  my $config = {
5746    PidFile => $pid_file,
5747    ScoreboardFile => $scoreboard_file,
5748    SystemLog => $log_file,
5749    TraceLog => $log_file,
5750    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
5751
5752    AuthUserFile => $auth_user_file,
5753    AuthGroupFile => $auth_group_file,
5754
5755    IfModules => {
5756      'mod_delay.c' => {
5757        DelayEngine => 'off',
5758      },
5759
5760      'mod_sftp.c' => [
5761        "SFTPEngine on",
5762        "SFTPLog $log_file",
5763
5764        "SFTPHostKey $rsa_host_key",
5765        "SFTPHostKey $dsa_host_key",
5766        "SFTPHostKey $ecdsa521_host_key",
5767
5768        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
5769      ],
5770    },
5771  };
5772
5773  my ($port, $config_user, $config_group) = config_write($config_file, $config);
5774
5775  # Open pipes, for use between the parent and child processes.  Specifically,
5776  # the child will indicate when it's done with its test by writing a message
5777  # to the parent.
5778  my ($rfh, $wfh);
5779  unless (pipe($rfh, $wfh)) {
5780    die("Can't open pipe: $!");
5781  }
5782
5783  require Net::SSH2;
5784
5785  my $ex;
5786
5787  # Fork child
5788  $self->handle_sigchld();
5789  defined(my $pid = fork()) or die("Can't fork: $!");
5790  if ($pid) {
5791    eval {
5792
5793      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
5794      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
5795
5796      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
5797
5798      my @cmd = (
5799        $sftp,
5800        '-F',
5801        $ssh_config,
5802        '-oBatchMode=yes',
5803        '-oCheckHostIP=no',
5804        '-oCompression=yes',
5805        "-oPort=$port",
5806        "-oIdentityFile=$rsa_priv_key",
5807        '-oPubkeyAuthentication=yes',
5808        '-oStrictHostKeyChecking=no',
5809        '-vvv',
5810        '-b',
5811        $batch_file,
5812        "$user\@127.0.0.1",
5813      );
5814
5815      my $sftp_rh = IO::Handle->new();
5816      my $sftp_wh = IO::Handle->new();
5817      my $sftp_eh = IO::Handle->new();
5818
5819      $sftp_wh->autoflush(1);
5820
5821      sleep(1);
5822
5823      local $SIG{CHLD} = 'DEFAULT';
5824
5825      # Make sure that the perms on the priv key are what OpenSSH wants
5826      unless (chmod(0400, $rsa_priv_key)) {
5827        die("Can't set perms on $rsa_priv_key to 0400: $!");
5828      }
5829
5830      if ($ENV{TEST_VERBOSE}) {
5831        print STDERR "Executing: ", join(' ', @cmd), "\n";
5832      }
5833
5834      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
5835      waitpid($sftp_pid, 0);
5836      my $exit_status = $?;
5837
5838      # Restore the perms on the priv key
5839      unless (chmod(0644, $rsa_priv_key)) {
5840        die("Can't set perms on $rsa_priv_key to 0644: $!");
5841      }
5842
5843      my ($res, $errstr);
5844      if ($exit_status >> 8 == 0) {
5845        $errstr = join('', <$sftp_eh>);
5846        $res = 0;
5847
5848      } else {
5849        $errstr = join('', <$sftp_eh>);
5850        if ($ENV{TEST_VERBOSE}) {
5851          print STDERR "Stderr: $errstr\n";
5852        }
5853
5854        $res = 1;
5855      }
5856
5857      unless ($res == 0) {
5858        die("Can't upload $src_file to server: $errstr");
5859      }
5860
5861      unless (-f $dst_file) {
5862        die("File '$dst_file' does not exist as expected");
5863      }
5864
5865      my $sz = (stat($dst_file))[7];
5866      my $expected_sz = $src_sz;
5867      $self->assert($expected_sz == $sz,
5868        test_msg("Expected file size $expected_sz, got $sz"));
5869
5870    };
5871
5872    if ($@) {
5873      $ex = $@;
5874    }
5875
5876    $wfh->print("done\n");
5877    $wfh->flush();
5878
5879  } else {
5880    eval { server_wait($config_file, $rfh) };
5881    if ($@) {
5882      warn($@);
5883      exit 1;
5884    }
5885
5886    exit 0;
5887  }
5888
5889  # Stop server
5890  server_stop($pid_file);
5891
5892  $self->assert_child_ok($pid);
5893
5894  if ($ex) {
5895    test_append_logfile($log_file, $ex);
5896    unlink($log_file);
5897
5898    die($ex);
5899  }
5900
5901  unlink($log_file);
5902}
5903
5904# Newer OpenSSH versions used `aes256-ctr` for their OpenSSH private keys.
5905# Older OpenSSH versions used `aes256-cbc`, but ONLY for ssh-ed25519 keys.
5906sub ssh2_ext_hostkey_openssh_rsa_issue793 {
5907  my $self = shift;
5908  my $tmpdir = $self->{tmpdir};
5909  my $setup = test_setup($tmpdir, 'sftp');
5910
5911  my $openssh_rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_rsa_key');
5912
5913  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
5914  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
5915  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
5916
5917  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
5918  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
5919    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
5920  }
5921
5922  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
5923  if (open(my $fh, "> $src_file")) {
5924    print $fh "Hello, World!\n";
5925
5926    unless (close($fh)) {
5927      die("Can't write $src_file: $!");
5928    }
5929
5930  } else {
5931    die("Can't open $src_file: $!");
5932  }
5933
5934  my $src_sz = (stat($src_file))[7];
5935  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
5936
5937  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
5938  if (open(my $fh, "> $batch_file")) {
5939    print $fh "put -P $src_file $dst_file\n";
5940
5941    unless (close($fh)) {
5942      die("Can't write $batch_file: $!");
5943    }
5944
5945  } else {
5946    die("Can't open $batch_file: $!");
5947  }
5948
5949  my $config = {
5950    PidFile => $setup->{pid_file},
5951    ScoreboardFile => $setup->{scoreboard_file},
5952    SystemLog => $setup->{log_file},
5953    TraceLog => $setup->{log_file},
5954    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
5955
5956    AuthUserFile => $setup->{auth_user_file},
5957    AuthGroupFile => $setup->{auth_group_file},
5958
5959    IfModules => {
5960      'mod_delay.c' => {
5961        DelayEngine => 'off',
5962      },
5963
5964      'mod_sftp.c' => [
5965        "SFTPEngine on",
5966        "SFTPLog $setup->{log_file}",
5967        "SFTPHostKey $openssh_rsa_host_key",
5968        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
5969      ],
5970    },
5971  };
5972
5973  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
5974    $config);
5975
5976  # Open pipes, for use between the parent and child processes.  Specifically,
5977  # the child will indicate when it's done with its test by writing a message
5978  # to the parent.
5979  my ($rfh, $wfh);
5980  unless (pipe($rfh, $wfh)) {
5981    die("Can't open pipe: $!");
5982  }
5983
5984  require Net::SSH2;
5985
5986  my $ex;
5987
5988  # Fork child
5989  $self->handle_sigchld();
5990  defined(my $pid = fork()) or die("Can't fork: $!");
5991  if ($pid) {
5992    eval {
5993      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
5994      # So we use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
5995
5996      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
5997
5998      my @cmd = (
5999        $sftp,
6000        '-oBatchMode=yes',
6001        '-oCheckHostIP=no',
6002        '-oCompression=yes',
6003        "-oPort=$port",
6004        "-oIdentityFile=$rsa_priv_key",
6005        '-oPubkeyAuthentication=yes',
6006        '-oStrictHostKeyChecking=no',
6007        '-vvv',
6008        '-b',
6009        $batch_file,
6010        "$setup->{user}\@127.0.0.1",
6011      );
6012
6013      my $sftp_rh = IO::Handle->new();
6014      my $sftp_wh = IO::Handle->new();
6015      my $sftp_eh = IO::Handle->new();
6016
6017      $sftp_wh->autoflush(1);
6018
6019      sleep(1);
6020
6021      local $SIG{CHLD} = 'DEFAULT';
6022
6023      # Make sure that the perms on the priv key are what OpenSSH wants
6024      unless (chmod(0400, $rsa_priv_key)) {
6025        die("Can't set perms on $rsa_priv_key to 0400: $!");
6026      }
6027
6028      if ($ENV{TEST_VERBOSE}) {
6029        print STDERR "Executing: ", join(' ', @cmd), "\n";
6030      }
6031
6032      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
6033      waitpid($sftp_pid, 0);
6034      my $exit_status = $?;
6035
6036      # Restore the perms on the priv key
6037      unless (chmod(0644, $rsa_priv_key)) {
6038        die("Can't set perms on $rsa_priv_key to 0644: $!");
6039      }
6040
6041      my ($res, $errstr);
6042      if ($exit_status >> 8 == 0) {
6043        $errstr = join('', <$sftp_eh>);
6044        $res = 0;
6045
6046      } else {
6047        $errstr = join('', <$sftp_eh>);
6048        if ($ENV{TEST_VERBOSE}) {
6049          print STDERR "Stderr: $errstr\n";
6050        }
6051
6052        $res = 1;
6053      }
6054
6055      unless ($res == 0) {
6056        die("Can't upload $src_file to server: $errstr");
6057      }
6058
6059      unless (-f $dst_file) {
6060        die("File '$dst_file' does not exist as expected");
6061      }
6062
6063      my $sz = (stat($dst_file))[7];
6064      my $expected_sz = $src_sz;
6065      $self->assert($expected_sz == $sz,
6066        test_msg("Expected file size $expected_sz, got $sz"));
6067    };
6068    if ($@) {
6069      $ex = $@;
6070    }
6071
6072    $wfh->print("done\n");
6073    $wfh->flush();
6074
6075  } else {
6076    eval { server_wait($setup->{config_file}, $rfh) };
6077    if ($@) {
6078      warn($@);
6079      exit 1;
6080    }
6081
6082    exit 0;
6083  }
6084
6085  # Stop server
6086  server_stop($setup->{pid_file});
6087  $self->assert_child_ok($pid);
6088
6089  test_cleanup($setup->{log_file}, $ex);
6090}
6091
6092sub ssh2_ext_hostkey_openssh_rsa_passphraseprovider_issue793 {
6093  my $self = shift;
6094  my $tmpdir = $self->{tmpdir};
6095  my $setup = test_setup($tmpdir, 'sftp');
6096
6097  my $openssh_rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_openssh_rsa_key');
6098  my $passphrase_provider = File::Spec->rel2abs('t/etc/modules/mod_sftp/sftp-get-passphrase.pl');
6099
6100  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
6101  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
6102  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
6103
6104  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
6105  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
6106    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
6107  }
6108
6109  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
6110  if (open(my $fh, "> $src_file")) {
6111    print $fh "Hello, World!\n";
6112
6113    unless (close($fh)) {
6114      die("Can't write $src_file: $!");
6115    }
6116
6117  } else {
6118    die("Can't open $src_file: $!");
6119  }
6120
6121  my $src_sz = (stat($src_file))[7];
6122  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
6123
6124  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
6125  if (open(my $fh, "> $batch_file")) {
6126    print $fh "put -P $src_file $dst_file\n";
6127
6128    unless (close($fh)) {
6129      die("Can't write $batch_file: $!");
6130    }
6131
6132  } else {
6133    die("Can't open $batch_file: $!");
6134  }
6135
6136  my $config = {
6137    PidFile => $setup->{pid_file},
6138    ScoreboardFile => $setup->{scoreboard_file},
6139    SystemLog => $setup->{log_file},
6140    TraceLog => $setup->{log_file},
6141    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
6142
6143    AuthUserFile => $setup->{auth_user_file},
6144    AuthGroupFile => $setup->{auth_group_file},
6145
6146    IfModules => {
6147      'mod_delay.c' => {
6148        DelayEngine => 'off',
6149      },
6150
6151      'mod_sftp.c' => [
6152        "SFTPEngine on",
6153        "SFTPLog $setup->{log_file}",
6154        "SFTPHostKey $openssh_rsa_host_key",
6155        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
6156
6157        "SFTPPassPhraseProvider $passphrase_provider",
6158      ],
6159    },
6160  };
6161
6162  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
6163    $config);
6164
6165  # Open pipes, for use between the parent and child processes.  Specifically,
6166  # the child will indicate when it's done with its test by writing a message
6167  # to the parent.
6168  my ($rfh, $wfh);
6169  unless (pipe($rfh, $wfh)) {
6170    die("Can't open pipe: $!");
6171  }
6172
6173  require Net::SSH2;
6174
6175  my $ex;
6176
6177  # Fork child
6178  $self->handle_sigchld();
6179  defined(my $pid = fork()) or die("Can't fork: $!");
6180  if ($pid) {
6181    eval {
6182      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
6183      # So we use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
6184
6185      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
6186
6187      my @cmd = (
6188        $sftp,
6189        '-oBatchMode=yes',
6190        '-oCheckHostIP=no',
6191        '-oCompression=yes',
6192        "-oPort=$port",
6193        "-oIdentityFile=$rsa_priv_key",
6194        '-oPubkeyAuthentication=yes',
6195        '-oStrictHostKeyChecking=no',
6196        '-vvv',
6197        '-b',
6198        $batch_file,
6199        "$setup->{user}\@127.0.0.1",
6200      );
6201
6202      my $sftp_rh = IO::Handle->new();
6203      my $sftp_wh = IO::Handle->new();
6204      my $sftp_eh = IO::Handle->new();
6205
6206      $sftp_wh->autoflush(1);
6207
6208      sleep(1);
6209
6210      local $SIG{CHLD} = 'DEFAULT';
6211
6212      # Make sure that the perms on the priv key are what OpenSSH wants
6213      unless (chmod(0400, $rsa_priv_key)) {
6214        die("Can't set perms on $rsa_priv_key to 0400: $!");
6215      }
6216
6217      if ($ENV{TEST_VERBOSE}) {
6218        print STDERR "Executing: ", join(' ', @cmd), "\n";
6219      }
6220
6221      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
6222      waitpid($sftp_pid, 0);
6223      my $exit_status = $?;
6224
6225      # Restore the perms on the priv key
6226      unless (chmod(0644, $rsa_priv_key)) {
6227        die("Can't set perms on $rsa_priv_key to 0644: $!");
6228      }
6229
6230      my ($res, $errstr);
6231      if ($exit_status >> 8 == 0) {
6232        $errstr = join('', <$sftp_eh>);
6233        $res = 0;
6234
6235      } else {
6236        $errstr = join('', <$sftp_eh>);
6237        if ($ENV{TEST_VERBOSE}) {
6238          print STDERR "Stderr: $errstr\n";
6239        }
6240
6241        $res = 1;
6242      }
6243
6244      unless ($res == 0) {
6245        die("Can't upload $src_file to server: $errstr");
6246      }
6247
6248      unless (-f $dst_file) {
6249        die("File '$dst_file' does not exist as expected");
6250      }
6251
6252      my $sz = (stat($dst_file))[7];
6253      my $expected_sz = $src_sz;
6254      $self->assert($expected_sz == $sz,
6255        test_msg("Expected file size $expected_sz, got $sz"));
6256    };
6257    if ($@) {
6258      $ex = $@;
6259    }
6260
6261    $wfh->print("done\n");
6262    $wfh->flush();
6263
6264  } else {
6265    eval { server_wait($setup->{config_file}, $rfh) };
6266    if ($@) {
6267      warn($@);
6268      exit 1;
6269    }
6270
6271    exit 0;
6272  }
6273
6274  # Stop server
6275  server_stop($setup->{pid_file});
6276  $self->assert_child_ok($pid);
6277
6278  test_cleanup($setup->{log_file}, $ex);
6279}
6280
6281sub ssh2_ext_hostkey_openssh_dsa_issue793 {
6282  my $self = shift;
6283  my $tmpdir = $self->{tmpdir};
6284  my $setup = test_setup($tmpdir, 'sftp');
6285
6286  my $openssh_dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_dsa_key');
6287
6288  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
6289  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
6290  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
6291
6292  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
6293  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
6294    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
6295  }
6296
6297  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
6298  if (open(my $fh, "> $src_file")) {
6299    print $fh "Hello, World!\n";
6300
6301    unless (close($fh)) {
6302      die("Can't write $src_file: $!");
6303    }
6304
6305  } else {
6306    die("Can't open $src_file: $!");
6307  }
6308
6309  my $src_sz = (stat($src_file))[7];
6310  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
6311
6312  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
6313  if (open(my $fh, "> $ssh_config")) {
6314    print $fh <<EOC;
6315HostKeyAlgorithms ssh-dss
6316EOC
6317    unless (close($fh)) {
6318      die("Can't write $ssh_config: $!");
6319    }
6320
6321  } else {
6322    die("Can't open $ssh_config: $!");
6323  }
6324
6325  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
6326  if (open(my $fh, "> $batch_file")) {
6327    print $fh "put -P $src_file $dst_file\n";
6328
6329    unless (close($fh)) {
6330      die("Can't write $batch_file: $!");
6331    }
6332
6333  } else {
6334    die("Can't open $batch_file: $!");
6335  }
6336
6337  my $config = {
6338    PidFile => $setup->{pid_file},
6339    ScoreboardFile => $setup->{scoreboard_file},
6340    SystemLog => $setup->{log_file},
6341    TraceLog => $setup->{log_file},
6342    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
6343
6344    AuthUserFile => $setup->{auth_user_file},
6345    AuthGroupFile => $setup->{auth_group_file},
6346
6347    IfModules => {
6348      'mod_delay.c' => {
6349        DelayEngine => 'off',
6350      },
6351
6352      'mod_sftp.c' => [
6353        "SFTPEngine on",
6354        "SFTPLog $setup->{log_file}",
6355        "SFTPHostKey $openssh_dsa_host_key",
6356        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
6357      ],
6358    },
6359  };
6360
6361  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
6362    $config);
6363
6364  # Open pipes, for use between the parent and child processes.  Specifically,
6365  # the child will indicate when it's done with its test by writing a message
6366  # to the parent.
6367  my ($rfh, $wfh);
6368  unless (pipe($rfh, $wfh)) {
6369    die("Can't open pipe: $!");
6370  }
6371
6372  require Net::SSH2;
6373
6374  my $ex;
6375
6376  # Fork child
6377  $self->handle_sigchld();
6378  defined(my $pid = fork()) or die("Can't fork: $!");
6379  if ($pid) {
6380    eval {
6381      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
6382      # So we use the external sftp(1) client (e.g. OpenSSH-6.2p2) to test;
6383      # newer OpenSSH versions dropped support for the 'ssh-dss' hostkey
6384      # algorithm.
6385
6386      my $sftp = 'sftp';
6387
6388      my @cmd = (
6389        $sftp,
6390        '-F',
6391        $ssh_config,
6392        '-oBatchMode=yes',
6393        '-oCheckHostIP=no',
6394        '-oCompression=yes',
6395        "-oPort=$port",
6396        "-oIdentityFile=$rsa_priv_key",
6397        '-oPubkeyAuthentication=yes',
6398        '-oStrictHostKeyChecking=no',
6399        '-vvv',
6400        '-b',
6401        $batch_file,
6402        "$setup->{user}\@127.0.0.1",
6403      );
6404
6405      my $sftp_rh = IO::Handle->new();
6406      my $sftp_wh = IO::Handle->new();
6407      my $sftp_eh = IO::Handle->new();
6408
6409      $sftp_wh->autoflush(1);
6410
6411      sleep(1);
6412
6413      local $SIG{CHLD} = 'DEFAULT';
6414
6415      # Make sure that the perms on the priv key are what OpenSSH wants
6416      unless (chmod(0400, $rsa_priv_key)) {
6417        die("Can't set perms on $rsa_priv_key to 0400: $!");
6418      }
6419
6420      if ($ENV{TEST_VERBOSE}) {
6421        print STDERR "Executing: ", join(' ', @cmd), "\n";
6422      }
6423
6424      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
6425      waitpid($sftp_pid, 0);
6426      my $exit_status = $?;
6427
6428      # Restore the perms on the priv key
6429      unless (chmod(0644, $rsa_priv_key)) {
6430        die("Can't set perms on $rsa_priv_key to 0644: $!");
6431      }
6432
6433      my ($res, $errstr);
6434      if ($exit_status >> 8 == 0) {
6435        $errstr = join('', <$sftp_eh>);
6436        $res = 0;
6437
6438      } else {
6439        $errstr = join('', <$sftp_eh>);
6440        if ($ENV{TEST_VERBOSE}) {
6441          print STDERR "Stderr: $errstr\n";
6442        }
6443
6444        $res = 1;
6445      }
6446
6447      unless ($res == 0) {
6448        die("Can't upload $src_file to server: $errstr");
6449      }
6450
6451      unless (-f $dst_file) {
6452        die("File '$dst_file' does not exist as expected");
6453      }
6454
6455      my $sz = (stat($dst_file))[7];
6456      my $expected_sz = $src_sz;
6457      $self->assert($expected_sz == $sz,
6458        test_msg("Expected file size $expected_sz, got $sz"));
6459    };
6460    if ($@) {
6461      $ex = $@;
6462    }
6463
6464    $wfh->print("done\n");
6465    $wfh->flush();
6466
6467  } else {
6468    eval { server_wait($setup->{config_file}, $rfh) };
6469    if ($@) {
6470      warn($@);
6471      exit 1;
6472    }
6473
6474    exit 0;
6475  }
6476
6477  # Stop server
6478  server_stop($setup->{pid_file});
6479  $self->assert_child_ok($pid);
6480
6481  test_cleanup($setup->{log_file}, $ex);
6482}
6483
6484sub ssh2_ext_hostkey_openssh_ecdsa_issue793 {
6485  my $self = shift;
6486  my $tmpdir = $self->{tmpdir};
6487  my $setup = test_setup($tmpdir, 'sftp');
6488
6489  my $openssh_ecdsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_ecdsa_key');
6490
6491  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
6492  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
6493  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
6494
6495  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
6496  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
6497    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
6498  }
6499
6500  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
6501  if (open(my $fh, "> $src_file")) {
6502    print $fh "Hello, World!\n";
6503
6504    unless (close($fh)) {
6505      die("Can't write $src_file: $!");
6506    }
6507
6508  } else {
6509    die("Can't open $src_file: $!");
6510  }
6511
6512  my $src_sz = (stat($src_file))[7];
6513  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
6514
6515  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
6516  if (open(my $fh, "> $ssh_config")) {
6517    print $fh <<EOC;
6518HostKeyAlgorithms ecdsa-sha2-nistp256
6519EOC
6520    unless (close($fh)) {
6521      die("Can't write $ssh_config: $!");
6522    }
6523
6524  } else {
6525    die("Can't open $ssh_config: $!");
6526  }
6527
6528  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
6529  if (open(my $fh, "> $batch_file")) {
6530    print $fh "put -P $src_file $dst_file\n";
6531
6532    unless (close($fh)) {
6533      die("Can't write $batch_file: $!");
6534    }
6535
6536  } else {
6537    die("Can't open $batch_file: $!");
6538  }
6539
6540  my $config = {
6541    PidFile => $setup->{pid_file},
6542    ScoreboardFile => $setup->{scoreboard_file},
6543    SystemLog => $setup->{log_file},
6544    TraceLog => $setup->{log_file},
6545    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
6546
6547    AuthUserFile => $setup->{auth_user_file},
6548    AuthGroupFile => $setup->{auth_group_file},
6549
6550    IfModules => {
6551      'mod_delay.c' => {
6552        DelayEngine => 'off',
6553      },
6554
6555      'mod_sftp.c' => [
6556        "SFTPEngine on",
6557        "SFTPLog $setup->{log_file}",
6558        "SFTPHostKey $openssh_ecdsa_host_key",
6559        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
6560      ],
6561    },
6562  };
6563
6564  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
6565    $config);
6566
6567  # Open pipes, for use between the parent and child processes.  Specifically,
6568  # the child will indicate when it's done with its test by writing a message
6569  # to the parent.
6570  my ($rfh, $wfh);
6571  unless (pipe($rfh, $wfh)) {
6572    die("Can't open pipe: $!");
6573  }
6574
6575  require Net::SSH2;
6576
6577  my $ex;
6578
6579  # Fork child
6580  $self->handle_sigchld();
6581  defined(my $pid = fork()) or die("Can't fork: $!");
6582  if ($pid) {
6583    eval {
6584      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
6585      # So we use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
6586
6587      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
6588
6589      my @cmd = (
6590        $sftp,
6591        '-F',
6592        $ssh_config,
6593        '-oBatchMode=yes',
6594        '-oCheckHostIP=no',
6595        '-oCompression=yes',
6596        "-oPort=$port",
6597        "-oIdentityFile=$rsa_priv_key",
6598        '-oPubkeyAuthentication=yes',
6599        '-oStrictHostKeyChecking=no',
6600        '-vvv',
6601        '-b',
6602        $batch_file,
6603        "$setup->{user}\@127.0.0.1",
6604      );
6605
6606      my $sftp_rh = IO::Handle->new();
6607      my $sftp_wh = IO::Handle->new();
6608      my $sftp_eh = IO::Handle->new();
6609
6610      $sftp_wh->autoflush(1);
6611
6612      sleep(1);
6613
6614      local $SIG{CHLD} = 'DEFAULT';
6615
6616      # Make sure that the perms on the priv key are what OpenSSH wants
6617      unless (chmod(0400, $rsa_priv_key)) {
6618        die("Can't set perms on $rsa_priv_key to 0400: $!");
6619      }
6620
6621      if ($ENV{TEST_VERBOSE}) {
6622        print STDERR "Executing: ", join(' ', @cmd), "\n";
6623      }
6624
6625      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
6626      waitpid($sftp_pid, 0);
6627      my $exit_status = $?;
6628
6629      # Restore the perms on the priv key
6630      unless (chmod(0644, $rsa_priv_key)) {
6631        die("Can't set perms on $rsa_priv_key to 0644: $!");
6632      }
6633
6634      my ($res, $errstr);
6635      if ($exit_status >> 8 == 0) {
6636        $errstr = join('', <$sftp_eh>);
6637        $res = 0;
6638
6639      } else {
6640        $errstr = join('', <$sftp_eh>);
6641        if ($ENV{TEST_VERBOSE}) {
6642          print STDERR "Stderr: $errstr\n";
6643        }
6644
6645        $res = 1;
6646      }
6647
6648      unless ($res == 0) {
6649        die("Can't upload $src_file to server: $errstr");
6650      }
6651
6652      unless (-f $dst_file) {
6653        die("File '$dst_file' does not exist as expected");
6654      }
6655
6656      my $sz = (stat($dst_file))[7];
6657      my $expected_sz = $src_sz;
6658      $self->assert($expected_sz == $sz,
6659        test_msg("Expected file size $expected_sz, got $sz"));
6660    };
6661    if ($@) {
6662      $ex = $@;
6663    }
6664
6665    $wfh->print("done\n");
6666    $wfh->flush();
6667
6668  } else {
6669    eval { server_wait($setup->{config_file}, $rfh) };
6670    if ($@) {
6671      warn($@);
6672      exit 1;
6673    }
6674
6675    exit 0;
6676  }
6677
6678  # Stop server
6679  server_stop($setup->{pid_file});
6680  $self->assert_child_ok($pid);
6681
6682  test_cleanup($setup->{log_file}, $ex);
6683}
6684
6685sub ssh2_ext_hostkey_openssh_ed25519_bug4221 {
6686  my $self = shift;
6687  my $tmpdir = $self->{tmpdir};
6688  my $setup = test_setup($tmpdir, 'sftp');
6689
6690  my $openssh_ed25519_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_openssh_ed25519_key');
6691
6692  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
6693  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
6694  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
6695
6696  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
6697  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
6698    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
6699  }
6700
6701  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
6702  if (open(my $fh, "> $src_file")) {
6703    print $fh "Hello, World!\n";
6704
6705    unless (close($fh)) {
6706      die("Can't write $src_file: $!");
6707    }
6708
6709  } else {
6710    die("Can't open $src_file: $!");
6711  }
6712
6713  my $src_sz = (stat($src_file))[7];
6714  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
6715
6716  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
6717  if (open(my $fh, "> $ssh_config")) {
6718    print $fh <<EOC;
6719HostKeyAlgorithms ssh-ed25519
6720EOC
6721    unless (close($fh)) {
6722      die("Can't write $ssh_config: $!");
6723    }
6724
6725  } else {
6726    die("Can't open $ssh_config: $!");
6727  }
6728
6729  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
6730  if (open(my $fh, "> $batch_file")) {
6731    print $fh "put -P $src_file $dst_file\n";
6732
6733    unless (close($fh)) {
6734      die("Can't write $batch_file: $!");
6735    }
6736
6737  } else {
6738    die("Can't open $batch_file: $!");
6739  }
6740
6741  my $config = {
6742    PidFile => $setup->{pid_file},
6743    ScoreboardFile => $setup->{scoreboard_file},
6744    SystemLog => $setup->{log_file},
6745    TraceLog => $setup->{log_file},
6746    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
6747
6748    AuthUserFile => $setup->{auth_user_file},
6749    AuthGroupFile => $setup->{auth_group_file},
6750
6751    IfModules => {
6752      'mod_delay.c' => {
6753        DelayEngine => 'off',
6754      },
6755
6756      'mod_sftp.c' => [
6757        "SFTPEngine on",
6758        "SFTPLog $setup->{log_file}",
6759        "SFTPHostKey $openssh_ed25519_host_key",
6760        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
6761      ],
6762    },
6763  };
6764
6765  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
6766    $config);
6767
6768  # Open pipes, for use between the parent and child processes.  Specifically,
6769  # the child will indicate when it's done with its test by writing a message
6770  # to the parent.
6771  my ($rfh, $wfh);
6772  unless (pipe($rfh, $wfh)) {
6773    die("Can't open pipe: $!");
6774  }
6775
6776  require Net::SSH2;
6777
6778  my $ex;
6779
6780  # Fork child
6781  $self->handle_sigchld();
6782  defined(my $pid = fork()) or die("Can't fork: $!");
6783  if ($pid) {
6784    eval {
6785      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
6786      # So we use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
6787
6788      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
6789
6790      my @cmd = (
6791        $sftp,
6792        '-F',
6793        $ssh_config,
6794        '-oBatchMode=yes',
6795        '-oCheckHostIP=no',
6796        '-oCompression=yes',
6797        "-oPort=$port",
6798        "-oIdentityFile=$rsa_priv_key",
6799        '-oPubkeyAuthentication=yes',
6800        '-oStrictHostKeyChecking=no',
6801        '-vvv',
6802        '-b',
6803        $batch_file,
6804        "$setup->{user}\@127.0.0.1",
6805      );
6806
6807      my $sftp_rh = IO::Handle->new();
6808      my $sftp_wh = IO::Handle->new();
6809      my $sftp_eh = IO::Handle->new();
6810
6811      $sftp_wh->autoflush(1);
6812
6813      sleep(1);
6814
6815      local $SIG{CHLD} = 'DEFAULT';
6816
6817      # Make sure that the perms on the priv key are what OpenSSH wants
6818      unless (chmod(0400, $rsa_priv_key)) {
6819        die("Can't set perms on $rsa_priv_key to 0400: $!");
6820      }
6821
6822      if ($ENV{TEST_VERBOSE}) {
6823        print STDERR "Executing: ", join(' ', @cmd), "\n";
6824      }
6825
6826      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
6827      waitpid($sftp_pid, 0);
6828      my $exit_status = $?;
6829
6830      # Restore the perms on the priv key
6831      unless (chmod(0644, $rsa_priv_key)) {
6832        die("Can't set perms on $rsa_priv_key to 0644: $!");
6833      }
6834
6835      my ($res, $errstr);
6836      if ($exit_status >> 8 == 0) {
6837        $errstr = join('', <$sftp_eh>);
6838        $res = 0;
6839
6840      } else {
6841        $errstr = join('', <$sftp_eh>);
6842        if ($ENV{TEST_VERBOSE}) {
6843          print STDERR "Stderr: $errstr\n";
6844        }
6845
6846        $res = 1;
6847      }
6848
6849      unless ($res == 0) {
6850        die("Can't upload $src_file to server: $errstr");
6851      }
6852
6853      unless (-f $dst_file) {
6854        die("File '$dst_file' does not exist as expected");
6855      }
6856
6857      my $sz = (stat($dst_file))[7];
6858      my $expected_sz = $src_sz;
6859      $self->assert($expected_sz == $sz,
6860        test_msg("Expected file size $expected_sz, got $sz"));
6861    };
6862    if ($@) {
6863      $ex = $@;
6864    }
6865
6866    $wfh->print("done\n");
6867    $wfh->flush();
6868
6869  } else {
6870    eval { server_wait($setup->{config_file}, $rfh) };
6871    if ($@) {
6872      warn($@);
6873      exit 1;
6874    }
6875
6876    exit 0;
6877  }
6878
6879  # Stop server
6880  server_stop($setup->{pid_file});
6881  $self->assert_child_ok($pid);
6882
6883  test_cleanup($setup->{log_file}, $ex);
6884}
6885
6886sub ssh2_ext_hostkey_openssh_ed25519_passphraseprovider_bug4221 {
6887  my $self = shift;
6888  my $tmpdir = $self->{tmpdir};
6889  my $setup = test_setup($tmpdir, 'sftp');
6890
6891  my $openssh_ed25519_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_openssh_ed25519_key');
6892  my $passphrase_provider = File::Spec->rel2abs('t/etc/modules/mod_sftp/sftp-get-passphrase.pl');
6893
6894  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
6895  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
6896  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
6897
6898  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
6899  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
6900    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
6901  }
6902
6903  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
6904  if (open(my $fh, "> $src_file")) {
6905    print $fh "Hello, World!\n";
6906
6907    unless (close($fh)) {
6908      die("Can't write $src_file: $!");
6909    }
6910
6911  } else {
6912    die("Can't open $src_file: $!");
6913  }
6914
6915  my $src_sz = (stat($src_file))[7];
6916  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
6917
6918  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
6919  if (open(my $fh, "> $ssh_config")) {
6920    print $fh <<EOC;
6921HostKeyAlgorithms ssh-ed25519
6922EOC
6923    unless (close($fh)) {
6924      die("Can't write $ssh_config: $!");
6925    }
6926
6927  } else {
6928    die("Can't open $ssh_config: $!");
6929  }
6930
6931  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
6932  if (open(my $fh, "> $batch_file")) {
6933    print $fh "put -P $src_file $dst_file\n";
6934
6935    unless (close($fh)) {
6936      die("Can't write $batch_file: $!");
6937    }
6938
6939  } else {
6940    die("Can't open $batch_file: $!");
6941  }
6942
6943  my $config = {
6944    PidFile => $setup->{pid_file},
6945    ScoreboardFile => $setup->{scoreboard_file},
6946    SystemLog => $setup->{log_file},
6947    TraceLog => $setup->{log_file},
6948    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
6949
6950    AuthUserFile => $setup->{auth_user_file},
6951    AuthGroupFile => $setup->{auth_group_file},
6952
6953    IfModules => {
6954      'mod_delay.c' => {
6955        DelayEngine => 'off',
6956      },
6957
6958      'mod_sftp.c' => [
6959        "SFTPEngine on",
6960        "SFTPLog $setup->{log_file}",
6961        "SFTPHostKey $openssh_ed25519_host_key",
6962        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
6963
6964        "SFTPPassPhraseProvider $passphrase_provider",
6965      ],
6966    },
6967  };
6968
6969  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
6970    $config);
6971
6972  # Open pipes, for use between the parent and child processes.  Specifically,
6973  # the child will indicate when it's done with its test by writing a message
6974  # to the parent.
6975  my ($rfh, $wfh);
6976  unless (pipe($rfh, $wfh)) {
6977    die("Can't open pipe: $!");
6978  }
6979
6980  require Net::SSH2;
6981
6982  my $ex;
6983
6984  # Fork child
6985  $self->handle_sigchld();
6986  defined(my $pid = fork()) or die("Can't fork: $!");
6987  if ($pid) {
6988    eval {
6989      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
6990      # So we use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
6991
6992      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
6993
6994      my @cmd = (
6995        $sftp,
6996        '-F',
6997        $ssh_config,
6998        '-oBatchMode=yes',
6999        '-oCheckHostIP=no',
7000        '-oCompression=yes',
7001        "-oPort=$port",
7002        "-oIdentityFile=$rsa_priv_key",
7003        '-oPubkeyAuthentication=yes',
7004        '-oStrictHostKeyChecking=no',
7005        '-vvv',
7006        '-b',
7007        $batch_file,
7008        "$setup->{user}\@127.0.0.1",
7009      );
7010
7011      my $sftp_rh = IO::Handle->new();
7012      my $sftp_wh = IO::Handle->new();
7013      my $sftp_eh = IO::Handle->new();
7014
7015      $sftp_wh->autoflush(1);
7016
7017      sleep(1);
7018
7019      local $SIG{CHLD} = 'DEFAULT';
7020
7021      # Make sure that the perms on the priv key are what OpenSSH wants
7022      unless (chmod(0400, $rsa_priv_key)) {
7023        die("Can't set perms on $rsa_priv_key to 0400: $!");
7024      }
7025
7026      if ($ENV{TEST_VERBOSE}) {
7027        print STDERR "Executing: ", join(' ', @cmd), "\n";
7028      }
7029
7030      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
7031      waitpid($sftp_pid, 0);
7032      my $exit_status = $?;
7033
7034      # Restore the perms on the priv key
7035      unless (chmod(0644, $rsa_priv_key)) {
7036        die("Can't set perms on $rsa_priv_key to 0644: $!");
7037      }
7038
7039      my ($res, $errstr);
7040      if ($exit_status >> 8 == 0) {
7041        $errstr = join('', <$sftp_eh>);
7042        $res = 0;
7043
7044      } else {
7045        $errstr = join('', <$sftp_eh>);
7046        if ($ENV{TEST_VERBOSE}) {
7047          print STDERR "Stderr: $errstr\n";
7048        }
7049
7050        $res = 1;
7051      }
7052
7053      unless ($res == 0) {
7054        die("Can't upload $src_file to server: $errstr");
7055      }
7056
7057      unless (-f $dst_file) {
7058        die("File '$dst_file' does not exist as expected");
7059      }
7060
7061      my $sz = (stat($dst_file))[7];
7062      my $expected_sz = $src_sz;
7063      $self->assert($expected_sz == $sz,
7064        test_msg("Expected file size $expected_sz, got $sz"));
7065    };
7066    if ($@) {
7067      $ex = $@;
7068    }
7069
7070    $wfh->print("done\n");
7071    $wfh->flush();
7072
7073  } else {
7074    eval { server_wait($setup->{config_file}, $rfh) };
7075    if ($@) {
7076      warn($@);
7077      exit 1;
7078    }
7079
7080    exit 0;
7081  }
7082
7083  # Stop server
7084  server_stop($setup->{pid_file});
7085  $self->assert_child_ok($pid);
7086
7087  test_cleanup($setup->{log_file}, $ex);
7088}
7089
7090sub ssh2_ext_hostkey_openssh_ed25519_cbc_passphraseprovider_bug4221 {
7091  my $self = shift;
7092  my $tmpdir = $self->{tmpdir};
7093  my $setup = test_setup($tmpdir, 'sftp');
7094
7095  my $openssh_ed25519_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/passphrase_host_openssh_ed25519_cbc_key');
7096  my $passphrase_provider = File::Spec->rel2abs('t/etc/modules/mod_sftp/sftp-get-passphrase.pl');
7097
7098  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
7099  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
7100  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
7101
7102  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
7103  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
7104    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
7105  }
7106
7107  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
7108  if (open(my $fh, "> $src_file")) {
7109    print $fh "Hello, World!\n";
7110
7111    unless (close($fh)) {
7112      die("Can't write $src_file: $!");
7113    }
7114
7115  } else {
7116    die("Can't open $src_file: $!");
7117  }
7118
7119  my $src_sz = (stat($src_file))[7];
7120  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
7121
7122  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
7123  if (open(my $fh, "> $ssh_config")) {
7124    print $fh <<EOC;
7125HostKeyAlgorithms ssh-ed25519
7126EOC
7127    unless (close($fh)) {
7128      die("Can't write $ssh_config: $!");
7129    }
7130
7131  } else {
7132    die("Can't open $ssh_config: $!");
7133  }
7134
7135  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
7136  if (open(my $fh, "> $batch_file")) {
7137    print $fh "put -P $src_file $dst_file\n";
7138
7139    unless (close($fh)) {
7140      die("Can't write $batch_file: $!");
7141    }
7142
7143  } else {
7144    die("Can't open $batch_file: $!");
7145  }
7146
7147  my $config = {
7148    PidFile => $setup->{pid_file},
7149    ScoreboardFile => $setup->{scoreboard_file},
7150    SystemLog => $setup->{log_file},
7151    TraceLog => $setup->{log_file},
7152    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
7153
7154    AuthUserFile => $setup->{auth_user_file},
7155    AuthGroupFile => $setup->{auth_group_file},
7156
7157    IfModules => {
7158      'mod_delay.c' => {
7159        DelayEngine => 'off',
7160      },
7161
7162      'mod_sftp.c' => [
7163        "SFTPEngine on",
7164        "SFTPLog $setup->{log_file}",
7165        "SFTPHostKey $openssh_ed25519_host_key",
7166        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
7167
7168        "SFTPPassPhraseProvider $passphrase_provider",
7169      ],
7170    },
7171  };
7172
7173  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
7174    $config);
7175
7176  # Open pipes, for use between the parent and child processes.  Specifically,
7177  # the child will indicate when it's done with its test by writing a message
7178  # to the parent.
7179  my ($rfh, $wfh);
7180  unless (pipe($rfh, $wfh)) {
7181    die("Can't open pipe: $!");
7182  }
7183
7184  require Net::SSH2;
7185
7186  my $ex;
7187
7188  # Fork child
7189  $self->handle_sigchld();
7190  defined(my $pid = fork()) or die("Can't fork: $!");
7191  if ($pid) {
7192    eval {
7193      # libssh2, and thus Net::SSH2, don't support OpenSSH formatted keys.
7194      # So we use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
7195
7196      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
7197
7198      my @cmd = (
7199        $sftp,
7200        '-F',
7201        $ssh_config,
7202        '-oBatchMode=yes',
7203        '-oCheckHostIP=no',
7204        '-oCompression=yes',
7205        "-oPort=$port",
7206        "-oIdentityFile=$rsa_priv_key",
7207        '-oPubkeyAuthentication=yes',
7208        '-oStrictHostKeyChecking=no',
7209        '-vvv',
7210        '-b',
7211        $batch_file,
7212        "$setup->{user}\@127.0.0.1",
7213      );
7214
7215      my $sftp_rh = IO::Handle->new();
7216      my $sftp_wh = IO::Handle->new();
7217      my $sftp_eh = IO::Handle->new();
7218
7219      $sftp_wh->autoflush(1);
7220
7221      sleep(1);
7222
7223      local $SIG{CHLD} = 'DEFAULT';
7224
7225      # Make sure that the perms on the priv key are what OpenSSH wants
7226      unless (chmod(0400, $rsa_priv_key)) {
7227        die("Can't set perms on $rsa_priv_key to 0400: $!");
7228      }
7229
7230      if ($ENV{TEST_VERBOSE}) {
7231        print STDERR "Executing: ", join(' ', @cmd), "\n";
7232      }
7233
7234      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
7235      waitpid($sftp_pid, 0);
7236      my $exit_status = $?;
7237
7238      # Restore the perms on the priv key
7239      unless (chmod(0644, $rsa_priv_key)) {
7240        die("Can't set perms on $rsa_priv_key to 0644: $!");
7241      }
7242
7243      my ($res, $errstr);
7244      if ($exit_status >> 8 == 0) {
7245        $errstr = join('', <$sftp_eh>);
7246        $res = 0;
7247
7248      } else {
7249        $errstr = join('', <$sftp_eh>);
7250        if ($ENV{TEST_VERBOSE}) {
7251          print STDERR "Stderr: $errstr\n";
7252        }
7253
7254        $res = 1;
7255      }
7256
7257      unless ($res == 0) {
7258        die("Can't upload $src_file to server: $errstr");
7259      }
7260
7261      unless (-f $dst_file) {
7262        die("File '$dst_file' does not exist as expected");
7263      }
7264
7265      my $sz = (stat($dst_file))[7];
7266      my $expected_sz = $src_sz;
7267      $self->assert($expected_sz == $sz,
7268        test_msg("Expected file size $expected_sz, got $sz"));
7269    };
7270    if ($@) {
7271      $ex = $@;
7272    }
7273
7274    $wfh->print("done\n");
7275    $wfh->flush();
7276
7277  } else {
7278    eval { server_wait($setup->{config_file}, $rfh) };
7279    if ($@) {
7280      warn($@);
7281      exit 1;
7282    }
7283
7284    exit 0;
7285  }
7286
7287  # Stop server
7288  server_stop($setup->{pid_file});
7289  $self->assert_child_ok($pid);
7290
7291  test_cleanup($setup->{log_file}, $ex);
7292}
7293
7294sub ssh2_cipher_c2s_aes256_cbc {
7295  my $self = shift;
7296  my $tmpdir = $self->{tmpdir};
7297
7298  my $config_file = "$tmpdir/sftp.conf";
7299  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
7300  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
7301
7302  my $log_file = test_get_logfile();
7303
7304  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
7305  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
7306
7307  my $user = 'proftpd';
7308  my $passwd = 'test';
7309  my $group = 'ftpd';
7310  my $home_dir = File::Spec->rel2abs($tmpdir);
7311  my $uid = 500;
7312  my $gid = 500;
7313
7314  # Make sure that, if we're running as root, that the home directory has
7315  # permissions/privs set for the account we create
7316  if ($< == 0) {
7317    unless (chmod(0755, $home_dir)) {
7318      die("Can't set perms on $home_dir to 0755: $!");
7319    }
7320
7321    unless (chown($uid, $gid, $home_dir)) {
7322      die("Can't set owner of $home_dir to $uid/$gid: $!");
7323    }
7324  }
7325
7326  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
7327    '/bin/bash');
7328  auth_group_write($auth_group_file, $group, $gid, $user);
7329
7330  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
7331  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
7332
7333  my $config = {
7334    PidFile => $pid_file,
7335    ScoreboardFile => $scoreboard_file,
7336    SystemLog => $log_file,
7337    TraceLog => $log_file,
7338    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
7339
7340    AuthUserFile => $auth_user_file,
7341    AuthGroupFile => $auth_group_file,
7342
7343    IfModules => {
7344      'mod_delay.c' => {
7345        DelayEngine => 'off',
7346      },
7347
7348      'mod_sftp.c' => [
7349        "SFTPEngine on",
7350        "SFTPLog $log_file",
7351        "SFTPHostKey $rsa_host_key",
7352        "SFTPHostKey $dsa_host_key",
7353      ],
7354    },
7355  };
7356
7357  my ($port, $config_user, $config_group) = config_write($config_file, $config);
7358
7359  # Open pipes, for use between the parent and child processes.  Specifically,
7360  # the child will indicate when it's done with its test by writing a message
7361  # to the parent.
7362  my ($rfh, $wfh);
7363  unless (pipe($rfh, $wfh)) {
7364    die("Can't open pipe: $!");
7365  }
7366
7367  require Net::SSH2;
7368
7369  my $ex;
7370
7371  # Fork child
7372  $self->handle_sigchld();
7373  defined(my $pid = fork()) or die("Can't fork: $!");
7374  if ($pid) {
7375    eval {
7376      my $ssh2 = Net::SSH2->new();
7377
7378      sleep(1);
7379
7380      my $cipher = 'aes256-cbc';
7381      $ssh2->method('crypt_cs', $cipher);
7382
7383      unless ($ssh2->connect('127.0.0.1', $port)) {
7384        my ($err_code, $err_name, $err_str) = $ssh2->error();
7385        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
7386      }
7387
7388      my $cipher_used = $ssh2->method('crypt_cs');
7389      $self->assert($cipher eq $cipher_used,
7390        test_msg("Expected '$cipher', got '$cipher_used'"));
7391
7392      $ssh2->disconnect();
7393    };
7394
7395    if ($@) {
7396      $ex = $@;
7397    }
7398
7399    $wfh->print("done\n");
7400    $wfh->flush();
7401
7402  } else {
7403    eval { server_wait($config_file, $rfh) };
7404    if ($@) {
7405      warn($@);
7406      exit 1;
7407    }
7408
7409    exit 0;
7410  }
7411
7412  # Stop server
7413  server_stop($pid_file);
7414
7415  $self->assert_child_ok($pid);
7416
7417  if ($ex) {
7418    test_append_logfile($log_file, $ex);
7419    unlink($log_file);
7420
7421    die($ex);
7422  }
7423
7424  unlink($log_file);
7425}
7426
7427sub ssh2_cipher_c2s_aes192_cbc {
7428  my $self = shift;
7429  my $tmpdir = $self->{tmpdir};
7430
7431  my $config_file = "$tmpdir/sftp.conf";
7432  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
7433  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
7434
7435  my $log_file = test_get_logfile();
7436
7437  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
7438  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
7439
7440  my $user = 'proftpd';
7441  my $passwd = 'test';
7442  my $group = 'ftpd';
7443  my $home_dir = File::Spec->rel2abs($tmpdir);
7444  my $uid = 500;
7445  my $gid = 500;
7446
7447  # Make sure that, if we're running as root, that the home directory has
7448  # permissions/privs set for the account we create
7449  if ($< == 0) {
7450    unless (chmod(0755, $home_dir)) {
7451      die("Can't set perms on $home_dir to 0755: $!");
7452    }
7453
7454    unless (chown($uid, $gid, $home_dir)) {
7455      die("Can't set owner of $home_dir to $uid/$gid: $!");
7456    }
7457  }
7458
7459  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
7460    '/bin/bash');
7461  auth_group_write($auth_group_file, $group, $gid, $user);
7462
7463  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
7464  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
7465
7466  my $config = {
7467    PidFile => $pid_file,
7468    ScoreboardFile => $scoreboard_file,
7469    SystemLog => $log_file,
7470    TraceLog => $log_file,
7471    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
7472
7473    AuthUserFile => $auth_user_file,
7474    AuthGroupFile => $auth_group_file,
7475
7476    IfModules => {
7477      'mod_delay.c' => {
7478        DelayEngine => 'off',
7479      },
7480
7481      'mod_sftp.c' => [
7482        "SFTPEngine on",
7483        "SFTPLog $log_file",
7484        "SFTPHostKey $rsa_host_key",
7485        "SFTPHostKey $dsa_host_key",
7486      ],
7487    },
7488  };
7489
7490  my ($port, $config_user, $config_group) = config_write($config_file, $config);
7491
7492  # Open pipes, for use between the parent and child processes.  Specifically,
7493  # the child will indicate when it's done with its test by writing a message
7494  # to the parent.
7495  my ($rfh, $wfh);
7496  unless (pipe($rfh, $wfh)) {
7497    die("Can't open pipe: $!");
7498  }
7499
7500  require Net::SSH2;
7501
7502  my $ex;
7503
7504  # Fork child
7505  $self->handle_sigchld();
7506  defined(my $pid = fork()) or die("Can't fork: $!");
7507  if ($pid) {
7508    eval {
7509      my $ssh2 = Net::SSH2->new();
7510
7511      sleep(1);
7512
7513      my $cipher = 'aes192-cbc';
7514      $ssh2->method('crypt_cs', $cipher);
7515
7516      unless ($ssh2->connect('127.0.0.1', $port)) {
7517        my ($err_code, $err_name, $err_str) = $ssh2->error();
7518        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
7519      }
7520
7521      my $cipher_used = $ssh2->method('crypt_cs');
7522      $self->assert($cipher eq $cipher_used,
7523        test_msg("Expected '$cipher', got '$cipher_used'"));
7524
7525      $ssh2->disconnect();
7526    };
7527
7528    if ($@) {
7529      $ex = $@;
7530    }
7531
7532    $wfh->print("done\n");
7533    $wfh->flush();
7534
7535  } else {
7536    eval { server_wait($config_file, $rfh) };
7537    if ($@) {
7538      warn($@);
7539      exit 1;
7540    }
7541
7542    exit 0;
7543  }
7544
7545  # Stop server
7546  server_stop($pid_file);
7547
7548  $self->assert_child_ok($pid);
7549
7550  if ($ex) {
7551    test_append_logfile($log_file, $ex);
7552    unlink($log_file);
7553
7554    die($ex);
7555  }
7556
7557  unlink($log_file);
7558}
7559
7560sub ssh2_cipher_c2s_aes128_cbc {
7561  my $self = shift;
7562  my $tmpdir = $self->{tmpdir};
7563
7564  my $config_file = "$tmpdir/sftp.conf";
7565  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
7566  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
7567
7568  my $log_file = test_get_logfile();
7569
7570  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
7571  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
7572
7573  my $user = 'proftpd';
7574  my $passwd = 'test';
7575  my $group = 'ftpd';
7576  my $home_dir = File::Spec->rel2abs($tmpdir);
7577  my $uid = 500;
7578  my $gid = 500;
7579
7580  # Make sure that, if we're running as root, that the home directory has
7581  # permissions/privs set for the account we create
7582  if ($< == 0) {
7583    unless (chmod(0755, $home_dir)) {
7584      die("Can't set perms on $home_dir to 0755: $!");
7585    }
7586
7587    unless (chown($uid, $gid, $home_dir)) {
7588      die("Can't set owner of $home_dir to $uid/$gid: $!");
7589    }
7590  }
7591
7592  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
7593    '/bin/bash');
7594  auth_group_write($auth_group_file, $group, $gid, $user);
7595
7596  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
7597  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
7598
7599  my $config = {
7600    PidFile => $pid_file,
7601    ScoreboardFile => $scoreboard_file,
7602    SystemLog => $log_file,
7603    TraceLog => $log_file,
7604    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
7605
7606    AuthUserFile => $auth_user_file,
7607    AuthGroupFile => $auth_group_file,
7608
7609    IfModules => {
7610      'mod_delay.c' => {
7611        DelayEngine => 'off',
7612      },
7613
7614      'mod_sftp.c' => [
7615        "SFTPEngine on",
7616        "SFTPLog $log_file",
7617        "SFTPHostKey $rsa_host_key",
7618        "SFTPHostKey $dsa_host_key",
7619      ],
7620    },
7621  };
7622
7623  my ($port, $config_user, $config_group) = config_write($config_file, $config);
7624
7625  # Open pipes, for use between the parent and child processes.  Specifically,
7626  # the child will indicate when it's done with its test by writing a message
7627  # to the parent.
7628  my ($rfh, $wfh);
7629  unless (pipe($rfh, $wfh)) {
7630    die("Can't open pipe: $!");
7631  }
7632
7633  require Net::SSH2;
7634
7635  my $ex;
7636
7637  # Fork child
7638  $self->handle_sigchld();
7639  defined(my $pid = fork()) or die("Can't fork: $!");
7640  if ($pid) {
7641    eval {
7642      my $ssh2 = Net::SSH2->new();
7643
7644      sleep(1);
7645
7646      my $cipher = 'aes128-cbc';
7647      $ssh2->method('crypt_cs', $cipher);
7648
7649      unless ($ssh2->connect('127.0.0.1', $port)) {
7650        my ($err_code, $err_name, $err_str) = $ssh2->error();
7651        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
7652      }
7653
7654      my $cipher_used = $ssh2->method('crypt_cs');
7655      $self->assert($cipher eq $cipher_used,
7656        test_msg("Expected '$cipher', got '$cipher_used'"));
7657
7658      $ssh2->disconnect();
7659    };
7660
7661    if ($@) {
7662      $ex = $@;
7663    }
7664
7665    $wfh->print("done\n");
7666    $wfh->flush();
7667
7668  } else {
7669    eval { server_wait($config_file, $rfh) };
7670    if ($@) {
7671      warn($@);
7672      exit 1;
7673    }
7674
7675    exit 0;
7676  }
7677
7678  # Stop server
7679  server_stop($pid_file);
7680
7681  $self->assert_child_ok($pid);
7682
7683  if ($ex) {
7684    test_append_logfile($log_file, $ex);
7685    unlink($log_file);
7686
7687    die($ex);
7688  }
7689
7690  unlink($log_file);
7691}
7692
7693sub ssh2_cipher_c2s_blowfish_cbc {
7694  my $self = shift;
7695  my $tmpdir = $self->{tmpdir};
7696
7697  my $config_file = "$tmpdir/sftp.conf";
7698  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
7699  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
7700
7701  my $log_file = test_get_logfile();
7702
7703  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
7704  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
7705
7706  my $user = 'proftpd';
7707  my $passwd = 'test';
7708  my $group = 'ftpd';
7709  my $home_dir = File::Spec->rel2abs($tmpdir);
7710  my $uid = 500;
7711  my $gid = 500;
7712
7713  # Make sure that, if we're running as root, that the home directory has
7714  # permissions/privs set for the account we create
7715  if ($< == 0) {
7716    unless (chmod(0755, $home_dir)) {
7717      die("Can't set perms on $home_dir to 0755: $!");
7718    }
7719
7720    unless (chown($uid, $gid, $home_dir)) {
7721      die("Can't set owner of $home_dir to $uid/$gid: $!");
7722    }
7723  }
7724
7725  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
7726    '/bin/bash');
7727  auth_group_write($auth_group_file, $group, $gid, $user);
7728
7729  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
7730  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
7731
7732  my $config = {
7733    PidFile => $pid_file,
7734    ScoreboardFile => $scoreboard_file,
7735    SystemLog => $log_file,
7736    TraceLog => $log_file,
7737    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
7738
7739    AuthUserFile => $auth_user_file,
7740    AuthGroupFile => $auth_group_file,
7741
7742    IfModules => {
7743      'mod_delay.c' => {
7744        DelayEngine => 'off',
7745      },
7746
7747      'mod_sftp.c' => [
7748        "SFTPEngine on",
7749        "SFTPLog $log_file",
7750        "SFTPHostKey $rsa_host_key",
7751        "SFTPHostKey $dsa_host_key",
7752        "SFTPCiphers blowfish-cbc",
7753      ],
7754    },
7755  };
7756
7757  my ($port, $config_user, $config_group) = config_write($config_file, $config);
7758
7759  # Open pipes, for use between the parent and child processes.  Specifically,
7760  # the child will indicate when it's done with its test by writing a message
7761  # to the parent.
7762  my ($rfh, $wfh);
7763  unless (pipe($rfh, $wfh)) {
7764    die("Can't open pipe: $!");
7765  }
7766
7767  require Net::SSH2;
7768
7769  my $ex;
7770
7771  # Fork child
7772  $self->handle_sigchld();
7773  defined(my $pid = fork()) or die("Can't fork: $!");
7774  if ($pid) {
7775    eval {
7776      my $ssh2 = Net::SSH2->new();
7777
7778      sleep(1);
7779
7780      my $cipher = 'blowfish-cbc';
7781      $ssh2->method('crypt_cs', $cipher);
7782
7783      unless ($ssh2->connect('127.0.0.1', $port)) {
7784        my ($err_code, $err_name, $err_str) = $ssh2->error();
7785        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
7786      }
7787
7788      my $cipher_used = $ssh2->method('crypt_cs');
7789      $self->assert($cipher eq $cipher_used,
7790        test_msg("Expected '$cipher', got '$cipher_used'"));
7791
7792      $ssh2->disconnect();
7793    };
7794
7795    if ($@) {
7796      $ex = $@;
7797    }
7798
7799    $wfh->print("done\n");
7800    $wfh->flush();
7801
7802  } else {
7803    eval { server_wait($config_file, $rfh) };
7804    if ($@) {
7805      warn($@);
7806      exit 1;
7807    }
7808
7809    exit 0;
7810  }
7811
7812  # Stop server
7813  server_stop($pid_file);
7814
7815  $self->assert_child_ok($pid);
7816
7817  if ($ex) {
7818    test_append_logfile($log_file, $ex);
7819    unlink($log_file);
7820
7821    die($ex);
7822  }
7823
7824  unlink($log_file);
7825}
7826
7827sub ssh2_cipher_c2s_arcfour {
7828  my $self = shift;
7829  my $tmpdir = $self->{tmpdir};
7830
7831  my $config_file = "$tmpdir/sftp.conf";
7832  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
7833  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
7834
7835  my $log_file = test_get_logfile();
7836
7837  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
7838  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
7839
7840  my $user = 'proftpd';
7841  my $passwd = 'test';
7842  my $group = 'ftpd';
7843  my $home_dir = File::Spec->rel2abs($tmpdir);
7844  my $uid = 500;
7845  my $gid = 500;
7846
7847  # Make sure that, if we're running as root, that the home directory has
7848  # permissions/privs set for the account we create
7849  if ($< == 0) {
7850    unless (chmod(0755, $home_dir)) {
7851      die("Can't set perms on $home_dir to 0755: $!");
7852    }
7853
7854    unless (chown($uid, $gid, $home_dir)) {
7855      die("Can't set owner of $home_dir to $uid/$gid: $!");
7856    }
7857  }
7858
7859  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
7860    '/bin/bash');
7861  auth_group_write($auth_group_file, $group, $gid, $user);
7862
7863  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
7864  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
7865
7866  my $config = {
7867    PidFile => $pid_file,
7868    ScoreboardFile => $scoreboard_file,
7869    SystemLog => $log_file,
7870    TraceLog => $log_file,
7871    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
7872
7873    AuthUserFile => $auth_user_file,
7874    AuthGroupFile => $auth_group_file,
7875
7876    IfModules => {
7877      'mod_delay.c' => {
7878        DelayEngine => 'off',
7879      },
7880
7881      'mod_sftp.c' => [
7882        "SFTPEngine on",
7883        "SFTPLog $log_file",
7884        "SFTPHostKey $rsa_host_key",
7885        "SFTPHostKey $dsa_host_key",
7886        "SFTPCiphers arcfour256",
7887      ],
7888    },
7889  };
7890
7891  my ($port, $config_user, $config_group) = config_write($config_file, $config);
7892
7893  # Open pipes, for use between the parent and child processes.  Specifically,
7894  # the child will indicate when it's done with its test by writing a message
7895  # to the parent.
7896  my ($rfh, $wfh);
7897  unless (pipe($rfh, $wfh)) {
7898    die("Can't open pipe: $!");
7899  }
7900
7901  require Net::SSH2;
7902
7903  my $ex;
7904
7905  # Fork child
7906  $self->handle_sigchld();
7907  defined(my $pid = fork()) or die("Can't fork: $!");
7908  if ($pid) {
7909    eval {
7910      my $ssh2 = Net::SSH2->new();
7911
7912      sleep(1);
7913
7914      my $cipher = 'arcfour,aes256-cbc';
7915      $ssh2->method('crypt_cs', $cipher);
7916
7917      unless ($ssh2->connect('127.0.0.1', $port)) {
7918        my ($err_code, $err_name, $err_str) = $ssh2->error();
7919        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
7920      }
7921
7922      my $cipher_used = $ssh2->method('crypt_cs');
7923
7924      # mod_sftp explicitly does NOT support the 'arcfour' cipher; it
7925      # DOES support 'arcfour256' and 'arcfour128', which are better anyway.
7926
7927      my $expected = 'aes256-cbc';
7928      $self->assert($expected eq $cipher_used,
7929        test_msg("Expected '$cipher', got '$cipher_used'"));
7930
7931      $ssh2->disconnect();
7932    };
7933
7934    if ($@) {
7935      $ex = $@;
7936    }
7937
7938    $wfh->print("done\n");
7939    $wfh->flush();
7940
7941  } else {
7942    eval { server_wait($config_file, $rfh) };
7943    if ($@) {
7944      warn($@);
7945      exit 1;
7946    }
7947
7948    exit 0;
7949  }
7950
7951  # Stop server
7952  server_stop($pid_file);
7953
7954  $self->assert_child_ok($pid);
7955
7956  if ($ex) {
7957    test_append_logfile($log_file, $ex);
7958    unlink($log_file);
7959
7960    die($ex);
7961  }
7962
7963  unlink($log_file);
7964}
7965
7966sub ssh2_cipher_c2s_cast128_cbc {
7967  my $self = shift;
7968  my $tmpdir = $self->{tmpdir};
7969
7970  my $config_file = "$tmpdir/sftp.conf";
7971  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
7972  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
7973
7974  my $log_file = test_get_logfile();
7975
7976  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
7977  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
7978
7979  my $user = 'proftpd';
7980  my $passwd = 'test';
7981  my $group = 'ftpd';
7982  my $home_dir = File::Spec->rel2abs($tmpdir);
7983  my $uid = 500;
7984  my $gid = 500;
7985
7986  # Make sure that, if we're running as root, that the home directory has
7987  # permissions/privs set for the account we create
7988  if ($< == 0) {
7989    unless (chmod(0755, $home_dir)) {
7990      die("Can't set perms on $home_dir to 0755: $!");
7991    }
7992
7993    unless (chown($uid, $gid, $home_dir)) {
7994      die("Can't set owner of $home_dir to $uid/$gid: $!");
7995    }
7996  }
7997
7998  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
7999    '/bin/bash');
8000  auth_group_write($auth_group_file, $group, $gid, $user);
8001
8002  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8003  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8004
8005  my $config = {
8006    PidFile => $pid_file,
8007    ScoreboardFile => $scoreboard_file,
8008    SystemLog => $log_file,
8009    TraceLog => $log_file,
8010    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8011
8012    AuthUserFile => $auth_user_file,
8013    AuthGroupFile => $auth_group_file,
8014
8015    IfModules => {
8016      'mod_delay.c' => {
8017        DelayEngine => 'off',
8018      },
8019
8020      'mod_sftp.c' => [
8021        "SFTPEngine on",
8022        "SFTPLog $log_file",
8023        "SFTPHostKey $rsa_host_key",
8024        "SFTPHostKey $dsa_host_key",
8025      ],
8026    },
8027  };
8028
8029  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8030
8031  # Open pipes, for use between the parent and child processes.  Specifically,
8032  # the child will indicate when it's done with its test by writing a message
8033  # to the parent.
8034  my ($rfh, $wfh);
8035  unless (pipe($rfh, $wfh)) {
8036    die("Can't open pipe: $!");
8037  }
8038
8039  require Net::SSH2;
8040
8041  my $ex;
8042
8043  # Fork child
8044  $self->handle_sigchld();
8045  defined(my $pid = fork()) or die("Can't fork: $!");
8046  if ($pid) {
8047    eval {
8048      my $ssh2 = Net::SSH2->new();
8049
8050      sleep(1);
8051
8052      my $cipher = 'cast128-cbc';
8053      $ssh2->method('crypt_cs', $cipher);
8054
8055      unless ($ssh2->connect('127.0.0.1', $port)) {
8056        my ($err_code, $err_name, $err_str) = $ssh2->error();
8057        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8058      }
8059
8060      my $cipher_used = $ssh2->method('crypt_cs');
8061      $self->assert($cipher eq $cipher_used,
8062        test_msg("Expected '$cipher', got '$cipher_used'"));
8063
8064      $ssh2->disconnect();
8065    };
8066
8067    if ($@) {
8068      $ex = $@;
8069    }
8070
8071    $wfh->print("done\n");
8072    $wfh->flush();
8073
8074  } else {
8075    eval { server_wait($config_file, $rfh) };
8076    if ($@) {
8077      warn($@);
8078      exit 1;
8079    }
8080
8081    exit 0;
8082  }
8083
8084  # Stop server
8085  server_stop($pid_file);
8086
8087  $self->assert_child_ok($pid);
8088
8089  if ($ex) {
8090    test_append_logfile($log_file, $ex);
8091    unlink($log_file);
8092
8093    die($ex);
8094  }
8095
8096  unlink($log_file);
8097}
8098
8099sub ssh2_cipher_c2s_3des_cbc {
8100  my $self = shift;
8101  my $tmpdir = $self->{tmpdir};
8102
8103  my $config_file = "$tmpdir/sftp.conf";
8104  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8105  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8106
8107  my $log_file = test_get_logfile();
8108
8109  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8110  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8111
8112  my $user = 'proftpd';
8113  my $passwd = 'test';
8114  my $group = 'ftpd';
8115  my $home_dir = File::Spec->rel2abs($tmpdir);
8116  my $uid = 500;
8117  my $gid = 500;
8118
8119  # Make sure that, if we're running as root, that the home directory has
8120  # permissions/privs set for the account we create
8121  if ($< == 0) {
8122    unless (chmod(0755, $home_dir)) {
8123      die("Can't set perms on $home_dir to 0755: $!");
8124    }
8125
8126    unless (chown($uid, $gid, $home_dir)) {
8127      die("Can't set owner of $home_dir to $uid/$gid: $!");
8128    }
8129  }
8130
8131  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8132    '/bin/bash');
8133  auth_group_write($auth_group_file, $group, $gid, $user);
8134
8135  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8136  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8137
8138  my $config = {
8139    PidFile => $pid_file,
8140    ScoreboardFile => $scoreboard_file,
8141    SystemLog => $log_file,
8142    TraceLog => $log_file,
8143    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8144
8145    AuthUserFile => $auth_user_file,
8146    AuthGroupFile => $auth_group_file,
8147
8148    IfModules => {
8149      'mod_delay.c' => {
8150        DelayEngine => 'off',
8151      },
8152
8153      'mod_sftp.c' => [
8154        "SFTPEngine on",
8155        "SFTPLog $log_file",
8156        "SFTPHostKey $rsa_host_key",
8157        "SFTPHostKey $dsa_host_key",
8158      ],
8159    },
8160  };
8161
8162  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8163
8164  # Open pipes, for use between the parent and child processes.  Specifically,
8165  # the child will indicate when it's done with its test by writing a message
8166  # to the parent.
8167  my ($rfh, $wfh);
8168  unless (pipe($rfh, $wfh)) {
8169    die("Can't open pipe: $!");
8170  }
8171
8172  require Net::SSH2;
8173
8174  my $ex;
8175
8176  # Fork child
8177  $self->handle_sigchld();
8178  defined(my $pid = fork()) or die("Can't fork: $!");
8179  if ($pid) {
8180    eval {
8181      my $ssh2 = Net::SSH2->new();
8182
8183      sleep(1);
8184
8185      my $cipher = '3des-cbc';
8186      $ssh2->method('crypt_cs', $cipher);
8187
8188      unless ($ssh2->connect('127.0.0.1', $port)) {
8189        my ($err_code, $err_name, $err_str) = $ssh2->error();
8190        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8191      }
8192
8193      my $cipher_used = $ssh2->method('crypt_cs');
8194      $self->assert($cipher eq $cipher_used,
8195        test_msg("Expected '$cipher', got '$cipher_used'"));
8196
8197      $ssh2->disconnect();
8198    };
8199
8200    if ($@) {
8201      $ex = $@;
8202    }
8203
8204    $wfh->print("done\n");
8205    $wfh->flush();
8206
8207  } else {
8208    eval { server_wait($config_file, $rfh) };
8209    if ($@) {
8210      warn($@);
8211      exit 1;
8212    }
8213
8214    exit 0;
8215  }
8216
8217  # Stop server
8218  server_stop($pid_file);
8219
8220  $self->assert_child_ok($pid);
8221
8222  if ($ex) {
8223    test_append_logfile($log_file, $ex);
8224    unlink($log_file);
8225
8226    die($ex);
8227  }
8228
8229  unlink($log_file);
8230}
8231
8232sub ssh2_cipher_c2s_none {
8233  my $self = shift;
8234  my $tmpdir = $self->{tmpdir};
8235
8236  my $config_file = "$tmpdir/sftp.conf";
8237  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8238  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8239
8240  my $log_file = test_get_logfile();
8241
8242  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8243  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8244
8245  my $user = 'proftpd';
8246  my $passwd = 'test';
8247  my $group = 'ftpd';
8248  my $home_dir = File::Spec->rel2abs($tmpdir);
8249  my $uid = 500;
8250  my $gid = 500;
8251
8252  # Make sure that, if we're running as root, that the home directory has
8253  # permissions/privs set for the account we create
8254  if ($< == 0) {
8255    unless (chmod(0755, $home_dir)) {
8256      die("Can't set perms on $home_dir to 0755: $!");
8257    }
8258
8259    unless (chown($uid, $gid, $home_dir)) {
8260      die("Can't set owner of $home_dir to $uid/$gid: $!");
8261    }
8262  }
8263
8264  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8265    '/bin/bash');
8266  auth_group_write($auth_group_file, $group, $gid, $user);
8267
8268  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8269  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8270
8271  my $config = {
8272    PidFile => $pid_file,
8273    ScoreboardFile => $scoreboard_file,
8274    SystemLog => $log_file,
8275    TraceLog => $log_file,
8276    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8277
8278    AuthUserFile => $auth_user_file,
8279    AuthGroupFile => $auth_group_file,
8280
8281    IfModules => {
8282      'mod_delay.c' => {
8283        DelayEngine => 'off',
8284      },
8285
8286      'mod_sftp.c' => [
8287        "SFTPEngine on",
8288        "SFTPLog $log_file",
8289        "SFTPHostKey $rsa_host_key",
8290        "SFTPHostKey $dsa_host_key",
8291        "SFTPCiphers none",
8292      ],
8293    },
8294  };
8295
8296  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8297
8298  # Open pipes, for use between the parent and child processes.  Specifically,
8299  # the child will indicate when it's done with its test by writing a message
8300  # to the parent.
8301  my ($rfh, $wfh);
8302  unless (pipe($rfh, $wfh)) {
8303    die("Can't open pipe: $!");
8304  }
8305
8306  require Net::SSH2;
8307
8308  my $ex;
8309
8310  # Fork child
8311  $self->handle_sigchld();
8312  defined(my $pid = fork()) or die("Can't fork: $!");
8313  if ($pid) {
8314    eval {
8315      my $ssh2 = Net::SSH2->new();
8316
8317      sleep(1);
8318
8319      my $cipher = 'none';
8320      $ssh2->method('crypt_cs', $cipher);
8321
8322      unless ($ssh2->connect('127.0.0.1', $port)) {
8323        my ($err_code, $err_name, $err_str) = $ssh2->error();
8324        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8325      }
8326
8327      my $cipher_used = $ssh2->method('crypt_cs');
8328      $self->assert($cipher eq $cipher_used,
8329        test_msg("Expected '$cipher', got '$cipher_used'"));
8330
8331      $ssh2->disconnect();
8332    };
8333
8334    if ($@) {
8335      $ex = $@;
8336    }
8337
8338    $wfh->print("done\n");
8339    $wfh->flush();
8340
8341  } else {
8342    eval { server_wait($config_file, $rfh) };
8343    if ($@) {
8344      warn($@);
8345      exit 1;
8346    }
8347
8348    exit 0;
8349  }
8350
8351  # Stop server
8352  server_stop($pid_file);
8353
8354  $self->assert_child_ok($pid);
8355
8356  if ($ex) {
8357    test_append_logfile($log_file, $ex);
8358    unlink($log_file);
8359
8360    die($ex);
8361  }
8362
8363  unlink($log_file);
8364}
8365
8366sub ssh2_cipher_s2c_aes256_cbc {
8367  my $self = shift;
8368  my $tmpdir = $self->{tmpdir};
8369
8370  my $config_file = "$tmpdir/sftp.conf";
8371  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8372  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8373
8374  my $log_file = test_get_logfile();
8375
8376  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8377  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8378
8379  my $user = 'proftpd';
8380  my $passwd = 'test';
8381  my $group = 'ftpd';
8382  my $home_dir = File::Spec->rel2abs($tmpdir);
8383  my $uid = 500;
8384  my $gid = 500;
8385
8386  # Make sure that, if we're running as root, that the home directory has
8387  # permissions/privs set for the account we create
8388  if ($< == 0) {
8389    unless (chmod(0755, $home_dir)) {
8390      die("Can't set perms on $home_dir to 0755: $!");
8391    }
8392
8393    unless (chown($uid, $gid, $home_dir)) {
8394      die("Can't set owner of $home_dir to $uid/$gid: $!");
8395    }
8396  }
8397
8398  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8399    '/bin/bash');
8400  auth_group_write($auth_group_file, $group, $gid, $user);
8401
8402  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8403  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8404
8405  my $config = {
8406    PidFile => $pid_file,
8407    ScoreboardFile => $scoreboard_file,
8408    SystemLog => $log_file,
8409    TraceLog => $log_file,
8410    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8411
8412    AuthUserFile => $auth_user_file,
8413    AuthGroupFile => $auth_group_file,
8414
8415    IfModules => {
8416      'mod_delay.c' => {
8417        DelayEngine => 'off',
8418      },
8419
8420      'mod_sftp.c' => [
8421        "SFTPEngine on",
8422        "SFTPLog $log_file",
8423        "SFTPHostKey $rsa_host_key",
8424        "SFTPHostKey $dsa_host_key",
8425      ],
8426    },
8427  };
8428
8429  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8430
8431  # Open pipes, for use between the parent and child processes.  Specifically,
8432  # the child will indicate when it's done with its test by writing a message
8433  # to the parent.
8434  my ($rfh, $wfh);
8435  unless (pipe($rfh, $wfh)) {
8436    die("Can't open pipe: $!");
8437  }
8438
8439  require Net::SSH2;
8440
8441  my $ex;
8442
8443  # Fork child
8444  $self->handle_sigchld();
8445  defined(my $pid = fork()) or die("Can't fork: $!");
8446  if ($pid) {
8447    eval {
8448      my $ssh2 = Net::SSH2->new();
8449
8450      sleep(1);
8451
8452      my $cipher = 'aes256-cbc';
8453      $ssh2->method('crypt_sc', $cipher);
8454
8455      unless ($ssh2->connect('127.0.0.1', $port)) {
8456        my ($err_code, $err_name, $err_str) = $ssh2->error();
8457        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8458      }
8459
8460      my $cipher_used = $ssh2->method('crypt_sc');
8461      $self->assert($cipher eq $cipher_used,
8462        test_msg("Expected '$cipher', got '$cipher_used'"));
8463
8464      $ssh2->disconnect();
8465    };
8466
8467    if ($@) {
8468      $ex = $@;
8469    }
8470
8471    $wfh->print("done\n");
8472    $wfh->flush();
8473
8474  } else {
8475    eval { server_wait($config_file, $rfh) };
8476    if ($@) {
8477      warn($@);
8478      exit 1;
8479    }
8480
8481    exit 0;
8482  }
8483
8484  # Stop server
8485  server_stop($pid_file);
8486
8487  $self->assert_child_ok($pid);
8488
8489  if ($ex) {
8490    test_append_logfile($log_file, $ex);
8491    unlink($log_file);
8492
8493    die($ex);
8494  }
8495
8496  unlink($log_file);
8497}
8498
8499sub ssh2_cipher_s2c_aes192_cbc {
8500  my $self = shift;
8501  my $tmpdir = $self->{tmpdir};
8502
8503  my $config_file = "$tmpdir/sftp.conf";
8504  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8505  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8506
8507  my $log_file = test_get_logfile();
8508
8509  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8510  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8511
8512  my $user = 'proftpd';
8513  my $passwd = 'test';
8514  my $group = 'ftpd';
8515  my $home_dir = File::Spec->rel2abs($tmpdir);
8516  my $uid = 500;
8517  my $gid = 500;
8518
8519  # Make sure that, if we're running as root, that the home directory has
8520  # permissions/privs set for the account we create
8521  if ($< == 0) {
8522    unless (chmod(0755, $home_dir)) {
8523      die("Can't set perms on $home_dir to 0755: $!");
8524    }
8525
8526    unless (chown($uid, $gid, $home_dir)) {
8527      die("Can't set owner of $home_dir to $uid/$gid: $!");
8528    }
8529  }
8530
8531  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8532    '/bin/bash');
8533  auth_group_write($auth_group_file, $group, $gid, $user);
8534
8535  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8536  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8537
8538  my $config = {
8539    PidFile => $pid_file,
8540    ScoreboardFile => $scoreboard_file,
8541    SystemLog => $log_file,
8542    TraceLog => $log_file,
8543    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8544
8545    AuthUserFile => $auth_user_file,
8546    AuthGroupFile => $auth_group_file,
8547
8548    IfModules => {
8549      'mod_delay.c' => {
8550        DelayEngine => 'off',
8551      },
8552
8553      'mod_sftp.c' => [
8554        "SFTPEngine on",
8555        "SFTPLog $log_file",
8556        "SFTPHostKey $rsa_host_key",
8557        "SFTPHostKey $dsa_host_key",
8558      ],
8559    },
8560  };
8561
8562  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8563
8564  # Open pipes, for use between the parent and child processes.  Specifically,
8565  # the child will indicate when it's done with its test by writing a message
8566  # to the parent.
8567  my ($rfh, $wfh);
8568  unless (pipe($rfh, $wfh)) {
8569    die("Can't open pipe: $!");
8570  }
8571
8572  require Net::SSH2;
8573
8574  my $ex;
8575
8576  # Fork child
8577  $self->handle_sigchld();
8578  defined(my $pid = fork()) or die("Can't fork: $!");
8579  if ($pid) {
8580    eval {
8581      my $ssh2 = Net::SSH2->new();
8582
8583      sleep(1);
8584
8585      my $cipher = 'aes192-cbc';
8586      $ssh2->method('crypt_cs', $cipher);
8587
8588      unless ($ssh2->connect('127.0.0.1', $port)) {
8589        my ($err_code, $err_name, $err_str) = $ssh2->error();
8590        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8591      }
8592
8593      my $cipher_used = $ssh2->method('crypt_cs');
8594      $self->assert($cipher eq $cipher_used,
8595        test_msg("Expected '$cipher', got '$cipher_used'"));
8596
8597      $ssh2->disconnect();
8598    };
8599
8600    if ($@) {
8601      $ex = $@;
8602    }
8603
8604    $wfh->print("done\n");
8605    $wfh->flush();
8606
8607  } else {
8608    eval { server_wait($config_file, $rfh) };
8609    if ($@) {
8610      warn($@);
8611      exit 1;
8612    }
8613
8614    exit 0;
8615  }
8616
8617  # Stop server
8618  server_stop($pid_file);
8619
8620  $self->assert_child_ok($pid);
8621
8622  if ($ex) {
8623    test_append_logfile($log_file, $ex);
8624    unlink($log_file);
8625
8626    die($ex);
8627  }
8628
8629  unlink($log_file);
8630}
8631
8632sub ssh2_cipher_s2c_aes128_cbc {
8633  my $self = shift;
8634  my $tmpdir = $self->{tmpdir};
8635
8636  my $config_file = "$tmpdir/sftp.conf";
8637  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8638  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8639
8640  my $log_file = test_get_logfile();
8641
8642  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8643  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8644
8645  my $user = 'proftpd';
8646  my $passwd = 'test';
8647  my $group = 'ftpd';
8648  my $home_dir = File::Spec->rel2abs($tmpdir);
8649  my $uid = 500;
8650  my $gid = 500;
8651
8652  # Make sure that, if we're running as root, that the home directory has
8653  # permissions/privs set for the account we create
8654  if ($< == 0) {
8655    unless (chmod(0755, $home_dir)) {
8656      die("Can't set perms on $home_dir to 0755: $!");
8657    }
8658
8659    unless (chown($uid, $gid, $home_dir)) {
8660      die("Can't set owner of $home_dir to $uid/$gid: $!");
8661    }
8662  }
8663
8664  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8665    '/bin/bash');
8666  auth_group_write($auth_group_file, $group, $gid, $user);
8667
8668  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8669  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8670
8671  my $config = {
8672    PidFile => $pid_file,
8673    ScoreboardFile => $scoreboard_file,
8674    SystemLog => $log_file,
8675    TraceLog => $log_file,
8676    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8677
8678    AuthUserFile => $auth_user_file,
8679    AuthGroupFile => $auth_group_file,
8680
8681    IfModules => {
8682      'mod_delay.c' => {
8683        DelayEngine => 'off',
8684      },
8685
8686      'mod_sftp.c' => [
8687        "SFTPEngine on",
8688        "SFTPLog $log_file",
8689        "SFTPHostKey $rsa_host_key",
8690        "SFTPHostKey $dsa_host_key",
8691      ],
8692    },
8693  };
8694
8695  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8696
8697  # Open pipes, for use between the parent and child processes.  Specifically,
8698  # the child will indicate when it's done with its test by writing a message
8699  # to the parent.
8700  my ($rfh, $wfh);
8701  unless (pipe($rfh, $wfh)) {
8702    die("Can't open pipe: $!");
8703  }
8704
8705  require Net::SSH2;
8706
8707  my $ex;
8708
8709  # Fork child
8710  $self->handle_sigchld();
8711  defined(my $pid = fork()) or die("Can't fork: $!");
8712  if ($pid) {
8713    eval {
8714      my $ssh2 = Net::SSH2->new();
8715
8716      sleep(1);
8717
8718      my $cipher = 'aes128-cbc';
8719      $ssh2->method('crypt_sc', $cipher);
8720
8721      unless ($ssh2->connect('127.0.0.1', $port)) {
8722        my ($err_code, $err_name, $err_str) = $ssh2->error();
8723        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8724      }
8725
8726      my $cipher_used = $ssh2->method('crypt_sc');
8727      $self->assert($cipher eq $cipher_used,
8728        test_msg("Expected '$cipher', got '$cipher_used'"));
8729
8730      $ssh2->disconnect();
8731    };
8732
8733    if ($@) {
8734      $ex = $@;
8735    }
8736
8737    $wfh->print("done\n");
8738    $wfh->flush();
8739
8740  } else {
8741    eval { server_wait($config_file, $rfh) };
8742    if ($@) {
8743      warn($@);
8744      exit 1;
8745    }
8746
8747    exit 0;
8748  }
8749
8750  # Stop server
8751  server_stop($pid_file);
8752
8753  $self->assert_child_ok($pid);
8754
8755  if ($ex) {
8756    test_append_logfile($log_file, $ex);
8757    unlink($log_file);
8758
8759    die($ex);
8760  }
8761
8762  unlink($log_file);
8763}
8764
8765sub ssh2_cipher_s2c_blowfish_cbc {
8766  my $self = shift;
8767  my $tmpdir = $self->{tmpdir};
8768
8769  my $config_file = "$tmpdir/sftp.conf";
8770  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8771  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8772
8773  my $log_file = test_get_logfile();
8774
8775  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8776  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8777
8778  my $user = 'proftpd';
8779  my $passwd = 'test';
8780  my $group = 'ftpd';
8781  my $home_dir = File::Spec->rel2abs($tmpdir);
8782  my $uid = 500;
8783  my $gid = 500;
8784
8785  # Make sure that, if we're running as root, that the home directory has
8786  # permissions/privs set for the account we create
8787  if ($< == 0) {
8788    unless (chmod(0755, $home_dir)) {
8789      die("Can't set perms on $home_dir to 0755: $!");
8790    }
8791
8792    unless (chown($uid, $gid, $home_dir)) {
8793      die("Can't set owner of $home_dir to $uid/$gid: $!");
8794    }
8795  }
8796
8797  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8798    '/bin/bash');
8799  auth_group_write($auth_group_file, $group, $gid, $user);
8800
8801  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8802  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8803
8804  my $config = {
8805    PidFile => $pid_file,
8806    ScoreboardFile => $scoreboard_file,
8807    SystemLog => $log_file,
8808    TraceLog => $log_file,
8809    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8810
8811    AuthUserFile => $auth_user_file,
8812    AuthGroupFile => $auth_group_file,
8813
8814    IfModules => {
8815      'mod_delay.c' => {
8816        DelayEngine => 'off',
8817      },
8818
8819      'mod_sftp.c' => [
8820        "SFTPEngine on",
8821        "SFTPLog $log_file",
8822        "SFTPHostKey $rsa_host_key",
8823        "SFTPHostKey $dsa_host_key",
8824        "SFTPCiphers blowfish-cbc",
8825      ],
8826    },
8827  };
8828
8829  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8830
8831  # Open pipes, for use between the parent and child processes.  Specifically,
8832  # the child will indicate when it's done with its test by writing a message
8833  # to the parent.
8834  my ($rfh, $wfh);
8835  unless (pipe($rfh, $wfh)) {
8836    die("Can't open pipe: $!");
8837  }
8838
8839  require Net::SSH2;
8840
8841  my $ex;
8842
8843  # Fork child
8844  $self->handle_sigchld();
8845  defined(my $pid = fork()) or die("Can't fork: $!");
8846  if ($pid) {
8847    eval {
8848      my $ssh2 = Net::SSH2->new();
8849
8850      sleep(1);
8851
8852      my $cipher = 'blowfish-cbc';
8853      $ssh2->method('crypt_sc', $cipher);
8854
8855      unless ($ssh2->connect('127.0.0.1', $port)) {
8856        my ($err_code, $err_name, $err_str) = $ssh2->error();
8857        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8858      }
8859
8860      my $cipher_used = $ssh2->method('crypt_sc');
8861      $self->assert($cipher eq $cipher_used,
8862        test_msg("Expected '$cipher', got '$cipher_used'"));
8863
8864      $ssh2->disconnect();
8865    };
8866
8867    if ($@) {
8868      $ex = $@;
8869    }
8870
8871    $wfh->print("done\n");
8872    $wfh->flush();
8873
8874  } else {
8875    eval { server_wait($config_file, $rfh) };
8876    if ($@) {
8877      warn($@);
8878      exit 1;
8879    }
8880
8881    exit 0;
8882  }
8883
8884  # Stop server
8885  server_stop($pid_file);
8886
8887  $self->assert_child_ok($pid);
8888
8889  if ($ex) {
8890    test_append_logfile($log_file, $ex);
8891    unlink($log_file);
8892
8893    die($ex);
8894  }
8895
8896  unlink($log_file);
8897}
8898
8899sub ssh2_cipher_s2c_arcfour {
8900  my $self = shift;
8901  my $tmpdir = $self->{tmpdir};
8902
8903  my $config_file = "$tmpdir/sftp.conf";
8904  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
8905  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
8906
8907  my $log_file = test_get_logfile();
8908
8909  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
8910  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
8911
8912  my $user = 'proftpd';
8913  my $passwd = 'test';
8914  my $group = 'ftpd';
8915  my $home_dir = File::Spec->rel2abs($tmpdir);
8916  my $uid = 500;
8917  my $gid = 500;
8918
8919  # Make sure that, if we're running as root, that the home directory has
8920  # permissions/privs set for the account we create
8921  if ($< == 0) {
8922    unless (chmod(0755, $home_dir)) {
8923      die("Can't set perms on $home_dir to 0755: $!");
8924    }
8925
8926    unless (chown($uid, $gid, $home_dir)) {
8927      die("Can't set owner of $home_dir to $uid/$gid: $!");
8928    }
8929  }
8930
8931  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
8932    '/bin/bash');
8933  auth_group_write($auth_group_file, $group, $gid, $user);
8934
8935  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
8936  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
8937
8938  my $config = {
8939    PidFile => $pid_file,
8940    ScoreboardFile => $scoreboard_file,
8941    SystemLog => $log_file,
8942    TraceLog => $log_file,
8943    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
8944
8945    AuthUserFile => $auth_user_file,
8946    AuthGroupFile => $auth_group_file,
8947
8948    IfModules => {
8949      'mod_delay.c' => {
8950        DelayEngine => 'off',
8951      },
8952
8953      'mod_sftp.c' => [
8954        "SFTPEngine on",
8955        "SFTPLog $log_file",
8956        "SFTPHostKey $rsa_host_key",
8957        "SFTPHostKey $dsa_host_key",
8958        "SFTPCiphers arcfour256",
8959      ],
8960    },
8961  };
8962
8963  my ($port, $config_user, $config_group) = config_write($config_file, $config);
8964
8965  # Open pipes, for use between the parent and child processes.  Specifically,
8966  # the child will indicate when it's done with its test by writing a message
8967  # to the parent.
8968  my ($rfh, $wfh);
8969  unless (pipe($rfh, $wfh)) {
8970    die("Can't open pipe: $!");
8971  }
8972
8973  require Net::SSH2;
8974
8975  my $ex;
8976
8977  # Fork child
8978  $self->handle_sigchld();
8979  defined(my $pid = fork()) or die("Can't fork: $!");
8980  if ($pid) {
8981    eval {
8982      my $ssh2 = Net::SSH2->new();
8983
8984      sleep(1);
8985
8986      my $cipher = 'arcfour,aes256-cbc';
8987      $ssh2->method('crypt_sc', $cipher);
8988
8989      unless ($ssh2->connect('127.0.0.1', $port)) {
8990        my ($err_code, $err_name, $err_str) = $ssh2->error();
8991        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
8992      }
8993
8994      my $cipher_used = $ssh2->method('crypt_sc');
8995
8996      # mod_sftp explicitly does NOT support the 'arcfour' cipher; it
8997      # DOES support 'arcfour256' and 'arcfour128', which are better anyway.
8998
8999      my $expected = 'aes256-cbc';
9000      $self->assert($expected eq $cipher_used,
9001        test_msg("Expected '$cipher', got '$cipher_used'"));
9002
9003      $ssh2->disconnect();
9004    };
9005
9006    if ($@) {
9007      $ex = $@;
9008    }
9009
9010    $wfh->print("done\n");
9011    $wfh->flush();
9012
9013  } else {
9014    eval { server_wait($config_file, $rfh) };
9015    if ($@) {
9016      warn($@);
9017      exit 1;
9018    }
9019
9020    exit 0;
9021  }
9022
9023  # Stop server
9024  server_stop($pid_file);
9025
9026  $self->assert_child_ok($pid);
9027
9028  if ($ex) {
9029    test_append_logfile($log_file, $ex);
9030    unlink($log_file);
9031
9032    die($ex);
9033  }
9034
9035  unlink($log_file);
9036}
9037
9038sub ssh2_cipher_s2c_cast128_cbc {
9039  my $self = shift;
9040  my $tmpdir = $self->{tmpdir};
9041
9042  my $config_file = "$tmpdir/sftp.conf";
9043  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9044  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9045
9046  my $log_file = test_get_logfile();
9047
9048  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9049  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9050
9051  my $user = 'proftpd';
9052  my $passwd = 'test';
9053  my $group = 'ftpd';
9054  my $home_dir = File::Spec->rel2abs($tmpdir);
9055  my $uid = 500;
9056  my $gid = 500;
9057
9058  # Make sure that, if we're running as root, that the home directory has
9059  # permissions/privs set for the account we create
9060  if ($< == 0) {
9061    unless (chmod(0755, $home_dir)) {
9062      die("Can't set perms on $home_dir to 0755: $!");
9063    }
9064
9065    unless (chown($uid, $gid, $home_dir)) {
9066      die("Can't set owner of $home_dir to $uid/$gid: $!");
9067    }
9068  }
9069
9070  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9071    '/bin/bash');
9072  auth_group_write($auth_group_file, $group, $gid, $user);
9073
9074  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9075  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9076
9077  my $config = {
9078    PidFile => $pid_file,
9079    ScoreboardFile => $scoreboard_file,
9080    SystemLog => $log_file,
9081    TraceLog => $log_file,
9082    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9083
9084    AuthUserFile => $auth_user_file,
9085    AuthGroupFile => $auth_group_file,
9086
9087    IfModules => {
9088      'mod_delay.c' => {
9089        DelayEngine => 'off',
9090      },
9091
9092      'mod_sftp.c' => [
9093        "SFTPEngine on",
9094        "SFTPLog $log_file",
9095        "SFTPHostKey $rsa_host_key",
9096        "SFTPHostKey $dsa_host_key",
9097      ],
9098    },
9099  };
9100
9101  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9102
9103  # Open pipes, for use between the parent and child processes.  Specifically,
9104  # the child will indicate when it's done with its test by writing a message
9105  # to the parent.
9106  my ($rfh, $wfh);
9107  unless (pipe($rfh, $wfh)) {
9108    die("Can't open pipe: $!");
9109  }
9110
9111  require Net::SSH2;
9112
9113  my $ex;
9114
9115  # Fork child
9116  $self->handle_sigchld();
9117  defined(my $pid = fork()) or die("Can't fork: $!");
9118  if ($pid) {
9119    eval {
9120      my $ssh2 = Net::SSH2->new();
9121
9122      sleep(1);
9123
9124      my $cipher = 'cast128-cbc';
9125      $ssh2->method('crypt_sc', $cipher);
9126
9127      unless ($ssh2->connect('127.0.0.1', $port)) {
9128        my ($err_code, $err_name, $err_str) = $ssh2->error();
9129        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9130      }
9131
9132      my $cipher_used = $ssh2->method('crypt_sc');
9133      $self->assert($cipher eq $cipher_used,
9134        test_msg("Expected '$cipher', got '$cipher_used'"));
9135
9136      $ssh2->disconnect();
9137    };
9138
9139    if ($@) {
9140      $ex = $@;
9141    }
9142
9143    $wfh->print("done\n");
9144    $wfh->flush();
9145
9146  } else {
9147    eval { server_wait($config_file, $rfh) };
9148    if ($@) {
9149      warn($@);
9150      exit 1;
9151    }
9152
9153    exit 0;
9154  }
9155
9156  # Stop server
9157  server_stop($pid_file);
9158
9159  $self->assert_child_ok($pid);
9160
9161  if ($ex) {
9162    test_append_logfile($log_file, $ex);
9163    unlink($log_file);
9164
9165    die($ex);
9166  }
9167
9168  unlink($log_file);
9169}
9170
9171sub ssh2_cipher_s2c_3des_cbc {
9172  my $self = shift;
9173  my $tmpdir = $self->{tmpdir};
9174
9175  my $config_file = "$tmpdir/sftp.conf";
9176  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9177  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9178
9179  my $log_file = test_get_logfile();
9180
9181  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9182  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9183
9184  my $user = 'proftpd';
9185  my $passwd = 'test';
9186  my $group = 'ftpd';
9187  my $home_dir = File::Spec->rel2abs($tmpdir);
9188  my $uid = 500;
9189  my $gid = 500;
9190
9191  # Make sure that, if we're running as root, that the home directory has
9192  # permissions/privs set for the account we create
9193  if ($< == 0) {
9194    unless (chmod(0755, $home_dir)) {
9195      die("Can't set perms on $home_dir to 0755: $!");
9196    }
9197
9198    unless (chown($uid, $gid, $home_dir)) {
9199      die("Can't set owner of $home_dir to $uid/$gid: $!");
9200    }
9201  }
9202
9203  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9204    '/bin/bash');
9205  auth_group_write($auth_group_file, $group, $gid, $user);
9206
9207  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9208  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9209
9210  my $config = {
9211    PidFile => $pid_file,
9212    ScoreboardFile => $scoreboard_file,
9213    SystemLog => $log_file,
9214    TraceLog => $log_file,
9215    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9216
9217    AuthUserFile => $auth_user_file,
9218    AuthGroupFile => $auth_group_file,
9219
9220    IfModules => {
9221      'mod_delay.c' => {
9222        DelayEngine => 'off',
9223      },
9224
9225      'mod_sftp.c' => [
9226        "SFTPEngine on",
9227        "SFTPLog $log_file",
9228        "SFTPHostKey $rsa_host_key",
9229        "SFTPHostKey $dsa_host_key",
9230      ],
9231    },
9232  };
9233
9234  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9235
9236  # Open pipes, for use between the parent and child processes.  Specifically,
9237  # the child will indicate when it's done with its test by writing a message
9238  # to the parent.
9239  my ($rfh, $wfh);
9240  unless (pipe($rfh, $wfh)) {
9241    die("Can't open pipe: $!");
9242  }
9243
9244  require Net::SSH2;
9245
9246  my $ex;
9247
9248  # Fork child
9249  $self->handle_sigchld();
9250  defined(my $pid = fork()) or die("Can't fork: $!");
9251  if ($pid) {
9252    eval {
9253      my $ssh2 = Net::SSH2->new();
9254
9255      sleep(1);
9256
9257      my $cipher = '3des-cbc';
9258      $ssh2->method('crypt_sc', $cipher);
9259
9260      unless ($ssh2->connect('127.0.0.1', $port)) {
9261        my ($err_code, $err_name, $err_str) = $ssh2->error();
9262        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9263      }
9264
9265      my $cipher_used = $ssh2->method('crypt_sc');
9266      $self->assert($cipher eq $cipher_used,
9267        test_msg("Expected '$cipher', got '$cipher_used'"));
9268
9269      $ssh2->disconnect();
9270    };
9271
9272    if ($@) {
9273      $ex = $@;
9274    }
9275
9276    $wfh->print("done\n");
9277    $wfh->flush();
9278
9279  } else {
9280    eval { server_wait($config_file, $rfh) };
9281    if ($@) {
9282      warn($@);
9283      exit 1;
9284    }
9285
9286    exit 0;
9287  }
9288
9289  # Stop server
9290  server_stop($pid_file);
9291
9292  $self->assert_child_ok($pid);
9293
9294  if ($ex) {
9295    test_append_logfile($log_file, $ex);
9296    unlink($log_file);
9297
9298    die($ex);
9299  }
9300
9301  unlink($log_file);
9302}
9303
9304sub ssh2_cipher_s2c_none {
9305  my $self = shift;
9306  my $tmpdir = $self->{tmpdir};
9307
9308  my $config_file = "$tmpdir/sftp.conf";
9309  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9310  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9311
9312  my $log_file = test_get_logfile();
9313
9314  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9315  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9316
9317  my $user = 'proftpd';
9318  my $passwd = 'test';
9319  my $group = 'ftpd';
9320  my $home_dir = File::Spec->rel2abs($tmpdir);
9321  my $uid = 500;
9322  my $gid = 500;
9323
9324  # Make sure that, if we're running as root, that the home directory has
9325  # permissions/privs set for the account we create
9326  if ($< == 0) {
9327    unless (chmod(0755, $home_dir)) {
9328      die("Can't set perms on $home_dir to 0755: $!");
9329    }
9330
9331    unless (chown($uid, $gid, $home_dir)) {
9332      die("Can't set owner of $home_dir to $uid/$gid: $!");
9333    }
9334  }
9335
9336  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9337    '/bin/bash');
9338  auth_group_write($auth_group_file, $group, $gid, $user);
9339
9340  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9341  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9342
9343  my $config = {
9344    PidFile => $pid_file,
9345    ScoreboardFile => $scoreboard_file,
9346    SystemLog => $log_file,
9347    TraceLog => $log_file,
9348    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9349
9350    AuthUserFile => $auth_user_file,
9351    AuthGroupFile => $auth_group_file,
9352
9353    IfModules => {
9354      'mod_delay.c' => {
9355        DelayEngine => 'off',
9356      },
9357
9358      'mod_sftp.c' => [
9359        "SFTPEngine on",
9360        "SFTPLog $log_file",
9361        "SFTPHostKey $rsa_host_key",
9362        "SFTPHostKey $dsa_host_key",
9363        "SFTPCiphers none",
9364      ],
9365    },
9366  };
9367
9368  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9369
9370  # Open pipes, for use between the parent and child processes.  Specifically,
9371  # the child will indicate when it's done with its test by writing a message
9372  # to the parent.
9373  my ($rfh, $wfh);
9374  unless (pipe($rfh, $wfh)) {
9375    die("Can't open pipe: $!");
9376  }
9377
9378  require Net::SSH2;
9379
9380  my $ex;
9381
9382  # Fork child
9383  $self->handle_sigchld();
9384  defined(my $pid = fork()) or die("Can't fork: $!");
9385  if ($pid) {
9386    eval {
9387      my $ssh2 = Net::SSH2->new();
9388
9389      sleep(1);
9390
9391      my $cipher = 'none';
9392      $ssh2->method('crypt_sc', $cipher);
9393
9394      unless ($ssh2->connect('127.0.0.1', $port)) {
9395        my ($err_code, $err_name, $err_str) = $ssh2->error();
9396        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9397      }
9398
9399      my $cipher_used = $ssh2->method('crypt_sc');
9400      $self->assert($cipher eq $cipher_used,
9401        test_msg("Expected '$cipher', got '$cipher_used'"));
9402
9403      $ssh2->disconnect();
9404    };
9405
9406    if ($@) {
9407      $ex = $@;
9408    }
9409
9410    $wfh->print("done\n");
9411    $wfh->flush();
9412
9413  } else {
9414    eval { server_wait($config_file, $rfh) };
9415    if ($@) {
9416      warn($@);
9417      exit 1;
9418    }
9419
9420    exit 0;
9421  }
9422
9423  # Stop server
9424  server_stop($pid_file);
9425
9426  $self->assert_child_ok($pid);
9427
9428  if ($ex) {
9429    test_append_logfile($log_file, $ex);
9430    unlink($log_file);
9431
9432    die($ex);
9433  }
9434
9435  unlink($log_file);
9436}
9437
9438sub ssh2_mac_c2s_hmac_sha1 {
9439  my $self = shift;
9440  my $tmpdir = $self->{tmpdir};
9441
9442  my $config_file = "$tmpdir/sftp.conf";
9443  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9444  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9445
9446  my $log_file = test_get_logfile();
9447
9448  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9449  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9450
9451  my $user = 'proftpd';
9452  my $passwd = 'test';
9453  my $group = 'ftpd';
9454  my $home_dir = File::Spec->rel2abs($tmpdir);
9455  my $uid = 500;
9456  my $gid = 500;
9457
9458  # Make sure that, if we're running as root, that the home directory has
9459  # permissions/privs set for the account we create
9460  if ($< == 0) {
9461    unless (chmod(0755, $home_dir)) {
9462      die("Can't set perms on $home_dir to 0755: $!");
9463    }
9464
9465    unless (chown($uid, $gid, $home_dir)) {
9466      die("Can't set owner of $home_dir to $uid/$gid: $!");
9467    }
9468  }
9469
9470  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9471    '/bin/bash');
9472  auth_group_write($auth_group_file, $group, $gid, $user);
9473
9474  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9475  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9476
9477  my $config = {
9478    PidFile => $pid_file,
9479    ScoreboardFile => $scoreboard_file,
9480    SystemLog => $log_file,
9481    TraceLog => $log_file,
9482    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9483
9484    AuthUserFile => $auth_user_file,
9485    AuthGroupFile => $auth_group_file,
9486
9487    IfModules => {
9488      'mod_delay.c' => {
9489        DelayEngine => 'off',
9490      },
9491
9492      'mod_sftp.c' => [
9493        "SFTPEngine on",
9494        "SFTPLog $log_file",
9495        "SFTPHostKey $rsa_host_key",
9496        "SFTPHostKey $dsa_host_key",
9497      ],
9498    },
9499  };
9500
9501  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9502
9503  # Open pipes, for use between the parent and child processes.  Specifically,
9504  # the child will indicate when it's done with its test by writing a message
9505  # to the parent.
9506  my ($rfh, $wfh);
9507  unless (pipe($rfh, $wfh)) {
9508    die("Can't open pipe: $!");
9509  }
9510
9511  require Net::SSH2;
9512
9513  my $ex;
9514
9515  # Fork child
9516  $self->handle_sigchld();
9517  defined(my $pid = fork()) or die("Can't fork: $!");
9518  if ($pid) {
9519    eval {
9520      my $ssh2 = Net::SSH2->new();
9521
9522      sleep(1);
9523
9524      my $mac = 'hmac-sha1';
9525      $ssh2->method('mac_cs', $mac);
9526
9527      unless ($ssh2->connect('127.0.0.1', $port)) {
9528        my ($err_code, $err_name, $err_str) = $ssh2->error();
9529        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9530      }
9531
9532      my $mac_used = $ssh2->method('mac_cs');
9533      $self->assert($mac eq $mac_used,
9534        test_msg("Expected '$mac', got '$mac_used'"));
9535
9536      $ssh2->disconnect();
9537    };
9538
9539    if ($@) {
9540      $ex = $@;
9541    }
9542
9543    $wfh->print("done\n");
9544    $wfh->flush();
9545
9546  } else {
9547    eval { server_wait($config_file, $rfh) };
9548    if ($@) {
9549      warn($@);
9550      exit 1;
9551    }
9552
9553    exit 0;
9554  }
9555
9556  # Stop server
9557  server_stop($pid_file);
9558
9559  $self->assert_child_ok($pid);
9560
9561  if ($ex) {
9562    test_append_logfile($log_file, $ex);
9563    unlink($log_file);
9564
9565    die($ex);
9566  }
9567
9568  unlink($log_file);
9569}
9570
9571sub ssh2_mac_c2s_hmac_sha1_96 {
9572  my $self = shift;
9573  my $tmpdir = $self->{tmpdir};
9574
9575  my $config_file = "$tmpdir/sftp.conf";
9576  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9577  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9578
9579  my $log_file = test_get_logfile();
9580
9581  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9582  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9583
9584  my $user = 'proftpd';
9585  my $passwd = 'test';
9586  my $group = 'ftpd';
9587  my $home_dir = File::Spec->rel2abs($tmpdir);
9588  my $uid = 500;
9589  my $gid = 500;
9590
9591  # Make sure that, if we're running as root, that the home directory has
9592  # permissions/privs set for the account we create
9593  if ($< == 0) {
9594    unless (chmod(0755, $home_dir)) {
9595      die("Can't set perms on $home_dir to 0755: $!");
9596    }
9597
9598    unless (chown($uid, $gid, $home_dir)) {
9599      die("Can't set owner of $home_dir to $uid/$gid: $!");
9600    }
9601  }
9602
9603  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9604    '/bin/bash');
9605  auth_group_write($auth_group_file, $group, $gid, $user);
9606
9607  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9608  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9609
9610  my $config = {
9611    PidFile => $pid_file,
9612    ScoreboardFile => $scoreboard_file,
9613    SystemLog => $log_file,
9614    TraceLog => $log_file,
9615    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9616
9617    AuthUserFile => $auth_user_file,
9618    AuthGroupFile => $auth_group_file,
9619
9620    IfModules => {
9621      'mod_delay.c' => {
9622        DelayEngine => 'off',
9623      },
9624
9625      'mod_sftp.c' => [
9626        "SFTPEngine on",
9627        "SFTPLog $log_file",
9628        "SFTPHostKey $rsa_host_key",
9629        "SFTPHostKey $dsa_host_key",
9630      ],
9631    },
9632  };
9633
9634  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9635
9636  # Open pipes, for use between the parent and child processes.  Specifically,
9637  # the child will indicate when it's done with its test by writing a message
9638  # to the parent.
9639  my ($rfh, $wfh);
9640  unless (pipe($rfh, $wfh)) {
9641    die("Can't open pipe: $!");
9642  }
9643
9644  require Net::SSH2;
9645
9646  my $ex;
9647
9648  # Fork child
9649  $self->handle_sigchld();
9650  defined(my $pid = fork()) or die("Can't fork: $!");
9651  if ($pid) {
9652    eval {
9653      my $ssh2 = Net::SSH2->new();
9654
9655      sleep(1);
9656
9657      my $mac = 'hmac-sha1-96';
9658      $ssh2->method('mac_cs', $mac);
9659
9660      unless ($ssh2->connect('127.0.0.1', $port)) {
9661        my ($err_code, $err_name, $err_str) = $ssh2->error();
9662        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9663      }
9664
9665      my $mac_used = $ssh2->method('mac_cs');
9666      $self->assert($mac eq $mac_used,
9667        test_msg("Expected '$mac', got '$mac_used'"));
9668
9669      $ssh2->disconnect();
9670    };
9671
9672    if ($@) {
9673      $ex = $@;
9674    }
9675
9676    $wfh->print("done\n");
9677    $wfh->flush();
9678
9679  } else {
9680    eval { server_wait($config_file, $rfh) };
9681    if ($@) {
9682      warn($@);
9683      exit 1;
9684    }
9685
9686    exit 0;
9687  }
9688
9689  # Stop server
9690  server_stop($pid_file);
9691
9692  $self->assert_child_ok($pid);
9693
9694  if ($ex) {
9695    test_append_logfile($log_file, $ex);
9696    unlink($log_file);
9697
9698    die($ex);
9699  }
9700
9701  unlink($log_file);
9702}
9703
9704sub ssh2_mac_c2s_hmac_md5 {
9705  my $self = shift;
9706  my $tmpdir = $self->{tmpdir};
9707
9708  my $config_file = "$tmpdir/sftp.conf";
9709  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9710  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9711
9712  my $log_file = test_get_logfile();
9713
9714  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9715  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9716
9717  my $user = 'proftpd';
9718  my $passwd = 'test';
9719  my $group = 'ftpd';
9720  my $home_dir = File::Spec->rel2abs($tmpdir);
9721  my $uid = 500;
9722  my $gid = 500;
9723
9724  # Make sure that, if we're running as root, that the home directory has
9725  # permissions/privs set for the account we create
9726  if ($< == 0) {
9727    unless (chmod(0755, $home_dir)) {
9728      die("Can't set perms on $home_dir to 0755: $!");
9729    }
9730
9731    unless (chown($uid, $gid, $home_dir)) {
9732      die("Can't set owner of $home_dir to $uid/$gid: $!");
9733    }
9734  }
9735
9736  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9737    '/bin/bash');
9738  auth_group_write($auth_group_file, $group, $gid, $user);
9739
9740  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9741  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9742
9743  my $config = {
9744    PidFile => $pid_file,
9745    ScoreboardFile => $scoreboard_file,
9746    SystemLog => $log_file,
9747    TraceLog => $log_file,
9748    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9749
9750    AuthUserFile => $auth_user_file,
9751    AuthGroupFile => $auth_group_file,
9752
9753    IfModules => {
9754      'mod_delay.c' => {
9755        DelayEngine => 'off',
9756      },
9757
9758      'mod_sftp.c' => [
9759        "SFTPEngine on",
9760        "SFTPLog $log_file",
9761        "SFTPHostKey $rsa_host_key",
9762        "SFTPHostKey $dsa_host_key",
9763        "SFTPDigests hmac-md5",
9764      ],
9765    },
9766  };
9767
9768  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9769
9770  # Open pipes, for use between the parent and child processes.  Specifically,
9771  # the child will indicate when it's done with its test by writing a message
9772  # to the parent.
9773  my ($rfh, $wfh);
9774  unless (pipe($rfh, $wfh)) {
9775    die("Can't open pipe: $!");
9776  }
9777
9778  require Net::SSH2;
9779
9780  my $ex;
9781
9782  # Fork child
9783  $self->handle_sigchld();
9784  defined(my $pid = fork()) or die("Can't fork: $!");
9785  if ($pid) {
9786    eval {
9787      my $ssh2 = Net::SSH2->new();
9788
9789      sleep(1);
9790
9791      my $mac = 'hmac-md5';
9792      $ssh2->method('mac_cs', $mac);
9793
9794      unless ($ssh2->connect('127.0.0.1', $port)) {
9795        my ($err_code, $err_name, $err_str) = $ssh2->error();
9796        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9797      }
9798
9799      my $mac_used = $ssh2->method('mac_cs');
9800      $self->assert($mac eq $mac_used,
9801        test_msg("Expected '$mac', got '$mac_used'"));
9802
9803      $ssh2->disconnect();
9804    };
9805
9806    if ($@) {
9807      $ex = $@;
9808    }
9809
9810    $wfh->print("done\n");
9811    $wfh->flush();
9812
9813  } else {
9814    eval { server_wait($config_file, $rfh) };
9815    if ($@) {
9816      warn($@);
9817      exit 1;
9818    }
9819
9820    exit 0;
9821  }
9822
9823  # Stop server
9824  server_stop($pid_file);
9825
9826  $self->assert_child_ok($pid);
9827
9828  if ($ex) {
9829    test_append_logfile($log_file, $ex);
9830    unlink($log_file);
9831
9832    die($ex);
9833  }
9834
9835  unlink($log_file);
9836}
9837
9838sub ssh2_mac_c2s_hmac_md5_96 {
9839  my $self = shift;
9840  my $tmpdir = $self->{tmpdir};
9841
9842  my $config_file = "$tmpdir/sftp.conf";
9843  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9844  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9845
9846  my $log_file = test_get_logfile();
9847
9848  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9849  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9850
9851  my $user = 'proftpd';
9852  my $passwd = 'test';
9853  my $group = 'ftpd';
9854  my $home_dir = File::Spec->rel2abs($tmpdir);
9855  my $uid = 500;
9856  my $gid = 500;
9857
9858  # Make sure that, if we're running as root, that the home directory has
9859  # permissions/privs set for the account we create
9860  if ($< == 0) {
9861    unless (chmod(0755, $home_dir)) {
9862      die("Can't set perms on $home_dir to 0755: $!");
9863    }
9864
9865    unless (chown($uid, $gid, $home_dir)) {
9866      die("Can't set owner of $home_dir to $uid/$gid: $!");
9867    }
9868  }
9869
9870  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
9871    '/bin/bash');
9872  auth_group_write($auth_group_file, $group, $gid, $user);
9873
9874  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
9875  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
9876
9877  my $config = {
9878    PidFile => $pid_file,
9879    ScoreboardFile => $scoreboard_file,
9880    SystemLog => $log_file,
9881    TraceLog => $log_file,
9882    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
9883
9884    AuthUserFile => $auth_user_file,
9885    AuthGroupFile => $auth_group_file,
9886
9887    IfModules => {
9888      'mod_delay.c' => {
9889        DelayEngine => 'off',
9890      },
9891
9892      'mod_sftp.c' => [
9893        "SFTPEngine on",
9894        "SFTPLog $log_file",
9895        "SFTPHostKey $rsa_host_key",
9896        "SFTPHostKey $dsa_host_key",
9897        "SFTPDigests hmac-md5-96",
9898      ],
9899    },
9900  };
9901
9902  my ($port, $config_user, $config_group) = config_write($config_file, $config);
9903
9904  # Open pipes, for use between the parent and child processes.  Specifically,
9905  # the child will indicate when it's done with its test by writing a message
9906  # to the parent.
9907  my ($rfh, $wfh);
9908  unless (pipe($rfh, $wfh)) {
9909    die("Can't open pipe: $!");
9910  }
9911
9912  require Net::SSH2;
9913
9914  my $ex;
9915
9916  # Fork child
9917  $self->handle_sigchld();
9918  defined(my $pid = fork()) or die("Can't fork: $!");
9919  if ($pid) {
9920    eval {
9921      my $ssh2 = Net::SSH2->new();
9922
9923      sleep(1);
9924
9925      my $mac = 'hmac-md5-96';
9926      $ssh2->method('mac_cs', $mac);
9927
9928      unless ($ssh2->connect('127.0.0.1', $port)) {
9929        my ($err_code, $err_name, $err_str) = $ssh2->error();
9930        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
9931      }
9932
9933      my $mac_used = $ssh2->method('mac_cs');
9934      $self->assert($mac eq $mac_used,
9935        test_msg("Expected '$mac', got '$mac_used'"));
9936
9937      $ssh2->disconnect();
9938    };
9939
9940    if ($@) {
9941      $ex = $@;
9942    }
9943
9944    $wfh->print("done\n");
9945    $wfh->flush();
9946
9947  } else {
9948    eval { server_wait($config_file, $rfh) };
9949    if ($@) {
9950      warn($@);
9951      exit 1;
9952    }
9953
9954    exit 0;
9955  }
9956
9957  # Stop server
9958  server_stop($pid_file);
9959
9960  $self->assert_child_ok($pid);
9961
9962  if ($ex) {
9963    test_append_logfile($log_file, $ex);
9964    unlink($log_file);
9965
9966    die($ex);
9967  }
9968
9969  unlink($log_file);
9970}
9971
9972sub ssh2_mac_c2s_hmac_ripemd160 {
9973  my $self = shift;
9974  my $tmpdir = $self->{tmpdir};
9975
9976  my $config_file = "$tmpdir/sftp.conf";
9977  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
9978  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
9979
9980  my $log_file = test_get_logfile();
9981
9982  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
9983  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
9984
9985  my $user = 'proftpd';
9986  my $passwd = 'test';
9987  my $group = 'ftpd';
9988  my $home_dir = File::Spec->rel2abs($tmpdir);
9989  my $uid = 500;
9990  my $gid = 500;
9991
9992  # Make sure that, if we're running as root, that the home directory has
9993  # permissions/privs set for the account we create
9994  if ($< == 0) {
9995    unless (chmod(0755, $home_dir)) {
9996      die("Can't set perms on $home_dir to 0755: $!");
9997    }
9998
9999    unless (chown($uid, $gid, $home_dir)) {
10000      die("Can't set owner of $home_dir to $uid/$gid: $!");
10001    }
10002  }
10003
10004  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10005    '/bin/bash');
10006  auth_group_write($auth_group_file, $group, $gid, $user);
10007
10008  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10009  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10010
10011  my $config = {
10012    PidFile => $pid_file,
10013    ScoreboardFile => $scoreboard_file,
10014    SystemLog => $log_file,
10015    TraceLog => $log_file,
10016    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10017
10018    AuthUserFile => $auth_user_file,
10019    AuthGroupFile => $auth_group_file,
10020
10021    IfModules => {
10022      'mod_delay.c' => {
10023        DelayEngine => 'off',
10024      },
10025
10026      'mod_sftp.c' => [
10027        "SFTPEngine on",
10028        "SFTPLog $log_file",
10029        "SFTPHostKey $rsa_host_key",
10030        "SFTPHostKey $dsa_host_key",
10031        "SFTPDigests hmac-ripemd160",
10032      ],
10033    },
10034  };
10035
10036  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10037
10038  # Open pipes, for use between the parent and child processes.  Specifically,
10039  # the child will indicate when it's done with its test by writing a message
10040  # to the parent.
10041  my ($rfh, $wfh);
10042  unless (pipe($rfh, $wfh)) {
10043    die("Can't open pipe: $!");
10044  }
10045
10046  require Net::SSH2;
10047
10048  my $ex;
10049
10050  # Fork child
10051  $self->handle_sigchld();
10052  defined(my $pid = fork()) or die("Can't fork: $!");
10053  if ($pid) {
10054    eval {
10055      my $ssh2 = Net::SSH2->new();
10056
10057      sleep(1);
10058
10059      my $mac = 'hmac-ripemd160';
10060      $ssh2->method('mac_cs', $mac);
10061
10062      unless ($ssh2->connect('127.0.0.1', $port)) {
10063        my ($err_code, $err_name, $err_str) = $ssh2->error();
10064        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10065      }
10066
10067      my $mac_used = $ssh2->method('mac_cs');
10068      $self->assert($mac eq $mac_used,
10069        test_msg("Expected '$mac', got '$mac_used'"));
10070
10071      $ssh2->disconnect();
10072    };
10073
10074    if ($@) {
10075      $ex = $@;
10076    }
10077
10078    $wfh->print("done\n");
10079    $wfh->flush();
10080
10081  } else {
10082    eval { server_wait($config_file, $rfh) };
10083    if ($@) {
10084      warn($@);
10085      exit 1;
10086    }
10087
10088    exit 0;
10089  }
10090
10091  # Stop server
10092  server_stop($pid_file);
10093
10094  $self->assert_child_ok($pid);
10095
10096  if ($ex) {
10097    test_append_logfile($log_file, $ex);
10098    unlink($log_file);
10099
10100    die($ex);
10101  }
10102
10103  unlink($log_file);
10104}
10105
10106sub ssh2_mac_c2s_none {
10107  my $self = shift;
10108  my $tmpdir = $self->{tmpdir};
10109
10110  my $config_file = "$tmpdir/sftp.conf";
10111  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10112  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10113
10114  my $log_file = test_get_logfile();
10115
10116  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10117  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10118
10119  my $user = 'proftpd';
10120  my $passwd = 'test';
10121  my $group = 'ftpd';
10122  my $home_dir = File::Spec->rel2abs($tmpdir);
10123  my $uid = 500;
10124  my $gid = 500;
10125
10126  # Make sure that, if we're running as root, that the home directory has
10127  # permissions/privs set for the account we create
10128  if ($< == 0) {
10129    unless (chmod(0755, $home_dir)) {
10130      die("Can't set perms on $home_dir to 0755: $!");
10131    }
10132
10133    unless (chown($uid, $gid, $home_dir)) {
10134      die("Can't set owner of $home_dir to $uid/$gid: $!");
10135    }
10136  }
10137
10138  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10139    '/bin/bash');
10140  auth_group_write($auth_group_file, $group, $gid, $user);
10141
10142  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10143  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10144
10145  my $config = {
10146    PidFile => $pid_file,
10147    ScoreboardFile => $scoreboard_file,
10148    SystemLog => $log_file,
10149    TraceLog => $log_file,
10150    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10151
10152    AuthUserFile => $auth_user_file,
10153    AuthGroupFile => $auth_group_file,
10154
10155    IfModules => {
10156      'mod_delay.c' => {
10157        DelayEngine => 'off',
10158      },
10159
10160      'mod_sftp.c' => [
10161        "SFTPEngine on",
10162        "SFTPLog $log_file",
10163        "SFTPHostKey $rsa_host_key",
10164        "SFTPHostKey $dsa_host_key",
10165        "SFTPDigests none",
10166      ],
10167    },
10168  };
10169
10170  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10171
10172  # Open pipes, for use between the parent and child processes.  Specifically,
10173  # the child will indicate when it's done with its test by writing a message
10174  # to the parent.
10175  my ($rfh, $wfh);
10176  unless (pipe($rfh, $wfh)) {
10177    die("Can't open pipe: $!");
10178  }
10179
10180  require Net::SSH2;
10181
10182  my $ex;
10183
10184  # Fork child
10185  $self->handle_sigchld();
10186  defined(my $pid = fork()) or die("Can't fork: $!");
10187  if ($pid) {
10188    eval {
10189      my $ssh2 = Net::SSH2->new();
10190
10191      sleep(1);
10192
10193      my $mac = 'none';
10194      $ssh2->method('mac_cs', $mac);
10195
10196      unless ($ssh2->connect('127.0.0.1', $port)) {
10197        my ($err_code, $err_name, $err_str) = $ssh2->error();
10198        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10199      }
10200
10201      my $mac_used = $ssh2->method('mac_cs');
10202      $self->assert($mac eq $mac_used,
10203        test_msg("Expected '$mac', got '$mac_used'"));
10204
10205      $ssh2->disconnect();
10206    };
10207
10208    if ($@) {
10209      $ex = $@;
10210    }
10211
10212    $wfh->print("done\n");
10213    $wfh->flush();
10214
10215  } else {
10216    eval { server_wait($config_file, $rfh) };
10217    if ($@) {
10218      warn($@);
10219      exit 1;
10220    }
10221
10222    exit 0;
10223  }
10224
10225  # Stop server
10226  server_stop($pid_file);
10227
10228  $self->assert_child_ok($pid);
10229
10230  if ($ex) {
10231    test_append_logfile($log_file, $ex);
10232    unlink($log_file);
10233
10234    die($ex);
10235  }
10236
10237  unlink($log_file);
10238}
10239
10240sub ssh2_mac_s2c_hmac_sha1 {
10241  my $self = shift;
10242  my $tmpdir = $self->{tmpdir};
10243
10244  my $config_file = "$tmpdir/sftp.conf";
10245  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10246  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10247
10248  my $log_file = test_get_logfile();
10249
10250  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10251  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10252
10253  my $user = 'proftpd';
10254  my $passwd = 'test';
10255  my $group = 'ftpd';
10256  my $home_dir = File::Spec->rel2abs($tmpdir);
10257  my $uid = 500;
10258  my $gid = 500;
10259
10260  # Make sure that, if we're running as root, that the home directory has
10261  # permissions/privs set for the account we create
10262  if ($< == 0) {
10263    unless (chmod(0755, $home_dir)) {
10264      die("Can't set perms on $home_dir to 0755: $!");
10265    }
10266
10267    unless (chown($uid, $gid, $home_dir)) {
10268      die("Can't set owner of $home_dir to $uid/$gid: $!");
10269    }
10270  }
10271
10272  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10273    '/bin/bash');
10274  auth_group_write($auth_group_file, $group, $gid, $user);
10275
10276  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10277  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10278
10279  my $config = {
10280    PidFile => $pid_file,
10281    ScoreboardFile => $scoreboard_file,
10282    SystemLog => $log_file,
10283    TraceLog => $log_file,
10284    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10285
10286    AuthUserFile => $auth_user_file,
10287    AuthGroupFile => $auth_group_file,
10288
10289    IfModules => {
10290      'mod_delay.c' => {
10291        DelayEngine => 'off',
10292      },
10293
10294      'mod_sftp.c' => [
10295        "SFTPEngine on",
10296        "SFTPLog $log_file",
10297        "SFTPHostKey $rsa_host_key",
10298        "SFTPHostKey $dsa_host_key",
10299      ],
10300    },
10301  };
10302
10303  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10304
10305  # Open pipes, for use between the parent and child processes.  Specifically,
10306  # the child will indicate when it's done with its test by writing a message
10307  # to the parent.
10308  my ($rfh, $wfh);
10309  unless (pipe($rfh, $wfh)) {
10310    die("Can't open pipe: $!");
10311  }
10312
10313  require Net::SSH2;
10314
10315  my $ex;
10316
10317  # Fork child
10318  $self->handle_sigchld();
10319  defined(my $pid = fork()) or die("Can't fork: $!");
10320  if ($pid) {
10321    eval {
10322      my $ssh2 = Net::SSH2->new();
10323
10324      sleep(1);
10325
10326      my $mac = 'hmac-sha1';
10327      $ssh2->method('mac_sc', $mac);
10328
10329      unless ($ssh2->connect('127.0.0.1', $port)) {
10330        my ($err_code, $err_name, $err_str) = $ssh2->error();
10331        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10332      }
10333
10334      my $mac_used = $ssh2->method('mac_sc');
10335      $self->assert($mac eq $mac_used,
10336        test_msg("Expected '$mac', got '$mac_used'"));
10337
10338      $ssh2->disconnect();
10339    };
10340
10341    if ($@) {
10342      $ex = $@;
10343    }
10344
10345    $wfh->print("done\n");
10346    $wfh->flush();
10347
10348  } else {
10349    eval { server_wait($config_file, $rfh) };
10350    if ($@) {
10351      warn($@);
10352      exit 1;
10353    }
10354
10355    exit 0;
10356  }
10357
10358  # Stop server
10359  server_stop($pid_file);
10360
10361  $self->assert_child_ok($pid);
10362
10363  if ($ex) {
10364    test_append_logfile($log_file, $ex);
10365    unlink($log_file);
10366
10367    die($ex);
10368  }
10369
10370  unlink($log_file);
10371}
10372
10373sub ssh2_mac_s2c_hmac_sha1_96 {
10374  my $self = shift;
10375  my $tmpdir = $self->{tmpdir};
10376
10377  my $config_file = "$tmpdir/sftp.conf";
10378  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10379  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10380
10381  my $log_file = test_get_logfile();
10382
10383  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10384  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10385
10386  my $user = 'proftpd';
10387  my $passwd = 'test';
10388  my $group = 'ftpd';
10389  my $home_dir = File::Spec->rel2abs($tmpdir);
10390  my $uid = 500;
10391  my $gid = 500;
10392
10393  # Make sure that, if we're running as root, that the home directory has
10394  # permissions/privs set for the account we create
10395  if ($< == 0) {
10396    unless (chmod(0755, $home_dir)) {
10397      die("Can't set perms on $home_dir to 0755: $!");
10398    }
10399
10400    unless (chown($uid, $gid, $home_dir)) {
10401      die("Can't set owner of $home_dir to $uid/$gid: $!");
10402    }
10403  }
10404
10405  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10406    '/bin/bash');
10407  auth_group_write($auth_group_file, $group, $gid, $user);
10408
10409  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10410  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10411
10412  my $config = {
10413    PidFile => $pid_file,
10414    ScoreboardFile => $scoreboard_file,
10415    SystemLog => $log_file,
10416    TraceLog => $log_file,
10417    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10418
10419    AuthUserFile => $auth_user_file,
10420    AuthGroupFile => $auth_group_file,
10421
10422    IfModules => {
10423      'mod_delay.c' => {
10424        DelayEngine => 'off',
10425      },
10426
10427      'mod_sftp.c' => [
10428        "SFTPEngine on",
10429        "SFTPLog $log_file",
10430        "SFTPHostKey $rsa_host_key",
10431        "SFTPHostKey $dsa_host_key",
10432      ],
10433    },
10434  };
10435
10436  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10437
10438  # Open pipes, for use between the parent and child processes.  Specifically,
10439  # the child will indicate when it's done with its test by writing a message
10440  # to the parent.
10441  my ($rfh, $wfh);
10442  unless (pipe($rfh, $wfh)) {
10443    die("Can't open pipe: $!");
10444  }
10445
10446  require Net::SSH2;
10447
10448  my $ex;
10449
10450  # Fork child
10451  $self->handle_sigchld();
10452  defined(my $pid = fork()) or die("Can't fork: $!");
10453  if ($pid) {
10454    eval {
10455      my $ssh2 = Net::SSH2->new();
10456
10457      sleep(1);
10458
10459      my $mac = 'hmac-sha1-96';
10460      $ssh2->method('mac_sc', $mac);
10461
10462      unless ($ssh2->connect('127.0.0.1', $port)) {
10463        my ($err_code, $err_name, $err_str) = $ssh2->error();
10464        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10465      }
10466
10467      my $mac_used = $ssh2->method('mac_sc');
10468      $self->assert($mac eq $mac_used,
10469        test_msg("Expected '$mac', got '$mac_used'"));
10470
10471      $ssh2->disconnect();
10472    };
10473
10474    if ($@) {
10475      $ex = $@;
10476    }
10477
10478    $wfh->print("done\n");
10479    $wfh->flush();
10480
10481  } else {
10482    eval { server_wait($config_file, $rfh) };
10483    if ($@) {
10484      warn($@);
10485      exit 1;
10486    }
10487
10488    exit 0;
10489  }
10490
10491  # Stop server
10492  server_stop($pid_file);
10493
10494  $self->assert_child_ok($pid);
10495
10496  if ($ex) {
10497    test_append_logfile($log_file, $ex);
10498    unlink($log_file);
10499
10500    die($ex);
10501  }
10502
10503  unlink($log_file);
10504}
10505
10506sub ssh2_mac_s2c_hmac_md5 {
10507  my $self = shift;
10508  my $tmpdir = $self->{tmpdir};
10509
10510  my $config_file = "$tmpdir/sftp.conf";
10511  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10512  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10513
10514  my $log_file = test_get_logfile();
10515
10516  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10517  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10518
10519  my $user = 'proftpd';
10520  my $passwd = 'test';
10521  my $group = 'ftpd';
10522  my $home_dir = File::Spec->rel2abs($tmpdir);
10523  my $uid = 500;
10524  my $gid = 500;
10525
10526  # Make sure that, if we're running as root, that the home directory has
10527  # permissions/privs set for the account we create
10528  if ($< == 0) {
10529    unless (chmod(0755, $home_dir)) {
10530      die("Can't set perms on $home_dir to 0755: $!");
10531    }
10532
10533    unless (chown($uid, $gid, $home_dir)) {
10534      die("Can't set owner of $home_dir to $uid/$gid: $!");
10535    }
10536  }
10537
10538  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10539    '/bin/bash');
10540  auth_group_write($auth_group_file, $group, $gid, $user);
10541
10542  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10543  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10544
10545  my $config = {
10546    PidFile => $pid_file,
10547    ScoreboardFile => $scoreboard_file,
10548    SystemLog => $log_file,
10549    TraceLog => $log_file,
10550    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10551
10552    AuthUserFile => $auth_user_file,
10553    AuthGroupFile => $auth_group_file,
10554
10555    IfModules => {
10556      'mod_delay.c' => {
10557        DelayEngine => 'off',
10558      },
10559
10560      'mod_sftp.c' => [
10561        "SFTPEngine on",
10562        "SFTPLog $log_file",
10563        "SFTPHostKey $rsa_host_key",
10564        "SFTPHostKey $dsa_host_key",
10565        "SFTPDigests hmac-md5",
10566      ],
10567    },
10568  };
10569
10570  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10571
10572  # Open pipes, for use between the parent and child processes.  Specifically,
10573  # the child will indicate when it's done with its test by writing a message
10574  # to the parent.
10575  my ($rfh, $wfh);
10576  unless (pipe($rfh, $wfh)) {
10577    die("Can't open pipe: $!");
10578  }
10579
10580  require Net::SSH2;
10581
10582  my $ex;
10583
10584  # Fork child
10585  $self->handle_sigchld();
10586  defined(my $pid = fork()) or die("Can't fork: $!");
10587  if ($pid) {
10588    eval {
10589      my $ssh2 = Net::SSH2->new();
10590
10591      sleep(1);
10592
10593      my $mac = 'hmac-md5';
10594      $ssh2->method('mac_sc', $mac);
10595
10596      unless ($ssh2->connect('127.0.0.1', $port)) {
10597        my ($err_code, $err_name, $err_str) = $ssh2->error();
10598        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10599      }
10600
10601      my $mac_used = $ssh2->method('mac_sc');
10602      $self->assert($mac eq $mac_used,
10603        test_msg("Expected '$mac', got '$mac_used'"));
10604
10605      $ssh2->disconnect();
10606    };
10607
10608    if ($@) {
10609      $ex = $@;
10610    }
10611
10612    $wfh->print("done\n");
10613    $wfh->flush();
10614
10615  } else {
10616    eval { server_wait($config_file, $rfh) };
10617    if ($@) {
10618      warn($@);
10619      exit 1;
10620    }
10621
10622    exit 0;
10623  }
10624
10625  # Stop server
10626  server_stop($pid_file);
10627
10628  $self->assert_child_ok($pid);
10629
10630  if ($ex) {
10631    test_append_logfile($log_file, $ex);
10632    unlink($log_file);
10633
10634    die($ex);
10635  }
10636
10637  unlink($log_file);
10638}
10639
10640sub ssh2_mac_s2c_hmac_md5_96 {
10641  my $self = shift;
10642  my $tmpdir = $self->{tmpdir};
10643
10644  my $config_file = "$tmpdir/sftp.conf";
10645  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10646  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10647
10648  my $log_file = test_get_logfile();
10649
10650  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10651  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10652
10653  my $user = 'proftpd';
10654  my $passwd = 'test';
10655  my $group = 'ftpd';
10656  my $home_dir = File::Spec->rel2abs($tmpdir);
10657  my $uid = 500;
10658  my $gid = 500;
10659
10660  # Make sure that, if we're running as root, that the home directory has
10661  # permissions/privs set for the account we create
10662  if ($< == 0) {
10663    unless (chmod(0755, $home_dir)) {
10664      die("Can't set perms on $home_dir to 0755: $!");
10665    }
10666
10667    unless (chown($uid, $gid, $home_dir)) {
10668      die("Can't set owner of $home_dir to $uid/$gid: $!");
10669    }
10670  }
10671
10672  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10673    '/bin/bash');
10674  auth_group_write($auth_group_file, $group, $gid, $user);
10675
10676  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10677  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10678
10679  my $config = {
10680    PidFile => $pid_file,
10681    ScoreboardFile => $scoreboard_file,
10682    SystemLog => $log_file,
10683    TraceLog => $log_file,
10684    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10685
10686    AuthUserFile => $auth_user_file,
10687    AuthGroupFile => $auth_group_file,
10688
10689    IfModules => {
10690      'mod_delay.c' => {
10691        DelayEngine => 'off',
10692      },
10693
10694      'mod_sftp.c' => [
10695        "SFTPEngine on",
10696        "SFTPLog $log_file",
10697        "SFTPHostKey $rsa_host_key",
10698        "SFTPHostKey $dsa_host_key",
10699        "SFTPDigests hmac-md5-96",
10700      ],
10701    },
10702  };
10703
10704  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10705
10706  # Open pipes, for use between the parent and child processes.  Specifically,
10707  # the child will indicate when it's done with its test by writing a message
10708  # to the parent.
10709  my ($rfh, $wfh);
10710  unless (pipe($rfh, $wfh)) {
10711    die("Can't open pipe: $!");
10712  }
10713
10714  require Net::SSH2;
10715
10716  my $ex;
10717
10718  # Fork child
10719  $self->handle_sigchld();
10720  defined(my $pid = fork()) or die("Can't fork: $!");
10721  if ($pid) {
10722    eval {
10723      my $ssh2 = Net::SSH2->new();
10724
10725      sleep(1);
10726
10727      my $mac = 'hmac-md5-96';
10728      $ssh2->method('mac_sc', $mac);
10729
10730      unless ($ssh2->connect('127.0.0.1', $port)) {
10731        my ($err_code, $err_name, $err_str) = $ssh2->error();
10732        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10733      }
10734
10735      my $mac_used = $ssh2->method('mac_sc');
10736      $self->assert($mac eq $mac_used,
10737        test_msg("Expected '$mac', got '$mac_used'"));
10738
10739      $ssh2->disconnect();
10740    };
10741
10742    if ($@) {
10743      $ex = $@;
10744    }
10745
10746    $wfh->print("done\n");
10747    $wfh->flush();
10748
10749  } else {
10750    eval { server_wait($config_file, $rfh) };
10751    if ($@) {
10752      warn($@);
10753      exit 1;
10754    }
10755
10756    exit 0;
10757  }
10758
10759  # Stop server
10760  server_stop($pid_file);
10761
10762  $self->assert_child_ok($pid);
10763
10764  if ($ex) {
10765    test_append_logfile($log_file, $ex);
10766    unlink($log_file);
10767
10768    die($ex);
10769  }
10770
10771  unlink($log_file);
10772}
10773
10774sub ssh2_mac_s2c_hmac_ripemd160 {
10775  my $self = shift;
10776  my $tmpdir = $self->{tmpdir};
10777
10778  my $config_file = "$tmpdir/sftp.conf";
10779  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10780  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10781
10782  my $log_file = test_get_logfile();
10783
10784  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10785  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10786
10787  my $user = 'proftpd';
10788  my $passwd = 'test';
10789  my $group = 'ftpd';
10790  my $home_dir = File::Spec->rel2abs($tmpdir);
10791  my $uid = 500;
10792  my $gid = 500;
10793
10794  # Make sure that, if we're running as root, that the home directory has
10795  # permissions/privs set for the account we create
10796  if ($< == 0) {
10797    unless (chmod(0755, $home_dir)) {
10798      die("Can't set perms on $home_dir to 0755: $!");
10799    }
10800
10801    unless (chown($uid, $gid, $home_dir)) {
10802      die("Can't set owner of $home_dir to $uid/$gid: $!");
10803    }
10804  }
10805
10806  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10807    '/bin/bash');
10808  auth_group_write($auth_group_file, $group, $gid, $user);
10809
10810  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10811  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10812
10813  my $config = {
10814    PidFile => $pid_file,
10815    ScoreboardFile => $scoreboard_file,
10816    SystemLog => $log_file,
10817    TraceLog => $log_file,
10818    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10819
10820    AuthUserFile => $auth_user_file,
10821    AuthGroupFile => $auth_group_file,
10822
10823    IfModules => {
10824      'mod_delay.c' => {
10825        DelayEngine => 'off',
10826      },
10827
10828      'mod_sftp.c' => [
10829        "SFTPEngine on",
10830        "SFTPLog $log_file",
10831        "SFTPHostKey $rsa_host_key",
10832        "SFTPHostKey $dsa_host_key",
10833        "SFTPDigests hmac-ripemd160",
10834      ],
10835    },
10836  };
10837
10838  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10839
10840  # Open pipes, for use between the parent and child processes.  Specifically,
10841  # the child will indicate when it's done with its test by writing a message
10842  # to the parent.
10843  my ($rfh, $wfh);
10844  unless (pipe($rfh, $wfh)) {
10845    die("Can't open pipe: $!");
10846  }
10847
10848  require Net::SSH2;
10849
10850  my $ex;
10851
10852  # Fork child
10853  $self->handle_sigchld();
10854  defined(my $pid = fork()) or die("Can't fork: $!");
10855  if ($pid) {
10856    eval {
10857      my $ssh2 = Net::SSH2->new();
10858
10859      sleep(1);
10860
10861      my $mac = 'hmac-ripemd160';
10862      $ssh2->method('mac_sc', $mac);
10863
10864      unless ($ssh2->connect('127.0.0.1', $port)) {
10865        my ($err_code, $err_name, $err_str) = $ssh2->error();
10866        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
10867      }
10868
10869      my $mac_used = $ssh2->method('mac_sc');
10870      $self->assert($mac eq $mac_used,
10871        test_msg("Expected '$mac', got '$mac_used'"));
10872
10873      $ssh2->disconnect();
10874    };
10875
10876    if ($@) {
10877      $ex = $@;
10878    }
10879
10880    $wfh->print("done\n");
10881    $wfh->flush();
10882
10883  } else {
10884    eval { server_wait($config_file, $rfh) };
10885    if ($@) {
10886      warn($@);
10887      exit 1;
10888    }
10889
10890    exit 0;
10891  }
10892
10893  # Stop server
10894  server_stop($pid_file);
10895
10896  $self->assert_child_ok($pid);
10897
10898  if ($ex) {
10899    test_append_logfile($log_file, $ex);
10900    unlink($log_file);
10901
10902    die($ex);
10903  }
10904
10905  unlink($log_file);
10906}
10907
10908sub ssh2_mac_s2c_none {
10909  my $self = shift;
10910  my $tmpdir = $self->{tmpdir};
10911
10912  my $config_file = "$tmpdir/sftp.conf";
10913  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
10914  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
10915
10916  my $log_file = test_get_logfile();
10917
10918  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
10919  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
10920
10921  my $user = 'proftpd';
10922  my $passwd = 'test';
10923  my $group = 'ftpd';
10924  my $home_dir = File::Spec->rel2abs($tmpdir);
10925  my $uid = 500;
10926  my $gid = 500;
10927
10928  # Make sure that, if we're running as root, that the home directory has
10929  # permissions/privs set for the account we create
10930  if ($< == 0) {
10931    unless (chmod(0755, $home_dir)) {
10932      die("Can't set perms on $home_dir to 0755: $!");
10933    }
10934
10935    unless (chown($uid, $gid, $home_dir)) {
10936      die("Can't set owner of $home_dir to $uid/$gid: $!");
10937    }
10938  }
10939
10940  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
10941    '/bin/bash');
10942  auth_group_write($auth_group_file, $group, $gid, $user);
10943
10944  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
10945  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
10946
10947  my $config = {
10948    PidFile => $pid_file,
10949    ScoreboardFile => $scoreboard_file,
10950    SystemLog => $log_file,
10951    TraceLog => $log_file,
10952    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
10953
10954    AuthUserFile => $auth_user_file,
10955    AuthGroupFile => $auth_group_file,
10956
10957    IfModules => {
10958      'mod_delay.c' => {
10959        DelayEngine => 'off',
10960      },
10961
10962      'mod_sftp.c' => [
10963        "SFTPEngine on",
10964        "SFTPLog $log_file",
10965        "SFTPHostKey $rsa_host_key",
10966        "SFTPHostKey $dsa_host_key",
10967        "SFTPDigests none",
10968      ],
10969    },
10970  };
10971
10972  my ($port, $config_user, $config_group) = config_write($config_file, $config);
10973
10974  # Open pipes, for use between the parent and child processes.  Specifically,
10975  # the child will indicate when it's done with its test by writing a message
10976  # to the parent.
10977  my ($rfh, $wfh);
10978  unless (pipe($rfh, $wfh)) {
10979    die("Can't open pipe: $!");
10980  }
10981
10982  require Net::SSH2;
10983
10984  my $ex;
10985
10986  # Fork child
10987  $self->handle_sigchld();
10988  defined(my $pid = fork()) or die("Can't fork: $!");
10989  if ($pid) {
10990    eval {
10991      my $ssh2 = Net::SSH2->new();
10992
10993      sleep(1);
10994
10995      my $mac = 'none';
10996      $ssh2->method('mac_sc', $mac);
10997
10998      unless ($ssh2->connect('127.0.0.1', $port)) {
10999        my ($err_code, $err_name, $err_str) = $ssh2->error();
11000        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
11001      }
11002
11003      my $mac_used = $ssh2->method('mac_sc');
11004      $self->assert($mac eq $mac_used,
11005        test_msg("Expected '$mac', got '$mac_used'"));
11006
11007      $ssh2->disconnect();
11008    };
11009
11010    if ($@) {
11011      $ex = $@;
11012    }
11013
11014    $wfh->print("done\n");
11015    $wfh->flush();
11016
11017  } else {
11018    eval { server_wait($config_file, $rfh) };
11019    if ($@) {
11020      warn($@);
11021      exit 1;
11022    }
11023
11024    exit 0;
11025  }
11026
11027  # Stop server
11028  server_stop($pid_file);
11029
11030  $self->assert_child_ok($pid);
11031
11032  if ($ex) {
11033    test_append_logfile($log_file, $ex);
11034    unlink($log_file);
11035
11036    die($ex);
11037  }
11038
11039  unlink($log_file);
11040}
11041
11042sub ssh2_ext_mac_umac64_openssh {
11043  my $self = shift;
11044  my $tmpdir = $self->{tmpdir};
11045
11046  my $config_file = "$tmpdir/sftp.conf";
11047  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11048  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11049
11050  my $log_file = test_get_logfile();
11051
11052  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11053  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11054
11055  my $user = 'proftpd';
11056  my $passwd = 'test';
11057  my $group = 'ftpd';
11058  my $home_dir = File::Spec->rel2abs($tmpdir);
11059  my $uid = 500;
11060  my $gid = 500;
11061
11062  # Make sure that, if we're running as root, that the home directory has
11063  # permissions/privs set for the account we create
11064  if ($< == 0) {
11065    unless (chmod(0755, $home_dir)) {
11066      die("Can't set perms on $home_dir to 0755: $!");
11067    }
11068
11069    unless (chown($uid, $gid, $home_dir)) {
11070      die("Can't set owner of $home_dir to $uid/$gid: $!");
11071    }
11072  }
11073
11074  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11075    '/bin/bash');
11076  auth_group_write($auth_group_file, $group, $gid, $user);
11077
11078  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
11079  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
11080
11081  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
11082  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
11083  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
11084
11085  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
11086  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
11087    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
11088  }
11089
11090  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
11091  if (open(my $fh, "> $src_file")) {
11092    print $fh "Hello, World!\n";
11093
11094    unless (close($fh)) {
11095      die("Can't write $src_file: $!");
11096    }
11097
11098  } else {
11099    die("Can't open $src_file: $!");
11100  }
11101
11102  my $src_sz = (stat($src_file))[7];
11103
11104  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
11105
11106  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
11107  if (open(my $fh, "> $ssh_config")) {
11108    print $fh <<EOC;
11109HostKeyAlgorithms ssh-rsa
11110MACs umac-64\@openssh.com
11111EOC
11112    unless (close($fh)) {
11113      die("Can't write $ssh_config: $!");
11114    }
11115
11116  } else {
11117    die("Can't open $ssh_config: $!");
11118  }
11119
11120  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
11121  if (open(my $fh, "> $batch_file")) {
11122    print $fh "put -P $src_file $dst_file\n";
11123
11124    unless (close($fh)) {
11125      die("Can't write $batch_file: $!");
11126    }
11127
11128  } else {
11129    die("Can't open $batch_file: $!");
11130  }
11131
11132  my $config = {
11133    PidFile => $pid_file,
11134    ScoreboardFile => $scoreboard_file,
11135    SystemLog => $log_file,
11136    TraceLog => $log_file,
11137    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
11138
11139    AuthUserFile => $auth_user_file,
11140    AuthGroupFile => $auth_group_file,
11141
11142    IfModules => {
11143      'mod_delay.c' => {
11144        DelayEngine => 'off',
11145      },
11146
11147      'mod_sftp.c' => [
11148        "SFTPEngine on",
11149        "SFTPLog $log_file",
11150
11151        "SFTPHostKey $rsa_host_key",
11152        "SFTPHostKey $dsa_host_key",
11153
11154        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
11155      ],
11156    },
11157  };
11158
11159  my ($port, $config_user, $config_group) = config_write($config_file, $config);
11160
11161  # Open pipes, for use between the parent and child processes.  Specifically,
11162  # the child will indicate when it's done with its test by writing a message
11163  # to the parent.
11164  my ($rfh, $wfh);
11165  unless (pipe($rfh, $wfh)) {
11166    die("Can't open pipe: $!");
11167  }
11168
11169  require Net::SSH2;
11170
11171  my $ex;
11172
11173  # Fork child
11174  $self->handle_sigchld();
11175  defined(my $pid = fork()) or die("Can't fork: $!");
11176  if ($pid) {
11177    eval {
11178
11179      my $sftp = 'sftp';
11180
11181      my @cmd = (
11182        $sftp,
11183        '-F',
11184        $ssh_config,
11185        '-oBatchMode=yes',
11186        '-oCheckHostIP=no',
11187        '-oCompression=yes',
11188        "-oPort=$port",
11189        "-oIdentityFile=$rsa_priv_key",
11190        '-oPubkeyAuthentication=yes',
11191        '-oStrictHostKeyChecking=no',
11192        '-vvv',
11193        '-b',
11194        $batch_file,
11195        "$user\@127.0.0.1",
11196      );
11197
11198      my $sftp_rh = IO::Handle->new();
11199      my $sftp_wh = IO::Handle->new();
11200      my $sftp_eh = IO::Handle->new();
11201
11202      $sftp_wh->autoflush(1);
11203
11204      sleep(1);
11205
11206      local $SIG{CHLD} = 'DEFAULT';
11207
11208      # Make sure that the perms on the priv key are what OpenSSH wants
11209      unless (chmod(0400, $rsa_priv_key)) {
11210        die("Can't set perms on $rsa_priv_key to 0400: $!");
11211      }
11212
11213      if ($ENV{TEST_VERBOSE}) {
11214        print STDERR "Executing: ", join(' ', @cmd), "\n";
11215      }
11216
11217      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
11218      waitpid($sftp_pid, 0);
11219      my $exit_status = $?;
11220
11221      # Restore the perms on the priv key
11222      unless (chmod(0644, $rsa_priv_key)) {
11223        die("Can't set perms on $rsa_priv_key to 0644: $!");
11224      }
11225
11226      my ($res, $errstr);
11227      if ($exit_status >> 8 == 0) {
11228        $errstr = join('', <$sftp_eh>);
11229        $res = 0;
11230
11231      } else {
11232        $errstr = join('', <$sftp_eh>);
11233        if ($ENV{TEST_VERBOSE}) {
11234          print STDERR "Stderr: $errstr\n";
11235        }
11236
11237        $res = 1;
11238      }
11239
11240      unless ($res == 0) {
11241        die("Can't upload $src_file to server: $errstr");
11242      }
11243
11244      unless (-f $dst_file) {
11245        die("File '$dst_file' does not exist as expected");
11246      }
11247
11248      my $sz = (stat($dst_file))[7];
11249      my $expected_sz = $src_sz;
11250      $self->assert($expected_sz == $sz,
11251        test_msg("Expected file size $expected_sz, got $sz"));
11252
11253    };
11254
11255    if ($@) {
11256      $ex = $@;
11257    }
11258
11259    $wfh->print("done\n");
11260    $wfh->flush();
11261
11262  } else {
11263    eval { server_wait($config_file, $rfh) };
11264    if ($@) {
11265      warn($@);
11266      exit 1;
11267    }
11268
11269    exit 0;
11270  }
11271
11272  # Stop server
11273  server_stop($pid_file);
11274
11275  $self->assert_child_ok($pid);
11276
11277  if ($ex) {
11278    test_append_logfile($log_file, $ex);
11279    unlink($log_file);
11280
11281    die($ex);
11282  }
11283
11284  unlink($log_file);
11285}
11286
11287sub ssh2_compress_c2s_none {
11288  my $self = shift;
11289  my $tmpdir = $self->{tmpdir};
11290
11291  my $config_file = "$tmpdir/sftp.conf";
11292  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11293  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11294
11295  my $log_file = test_get_logfile();
11296
11297  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11298  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11299
11300  my $user = 'proftpd';
11301  my $passwd = 'test';
11302  my $group = 'ftpd';
11303  my $home_dir = File::Spec->rel2abs($tmpdir);
11304  my $uid = 500;
11305  my $gid = 500;
11306
11307  # Make sure that, if we're running as root, that the home directory has
11308  # permissions/privs set for the account we create
11309  if ($< == 0) {
11310    unless (chmod(0755, $home_dir)) {
11311      die("Can't set perms on $home_dir to 0755: $!");
11312    }
11313
11314    unless (chown($uid, $gid, $home_dir)) {
11315      die("Can't set owner of $home_dir to $uid/$gid: $!");
11316    }
11317  }
11318
11319  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11320    '/bin/bash');
11321  auth_group_write($auth_group_file, $group, $gid, $user);
11322
11323  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
11324  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
11325
11326  my $config = {
11327    PidFile => $pid_file,
11328    ScoreboardFile => $scoreboard_file,
11329    SystemLog => $log_file,
11330    TraceLog => $log_file,
11331    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
11332
11333    AuthUserFile => $auth_user_file,
11334    AuthGroupFile => $auth_group_file,
11335
11336    IfModules => {
11337      'mod_delay.c' => {
11338        DelayEngine => 'off',
11339      },
11340
11341      'mod_sftp.c' => [
11342        "SFTPEngine on",
11343        "SFTPLog $log_file",
11344        "SFTPHostKey $rsa_host_key",
11345        "SFTPHostKey $dsa_host_key",
11346      ],
11347    },
11348  };
11349
11350  my ($port, $config_user, $config_group) = config_write($config_file, $config);
11351
11352  # Open pipes, for use between the parent and child processes.  Specifically,
11353  # the child will indicate when it's done with its test by writing a message
11354  # to the parent.
11355  my ($rfh, $wfh);
11356  unless (pipe($rfh, $wfh)) {
11357    die("Can't open pipe: $!");
11358  }
11359
11360  require Net::SSH2;
11361
11362  my $ex;
11363
11364  # Fork child
11365  $self->handle_sigchld();
11366  defined(my $pid = fork()) or die("Can't fork: $!");
11367  if ($pid) {
11368    eval {
11369      my $ssh2 = Net::SSH2->new();
11370
11371      sleep(1);
11372
11373      my $comp = 'none';
11374      $ssh2->method('comp_cs', $comp);
11375
11376      unless ($ssh2->connect('127.0.0.1', $port)) {
11377        my ($err_code, $err_name, $err_str) = $ssh2->error();
11378        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
11379      }
11380
11381      my $comp_used = $ssh2->method('comp_cs');
11382      $self->assert($comp eq $comp_used,
11383        test_msg("Expected '$comp', got '$comp_used'"));
11384
11385      $ssh2->disconnect();
11386    };
11387
11388    if ($@) {
11389      $ex = $@;
11390    }
11391
11392    $wfh->print("done\n");
11393    $wfh->flush();
11394
11395  } else {
11396    eval { server_wait($config_file, $rfh) };
11397    if ($@) {
11398      warn($@);
11399      exit 1;
11400    }
11401
11402    exit 0;
11403  }
11404
11405  # Stop server
11406  server_stop($pid_file);
11407
11408  $self->assert_child_ok($pid);
11409
11410  if ($ex) {
11411    test_append_logfile($log_file, $ex);
11412    unlink($log_file);
11413
11414    die($ex);
11415  }
11416
11417  unlink($log_file);
11418}
11419
11420sub ssh2_compress_c2s_zlib {
11421  my $self = shift;
11422  my $tmpdir = $self->{tmpdir};
11423
11424  my $config_file = "$tmpdir/sftp.conf";
11425  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11426  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11427
11428  my $log_file = test_get_logfile();
11429
11430  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11431  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11432
11433  my $user = 'proftpd';
11434  my $passwd = 'test';
11435  my $group = 'ftpd';
11436  my $home_dir = File::Spec->rel2abs($tmpdir);
11437  my $uid = 500;
11438  my $gid = 500;
11439
11440  # Make sure that, if we're running as root, that the home directory has
11441  # permissions/privs set for the account we create
11442  if ($< == 0) {
11443    unless (chmod(0755, $home_dir)) {
11444      die("Can't set perms on $home_dir to 0755: $!");
11445    }
11446
11447    unless (chown($uid, $gid, $home_dir)) {
11448      die("Can't set owner of $home_dir to $uid/$gid: $!");
11449    }
11450  }
11451
11452  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11453    '/bin/bash');
11454  auth_group_write($auth_group_file, $group, $gid, $user);
11455
11456  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
11457  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
11458
11459  my $config = {
11460    PidFile => $pid_file,
11461    ScoreboardFile => $scoreboard_file,
11462    SystemLog => $log_file,
11463    TraceLog => $log_file,
11464    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
11465
11466    AuthUserFile => $auth_user_file,
11467    AuthGroupFile => $auth_group_file,
11468
11469    IfModules => {
11470      'mod_delay.c' => {
11471        DelayEngine => 'off',
11472      },
11473
11474      'mod_sftp.c' => [
11475        "SFTPEngine on",
11476        "SFTPLog $log_file",
11477        "SFTPHostKey $rsa_host_key",
11478        "SFTPHostKey $dsa_host_key",
11479
11480        "SFTPCompression on",
11481      ],
11482    },
11483  };
11484
11485  my ($port, $config_user, $config_group) = config_write($config_file, $config);
11486
11487  # Open pipes, for use between the parent and child processes.  Specifically,
11488  # the child will indicate when it's done with its test by writing a message
11489  # to the parent.
11490  my ($rfh, $wfh);
11491  unless (pipe($rfh, $wfh)) {
11492    die("Can't open pipe: $!");
11493  }
11494
11495  require Net::SSH2;
11496
11497  my $ex;
11498
11499  # Fork child
11500  $self->handle_sigchld();
11501  defined(my $pid = fork()) or die("Can't fork: $!");
11502  if ($pid) {
11503    eval {
11504      my $ssh2 = Net::SSH2->new();
11505
11506      sleep(1);
11507
11508      my $comp = 'zlib';
11509      $ssh2->method('comp_cs', $comp);
11510
11511      unless ($ssh2->connect('127.0.0.1', $port)) {
11512        my ($err_code, $err_name, $err_str) = $ssh2->error();
11513        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
11514      }
11515
11516      my $comp_used = $ssh2->method('comp_cs');
11517      $self->assert($comp eq $comp_used,
11518        test_msg("Expected '$comp', got '$comp_used'"));
11519
11520      $ssh2->disconnect();
11521    };
11522
11523    if ($@) {
11524      $ex = $@;
11525    }
11526
11527    $wfh->print("done\n");
11528    $wfh->flush();
11529
11530  } else {
11531    eval { server_wait($config_file, $rfh) };
11532    if ($@) {
11533      warn($@);
11534      exit 1;
11535    }
11536
11537    exit 0;
11538  }
11539
11540  # Stop server
11541  server_stop($pid_file);
11542
11543  $self->assert_child_ok($pid);
11544
11545  if ($ex) {
11546    test_append_logfile($log_file, $ex);
11547    unlink($log_file);
11548
11549    die($ex);
11550  }
11551
11552  unlink($log_file);
11553}
11554
11555sub ssh2_compress_s2c_none {
11556  my $self = shift;
11557  my $tmpdir = $self->{tmpdir};
11558
11559  my $config_file = "$tmpdir/sftp.conf";
11560  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11561  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11562
11563  my $log_file = test_get_logfile();
11564
11565  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11566  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11567
11568  my $user = 'proftpd';
11569  my $passwd = 'test';
11570  my $group = 'ftpd';
11571  my $home_dir = File::Spec->rel2abs($tmpdir);
11572  my $uid = 500;
11573  my $gid = 500;
11574
11575  # Make sure that, if we're running as root, that the home directory has
11576  # permissions/privs set for the account we create
11577  if ($< == 0) {
11578    unless (chmod(0755, $home_dir)) {
11579      die("Can't set perms on $home_dir to 0755: $!");
11580    }
11581
11582    unless (chown($uid, $gid, $home_dir)) {
11583      die("Can't set owner of $home_dir to $uid/$gid: $!");
11584    }
11585  }
11586
11587  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11588    '/bin/bash');
11589  auth_group_write($auth_group_file, $group, $gid, $user);
11590
11591  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
11592  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
11593
11594  my $config = {
11595    PidFile => $pid_file,
11596    ScoreboardFile => $scoreboard_file,
11597    SystemLog => $log_file,
11598    TraceLog => $log_file,
11599    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
11600
11601    AuthUserFile => $auth_user_file,
11602    AuthGroupFile => $auth_group_file,
11603
11604    IfModules => {
11605      'mod_delay.c' => {
11606        DelayEngine => 'off',
11607      },
11608
11609      'mod_sftp.c' => [
11610        "SFTPEngine on",
11611        "SFTPLog $log_file",
11612        "SFTPHostKey $rsa_host_key",
11613        "SFTPHostKey $dsa_host_key",
11614      ],
11615    },
11616  };
11617
11618  my ($port, $config_user, $config_group) = config_write($config_file, $config);
11619
11620  # Open pipes, for use between the parent and child processes.  Specifically,
11621  # the child will indicate when it's done with its test by writing a message
11622  # to the parent.
11623  my ($rfh, $wfh);
11624  unless (pipe($rfh, $wfh)) {
11625    die("Can't open pipe: $!");
11626  }
11627
11628  require Net::SSH2;
11629
11630  my $ex;
11631
11632  # Fork child
11633  $self->handle_sigchld();
11634  defined(my $pid = fork()) or die("Can't fork: $!");
11635  if ($pid) {
11636    eval {
11637      my $ssh2 = Net::SSH2->new();
11638
11639      sleep(1);
11640
11641      my $comp = 'none';
11642      $ssh2->method('comp_sc', $comp);
11643
11644      unless ($ssh2->connect('127.0.0.1', $port)) {
11645        my ($err_code, $err_name, $err_str) = $ssh2->error();
11646        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
11647      }
11648
11649      my $comp_used = $ssh2->method('comp_sc');
11650      $self->assert($comp eq $comp_used,
11651        test_msg("Expected '$comp', got '$comp_used'"));
11652
11653      $ssh2->disconnect();
11654    };
11655
11656    if ($@) {
11657      $ex = $@;
11658    }
11659
11660    $wfh->print("done\n");
11661    $wfh->flush();
11662
11663  } else {
11664    eval { server_wait($config_file, $rfh) };
11665    if ($@) {
11666      warn($@);
11667      exit 1;
11668    }
11669
11670    exit 0;
11671  }
11672
11673  # Stop server
11674  server_stop($pid_file);
11675
11676  $self->assert_child_ok($pid);
11677
11678  if ($ex) {
11679    test_append_logfile($log_file, $ex);
11680    unlink($log_file);
11681
11682    die($ex);
11683  }
11684
11685  unlink($log_file);
11686}
11687
11688sub ssh2_compress_s2c_zlib {
11689  my $self = shift;
11690  my $tmpdir = $self->{tmpdir};
11691
11692  my $config_file = "$tmpdir/sftp.conf";
11693  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11694  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11695
11696  my $log_file = test_get_logfile();
11697
11698  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11699  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11700
11701  my $user = 'proftpd';
11702  my $passwd = 'test';
11703  my $group = 'ftpd';
11704  my $home_dir = File::Spec->rel2abs($tmpdir);
11705  my $uid = 500;
11706  my $gid = 500;
11707
11708  # Make sure that, if we're running as root, that the home directory has
11709  # permissions/privs set for the account we create
11710  if ($< == 0) {
11711    unless (chmod(0755, $home_dir)) {
11712      die("Can't set perms on $home_dir to 0755: $!");
11713    }
11714
11715    unless (chown($uid, $gid, $home_dir)) {
11716      die("Can't set owner of $home_dir to $uid/$gid: $!");
11717    }
11718  }
11719
11720  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11721    '/bin/bash');
11722  auth_group_write($auth_group_file, $group, $gid, $user);
11723
11724  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
11725  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
11726
11727  my $config = {
11728    PidFile => $pid_file,
11729    ScoreboardFile => $scoreboard_file,
11730    SystemLog => $log_file,
11731    TraceLog => $log_file,
11732    Trace => 'ssh2:20 sftp:20 scp:20',
11733
11734    AuthUserFile => $auth_user_file,
11735    AuthGroupFile => $auth_group_file,
11736
11737    IfModules => {
11738      'mod_delay.c' => {
11739        DelayEngine => 'off',
11740      },
11741
11742      'mod_sftp.c' => [
11743        "SFTPEngine on",
11744        "SFTPLog $log_file",
11745        "SFTPHostKey $rsa_host_key",
11746        "SFTPHostKey $dsa_host_key",
11747
11748        "SFTPCompression on",
11749      ],
11750    },
11751  };
11752
11753  my ($port, $config_user, $config_group) = config_write($config_file, $config);
11754
11755  # Open pipes, for use between the parent and child processes.  Specifically,
11756  # the child will indicate when it's done with its test by writing a message
11757  # to the parent.
11758  my ($rfh, $wfh);
11759  unless (pipe($rfh, $wfh)) {
11760    die("Can't open pipe: $!");
11761  }
11762
11763  require Net::SSH2;
11764
11765  my $ex;
11766
11767  # Fork child
11768  $self->handle_sigchld();
11769  defined(my $pid = fork()) or die("Can't fork: $!");
11770  if ($pid) {
11771    eval {
11772      my $ssh2 = Net::SSH2->new();
11773
11774      sleep(1);
11775
11776      my $comp = 'zlib';
11777      $ssh2->method('comp_sc', $comp);
11778
11779      unless ($ssh2->connect('127.0.0.1', $port)) {
11780        my ($err_code, $err_name, $err_str) = $ssh2->error();
11781        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
11782      }
11783
11784      my $comp_used = $ssh2->method('comp_sc');
11785      $self->assert($comp eq $comp_used,
11786        test_msg("Expected '$comp', got '$comp_used'"));
11787
11788      $ssh2->disconnect();
11789    };
11790
11791    if ($@) {
11792      $ex = $@;
11793    }
11794
11795    $wfh->print("done\n");
11796    $wfh->flush();
11797
11798  } else {
11799    eval { server_wait($config_file, $rfh) };
11800    if ($@) {
11801      warn($@);
11802      exit 1;
11803    }
11804
11805    exit 0;
11806  }
11807
11808  # Stop server
11809  server_stop($pid_file);
11810
11811  $self->assert_child_ok($pid);
11812
11813  if ($ex) {
11814    test_append_logfile($log_file, $ex);
11815    unlink($log_file);
11816
11817    die($ex);
11818  }
11819
11820  unlink($log_file);
11821}
11822
11823sub ssh2_auth_hostbased {
11824  my $self = shift;
11825  my $tmpdir = $self->{tmpdir};
11826
11827  my $config_file = "$tmpdir/sftp.conf";
11828  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11829  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11830
11831  my $log_file = test_get_logfile();
11832
11833  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11834  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11835
11836  my $user = 'proftpd';
11837  my $passwd = 'test';
11838  my $group = 'ftpd';
11839  my $home_dir = File::Spec->rel2abs($tmpdir);
11840  my $uid = 500;
11841  my $gid = 500;
11842
11843  # Make sure that, if we're running as root, that the home directory has
11844  # permissions/privs set for the account we create
11845  if ($< == 0) {
11846    unless (chmod(0755, $home_dir)) {
11847      die("Can't set perms on $home_dir to 0755: $!");
11848    }
11849
11850    unless (chown($uid, $gid, $home_dir)) {
11851      die("Can't set owner of $home_dir to $uid/$gid: $!");
11852    }
11853  }
11854
11855  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11856    '/bin/bash');
11857  auth_group_write($auth_group_file, $group, $gid, $user);
11858
11859  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
11860  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
11861
11862  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
11863  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
11864  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
11865
11866  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
11867  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
11868    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
11869  }
11870
11871  my $config = {
11872    PidFile => $pid_file,
11873    ScoreboardFile => $scoreboard_file,
11874    SystemLog => $log_file,
11875    TraceLog => $log_file,
11876    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
11877
11878    AuthUserFile => $auth_user_file,
11879    AuthGroupFile => $auth_group_file,
11880
11881    IfModules => {
11882      'mod_delay.c' => {
11883        DelayEngine => 'off',
11884      },
11885
11886      'mod_sftp.c' => [
11887        "SFTPEngine on",
11888        "SFTPLog $log_file",
11889        "SFTPHostKey $rsa_host_key",
11890        "SFTPHostKey $dsa_host_key",
11891        "SFTPAuthorizedHostKeys file:~/.authorized_keys",
11892      ],
11893    },
11894  };
11895
11896  my ($port, $config_user, $config_group) = config_write($config_file, $config);
11897
11898  # Open pipes, for use between the parent and child processes.  Specifically,
11899  # the child will indicate when it's done with its test by writing a message
11900  # to the parent.
11901  my ($rfh, $wfh);
11902  unless (pipe($rfh, $wfh)) {
11903    die("Can't open pipe: $!");
11904  }
11905
11906  require Net::SSH2;
11907
11908  my $ex;
11909
11910  # Fork child
11911  $self->handle_sigchld();
11912  defined(my $pid = fork()) or die("Can't fork: $!");
11913  if ($pid) {
11914    eval {
11915      my $ssh2 = Net::SSH2->new();
11916
11917      sleep(1);
11918
11919      unless ($ssh2->connect('127.0.0.1', $port)) {
11920        my ($err_code, $err_name, $err_str) = $ssh2->error();
11921        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
11922      }
11923
11924      unless ($ssh2->auth_hostbased($user, $rsa_pub_key, $rsa_priv_key,
11925          '127.0.0.1', $user)) {
11926        my ($err_code, $err_name, $err_str) = $ssh2->error();
11927        die("RSA hostbased authentication failed: [$err_name] ($err_code) $err_str");
11928      }
11929
11930      $ssh2->disconnect();
11931    };
11932
11933    if ($@) {
11934      $ex = $@;
11935    }
11936
11937    $wfh->print("done\n");
11938    $wfh->flush();
11939
11940  } else {
11941    eval { server_wait($config_file, $rfh) };
11942    if ($@) {
11943      warn($@);
11944      exit 1;
11945    }
11946
11947    exit 0;
11948  }
11949
11950  # Stop server
11951  server_stop($pid_file);
11952
11953  $self->assert_child_ok($pid);
11954
11955  if ($ex) {
11956    test_append_logfile($log_file, $ex);
11957    unlink($log_file);
11958
11959    die($ex);
11960  }
11961
11962  unlink($log_file);
11963}
11964
11965sub ssh2_auth_publickey_rsa_no_match_bug3493 {
11966  my $self = shift;
11967  my $tmpdir = $self->{tmpdir};
11968
11969  my $config_file = "$tmpdir/sftp.conf";
11970  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
11971  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
11972
11973  my $log_file = test_get_logfile();
11974
11975  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
11976  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
11977
11978  my $user = 'proftpd';
11979  my $passwd = 'test';
11980  my $group = 'ftpd';
11981  my $home_dir = File::Spec->rel2abs($tmpdir);
11982  my $uid = 500;
11983  my $gid = 500;
11984
11985  # Make sure that, if we're running as root, that the home directory has
11986  # permissions/privs set for the account we create
11987  if ($< == 0) {
11988    unless (chmod(0755, $home_dir)) {
11989      die("Can't set perms on $home_dir to 0755: $!");
11990    }
11991
11992    unless (chown($uid, $gid, $home_dir)) {
11993      die("Can't set owner of $home_dir to $uid/$gid: $!");
11994    }
11995  }
11996
11997  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
11998    '/bin/bash');
11999  auth_group_write($auth_group_file, $group, $gid, $user);
12000
12001  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12002  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12003
12004  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
12005  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
12006  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_subj_keys');
12007
12008  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12009  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12010    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12011  }
12012
12013  my $config = {
12014    PidFile => $pid_file,
12015    ScoreboardFile => $scoreboard_file,
12016    SystemLog => $log_file,
12017    TraceLog => $log_file,
12018    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12019
12020    AuthUserFile => $auth_user_file,
12021    AuthGroupFile => $auth_group_file,
12022
12023    IfModules => {
12024      'mod_delay.c' => {
12025        DelayEngine => 'off',
12026      },
12027
12028      'mod_sftp.c' => [
12029        "SFTPEngine on",
12030        "SFTPLog $log_file",
12031        "SFTPHostKey $rsa_host_key",
12032        "SFTPHostKey $dsa_host_key",
12033        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12034      ],
12035    },
12036  };
12037
12038  my ($port, $config_user, $config_group) = config_write($config_file, $config);
12039
12040  # Open pipes, for use between the parent and child processes.  Specifically,
12041  # the child will indicate when it's done with its test by writing a message
12042  # to the parent.
12043  my ($rfh, $wfh);
12044  unless (pipe($rfh, $wfh)) {
12045    die("Can't open pipe: $!");
12046  }
12047
12048  require Net::SSH2;
12049
12050  my $ex;
12051
12052  # Fork child
12053  $self->handle_sigchld();
12054  defined(my $pid = fork()) or die("Can't fork: $!");
12055  if ($pid) {
12056    eval {
12057      my $ssh2 = Net::SSH2->new();
12058
12059      sleep(1);
12060
12061      unless ($ssh2->connect('127.0.0.1', $port)) {
12062        my ($err_code, $err_name, $err_str) = $ssh2->error();
12063        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12064      }
12065
12066      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
12067        my ($err_code, $err_name, $err_str) = $ssh2->error();
12068        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
12069      }
12070
12071      $ssh2->disconnect();
12072    };
12073
12074    if ($@) {
12075      $ex = $@;
12076    }
12077
12078    $wfh->print("done\n");
12079    $wfh->flush();
12080
12081  } else {
12082    eval { server_wait($config_file, $rfh) };
12083    if ($@) {
12084      warn($@);
12085      exit 1;
12086    }
12087
12088    exit 0;
12089  }
12090
12091  # Stop server
12092  server_stop($pid_file);
12093
12094  $self->assert_child_ok($pid);
12095
12096  if ($ex) {
12097    test_append_logfile($log_file, $ex);
12098    unlink($log_file);
12099
12100    die($ex);
12101  }
12102
12103  unlink($log_file);
12104}
12105
12106sub ssh2_auth_publickey_rsa_with_match_bug3493 {
12107  my $self = shift;
12108  my $tmpdir = $self->{tmpdir};
12109
12110  my $config_file = "$tmpdir/sftp.conf";
12111  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
12112  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
12113
12114  my $log_file = test_get_logfile();
12115
12116  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
12117  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
12118
12119  my $user = 'proftpd';
12120  my $passwd = 'test';
12121  my $group = 'ftpd';
12122  my $home_dir = File::Spec->rel2abs($tmpdir);
12123  my $uid = 500;
12124  my $gid = 500;
12125
12126  # Make sure that, if we're running as root, that the home directory has
12127  # permissions/privs set for the account we create
12128  if ($< == 0) {
12129    unless (chmod(0755, $home_dir)) {
12130      die("Can't set perms on $home_dir to 0755: $!");
12131    }
12132
12133    unless (chown($uid, $gid, $home_dir)) {
12134      die("Can't set owner of $home_dir to $uid/$gid: $!");
12135    }
12136  }
12137
12138  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
12139    '/bin/bash');
12140  auth_group_write($auth_group_file, $group, $gid, $user);
12141
12142  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12143  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12144
12145  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
12146  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
12147  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_subj_keys');
12148
12149  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12150  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12151    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12152  }
12153
12154  my $config = {
12155    PidFile => $pid_file,
12156    ScoreboardFile => $scoreboard_file,
12157    SystemLog => $log_file,
12158    TraceLog => $log_file,
12159    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12160
12161    AuthUserFile => $auth_user_file,
12162    AuthGroupFile => $auth_group_file,
12163
12164    IfModules => {
12165      'mod_delay.c' => {
12166        DelayEngine => 'off',
12167      },
12168
12169      'mod_sftp.c' => [
12170        "SFTPEngine on",
12171        "SFTPLog $log_file",
12172        "SFTPHostKey $rsa_host_key",
12173        "SFTPHostKey $dsa_host_key",
12174        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12175        "SFTPOptions MatchKeySubject",
12176      ],
12177    },
12178  };
12179
12180  my ($port, $config_user, $config_group) = config_write($config_file, $config);
12181
12182  # Open pipes, for use between the parent and child processes.  Specifically,
12183  # the child will indicate when it's done with its test by writing a message
12184  # to the parent.
12185  my ($rfh, $wfh);
12186  unless (pipe($rfh, $wfh)) {
12187    die("Can't open pipe: $!");
12188  }
12189
12190  require Net::SSH2;
12191
12192  my $ex;
12193
12194  # Fork child
12195  $self->handle_sigchld();
12196  defined(my $pid = fork()) or die("Can't fork: $!");
12197  if ($pid) {
12198    eval {
12199      my $ssh2 = Net::SSH2->new();
12200
12201      sleep(1);
12202
12203      unless ($ssh2->connect('127.0.0.1', $port)) {
12204        my ($err_code, $err_name, $err_str) = $ssh2->error();
12205        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12206      }
12207
12208      if ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
12209        die("RSA publickey authentication succeeded unexpectly");
12210      }
12211
12212      my ($err_code, $err_name, $err_str) = $ssh2->error();
12213
12214      my $expected = 'LIBSSH2_ERROR_PUBLICKEY_UNVERIFIED';
12215      $self->assert($expected eq $err_name,
12216        test_msg("Expected '$expected', got '$err_name'"));
12217
12218      $ssh2->disconnect();
12219    };
12220
12221    if ($@) {
12222      $ex = $@;
12223    }
12224
12225    $wfh->print("done\n");
12226    $wfh->flush();
12227
12228  } else {
12229    eval { server_wait($config_file, $rfh) };
12230    if ($@) {
12231      warn($@);
12232      exit 1;
12233    }
12234
12235    exit 0;
12236  }
12237
12238  # Stop server
12239  server_stop($pid_file);
12240
12241  $self->assert_child_ok($pid);
12242
12243  if ($ex) {
12244    test_append_logfile($log_file, $ex);
12245    unlink($log_file);
12246
12247    die($ex);
12248  }
12249
12250  unlink($log_file);
12251}
12252
12253sub ssh2_auth_publickey_rsa2048_2nd_key {
12254  my $self = shift;
12255  my $tmpdir = $self->{tmpdir};
12256  my $setup = test_setup($tmpdir, 'sftp');
12257
12258  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12259  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12260
12261  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
12262  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
12263  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys2');
12264
12265  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12266  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12267    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12268  }
12269
12270  my $config = {
12271    PidFile => $setup->{pid_file},
12272    ScoreboardFile => $setup->{scoreboard_file},
12273    SystemLog => $setup->{log_file},
12274    TraceLog => $setup->{log_file},
12275    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
12276
12277    AuthUserFile => $setup->{auth_user_file},
12278    AuthGroupFile => $setup->{auth_group_file},
12279
12280    IfModules => {
12281      'mod_delay.c' => {
12282        DelayEngine => 'off',
12283      },
12284
12285      'mod_sftp.c' => [
12286        "SFTPEngine on",
12287        "SFTPLog $setup->{log_file}",
12288        "SFTPHostKey $rsa_host_key",
12289        "SFTPHostKey $dsa_host_key",
12290        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12291      ],
12292    },
12293  };
12294
12295  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
12296    $config);
12297
12298  # Open pipes, for use between the parent and child processes.  Specifically,
12299  # the child will indicate when it's done with its test by writing a message
12300  # to the parent.
12301  my ($rfh, $wfh);
12302  unless (pipe($rfh, $wfh)) {
12303    die("Can't open pipe: $!");
12304  }
12305
12306  require Net::SSH2;
12307
12308  my $ex;
12309
12310  # Fork child
12311  $self->handle_sigchld();
12312  defined(my $pid = fork()) or die("Can't fork: $!");
12313  if ($pid) {
12314    eval {
12315      my $ssh2 = Net::SSH2->new();
12316
12317      sleep(1);
12318
12319      unless ($ssh2->connect('127.0.0.1', $port)) {
12320        my ($err_code, $err_name, $err_str) = $ssh2->error();
12321        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12322      }
12323
12324      unless ($ssh2->auth_publickey($setup->{user}, $rsa_pub_key,
12325          $rsa_priv_key)) {
12326        my ($err_code, $err_name, $err_str) = $ssh2->error();
12327        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
12328      }
12329
12330      $ssh2->disconnect();
12331    };
12332
12333    if ($@) {
12334      $ex = $@;
12335    }
12336
12337    $wfh->print("done\n");
12338    $wfh->flush();
12339
12340  } else {
12341    eval { server_wait($setup->{config_file}, $rfh) };
12342    if ($@) {
12343      warn($@);
12344      exit 1;
12345    }
12346
12347    exit 0;
12348  }
12349
12350  # Stop server
12351  server_stop($setup->{pid_file});
12352
12353  $self->assert_child_ok($pid);
12354
12355  test_cleanup($setup->{log_file}, $ex);
12356}
12357
12358sub ssh2_auth_publickey_rsa2048 {
12359  my $self = shift;
12360  my $tmpdir = $self->{tmpdir};
12361
12362  my $config_file = "$tmpdir/sftp.conf";
12363  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
12364  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
12365
12366  my $log_file = test_get_logfile();
12367
12368  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
12369  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
12370
12371  my $user = 'proftpd';
12372  my $passwd = 'test';
12373  my $group = 'ftpd';
12374  my $home_dir = File::Spec->rel2abs($tmpdir);
12375  my $uid = 500;
12376  my $gid = 500;
12377
12378  # Make sure that, if we're running as root, that the home directory has
12379  # permissions/privs set for the account we create
12380  if ($< == 0) {
12381    unless (chmod(0755, $home_dir)) {
12382      die("Can't set perms on $home_dir to 0755: $!");
12383    }
12384
12385    unless (chown($uid, $gid, $home_dir)) {
12386      die("Can't set owner of $home_dir to $uid/$gid: $!");
12387    }
12388  }
12389
12390  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
12391    '/bin/bash');
12392  auth_group_write($auth_group_file, $group, $gid, $user);
12393
12394  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12395  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12396
12397  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
12398  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
12399  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
12400
12401  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12402  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12403    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12404  }
12405
12406  my $config = {
12407    PidFile => $pid_file,
12408    ScoreboardFile => $scoreboard_file,
12409    SystemLog => $log_file,
12410    TraceLog => $log_file,
12411    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12412
12413    AuthUserFile => $auth_user_file,
12414    AuthGroupFile => $auth_group_file,
12415
12416    IfModules => {
12417      'mod_delay.c' => {
12418        DelayEngine => 'off',
12419      },
12420
12421      'mod_sftp.c' => [
12422        "SFTPEngine on",
12423        "SFTPLog $log_file",
12424        "SFTPHostKey $rsa_host_key",
12425        "SFTPHostKey $dsa_host_key",
12426        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12427      ],
12428    },
12429  };
12430
12431  my ($port, $config_user, $config_group) = config_write($config_file, $config);
12432
12433  # Open pipes, for use between the parent and child processes.  Specifically,
12434  # the child will indicate when it's done with its test by writing a message
12435  # to the parent.
12436  my ($rfh, $wfh);
12437  unless (pipe($rfh, $wfh)) {
12438    die("Can't open pipe: $!");
12439  }
12440
12441  require Net::SSH2;
12442
12443  my $ex;
12444
12445  # Fork child
12446  $self->handle_sigchld();
12447  defined(my $pid = fork()) or die("Can't fork: $!");
12448  if ($pid) {
12449    eval {
12450      my $ssh2 = Net::SSH2->new();
12451
12452      sleep(1);
12453
12454      unless ($ssh2->connect('127.0.0.1', $port)) {
12455        my ($err_code, $err_name, $err_str) = $ssh2->error();
12456        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12457      }
12458
12459      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
12460        my ($err_code, $err_name, $err_str) = $ssh2->error();
12461        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
12462      }
12463
12464      $ssh2->disconnect();
12465    };
12466
12467    if ($@) {
12468      $ex = $@;
12469    }
12470
12471    $wfh->print("done\n");
12472    $wfh->flush();
12473
12474  } else {
12475    eval { server_wait($config_file, $rfh) };
12476    if ($@) {
12477      warn($@);
12478      exit 1;
12479    }
12480
12481    exit 0;
12482  }
12483
12484  # Stop server
12485  server_stop($pid_file);
12486
12487  $self->assert_child_ok($pid);
12488
12489  if ($ex) {
12490    test_append_logfile($log_file, $ex);
12491    unlink($log_file);
12492
12493    die($ex);
12494  }
12495
12496  unlink($log_file);
12497}
12498
12499sub ssh2_auth_publickey_rsa2048_no_nl {
12500  my $self = shift;
12501  my $tmpdir = $self->{tmpdir};
12502
12503  my $config_file = "$tmpdir/sftp.conf";
12504  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
12505  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
12506
12507  my $log_file = test_get_logfile();
12508
12509  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
12510  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
12511
12512  my $user = 'proftpd';
12513  my $passwd = 'test';
12514  my $group = 'ftpd';
12515  my $home_dir = File::Spec->rel2abs($tmpdir);
12516  my $uid = 500;
12517  my $gid = 500;
12518
12519  # Make sure that, if we're running as root, that the home directory has
12520  # permissions/privs set for the account we create
12521  if ($< == 0) {
12522    unless (chmod(0755, $home_dir)) {
12523      die("Can't set perms on $home_dir to 0755: $!");
12524    }
12525
12526    unless (chown($uid, $gid, $home_dir)) {
12527      die("Can't set owner of $home_dir to $uid/$gid: $!");
12528    }
12529  }
12530
12531  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
12532    '/bin/bash');
12533  auth_group_write($auth_group_file, $group, $gid, $user);
12534
12535  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12536  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12537
12538# Deliberately choose a key file which does NOT end in a LF.  Ultimately
12539# the mod_sftp code uses fsio_gets() to read the file, line by line, and that
12540# function expects an LF terminator for the line.
12541
12542  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
12543  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
12544  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys_no_nl');
12545
12546  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12547  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12548    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12549  }
12550
12551  my $config = {
12552    PidFile => $pid_file,
12553    ScoreboardFile => $scoreboard_file,
12554    SystemLog => $log_file,
12555    TraceLog => $log_file,
12556    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12557
12558    AuthUserFile => $auth_user_file,
12559    AuthGroupFile => $auth_group_file,
12560
12561    IfModules => {
12562      'mod_delay.c' => {
12563        DelayEngine => 'off',
12564      },
12565
12566      'mod_sftp.c' => [
12567        "SFTPEngine on",
12568        "SFTPLog $log_file",
12569        "SFTPHostKey $rsa_host_key",
12570        "SFTPHostKey $dsa_host_key",
12571        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12572      ],
12573    },
12574  };
12575
12576  my ($port, $config_user, $config_group) = config_write($config_file, $config);
12577
12578  # Open pipes, for use between the parent and child processes.  Specifically,
12579  # the child will indicate when it's done with its test by writing a message
12580  # to the parent.
12581  my ($rfh, $wfh);
12582  unless (pipe($rfh, $wfh)) {
12583    die("Can't open pipe: $!");
12584  }
12585
12586  require Net::SSH2;
12587
12588  my $ex;
12589
12590  # Fork child
12591  $self->handle_sigchld();
12592  defined(my $pid = fork()) or die("Can't fork: $!");
12593  if ($pid) {
12594    eval {
12595      my $ssh2 = Net::SSH2->new();
12596
12597      sleep(1);
12598
12599      unless ($ssh2->connect('127.0.0.1', $port)) {
12600        my ($err_code, $err_name, $err_str) = $ssh2->error();
12601        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12602      }
12603
12604      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
12605        my ($err_code, $err_name, $err_str) = $ssh2->error();
12606        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
12607      }
12608
12609      $ssh2->disconnect();
12610    };
12611
12612    if ($@) {
12613      $ex = $@;
12614    }
12615
12616    $wfh->print("done\n");
12617    $wfh->flush();
12618
12619  } else {
12620    eval { server_wait($config_file, $rfh) };
12621    if ($@) {
12622      warn($@);
12623      exit 1;
12624    }
12625
12626    exit 0;
12627  }
12628
12629  # Stop server
12630  server_stop($pid_file);
12631
12632  $self->assert_child_ok($pid);
12633
12634  if ($ex) {
12635    test_append_logfile($log_file, $ex);
12636    unlink($log_file);
12637
12638    die($ex);
12639  }
12640
12641  unlink($log_file);
12642}
12643
12644sub ssh2_auth_publickey_rsa2048_min_4096_bug4233 {
12645  my $self = shift;
12646  my $tmpdir = $self->{tmpdir};
12647  my $setup = test_setup($tmpdir, 'sftp');
12648
12649  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12650  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12651
12652  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
12653  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
12654  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
12655
12656  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12657  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12658    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12659  }
12660
12661  my $config = {
12662    PidFile => $setup->{pid_file},
12663    ScoreboardFile => $setup->{scoreboard_file},
12664    SystemLog => $setup->{log_file},
12665    TraceLog => $setup->{log_file},
12666    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12667
12668    AuthUserFile => $setup->{auth_user_file},
12669    AuthGroupFile => $setup->{auth_group_file},
12670
12671    IfModules => {
12672      'mod_delay.c' => {
12673        DelayEngine => 'off',
12674      },
12675
12676      'mod_sftp.c' => [
12677        "SFTPEngine on",
12678        "SFTPLog $setup->{log_file}",
12679        "SFTPHostKey $dsa_host_key",
12680        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12681        "SFTPKeyLimits MinimumRSASize 4096 MinimumDSASize 384",
12682      ],
12683    },
12684  };
12685
12686  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
12687    $config);
12688
12689  # Open pipes, for use between the parent and child processes.  Specifically,
12690  # the child will indicate when it's done with its test by writing a message
12691  # to the parent.
12692  my ($rfh, $wfh);
12693  unless (pipe($rfh, $wfh)) {
12694    die("Can't open pipe: $!");
12695  }
12696
12697  require Net::SSH2;
12698
12699  my $ex;
12700
12701  # Fork child
12702  $self->handle_sigchld();
12703  defined(my $pid = fork()) or die("Can't fork: $!");
12704  if ($pid) {
12705    eval {
12706      my $ssh2 = Net::SSH2->new();
12707
12708      sleep(1);
12709
12710      unless ($ssh2->connect('127.0.0.1', $port)) {
12711        my ($err_code, $err_name, $err_str) = $ssh2->error();
12712        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12713      }
12714
12715      if ($ssh2->auth_publickey($setup->{user}, $rsa_pub_key, $rsa_priv_key)) {
12716        die("RSA publickey authentication succeeded unexpectedly");
12717      }
12718
12719      my ($err_code, $err_name, $err_str) = $ssh2->error();
12720      $ssh2->disconnect();
12721
12722      if ($ENV{TEST_VERBOSE}) {
12723        print STDERR "# error code: $err_code\n";
12724        print STDERR "# error name: $err_name\n";
12725        print STDERR "# error message: $err_str\n";
12726      }
12727
12728      my $expected = 'LIBSSH2_ERROR_PUBLICKEY_UNVERIFIED';
12729      $self->assert($expected eq $err_name,
12730        test_msg("Expected '$expected', got '$err_name'"));
12731    };
12732    if ($@) {
12733      $ex = $@;
12734    }
12735
12736    $wfh->print("done\n");
12737    $wfh->flush();
12738
12739  } else {
12740    eval { server_wait($setup->{config_file}, $rfh) };
12741    if ($@) {
12742      warn($@);
12743      exit 1;
12744    }
12745
12746    exit 0;
12747  }
12748
12749  # Stop server
12750  server_stop($setup->{pid_file});
12751  $self->assert_child_ok($pid);
12752
12753  test_cleanup($setup->{log_file}, $ex);
12754}
12755
12756sub ssh2_auth_publickey_rsa4096 {
12757  my $self = shift;
12758  my $tmpdir = $self->{tmpdir};
12759
12760  my $config_file = "$tmpdir/sftp.conf";
12761  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
12762  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
12763
12764  my $log_file = test_get_logfile();
12765
12766  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
12767  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
12768
12769  my $user = 'proftpd';
12770  my $passwd = 'test';
12771  my $group = 'ftpd';
12772  my $home_dir = File::Spec->rel2abs($tmpdir);
12773  my $uid = 500;
12774  my $gid = 500;
12775
12776  # Make sure that, if we're running as root, that the home directory has
12777  # permissions/privs set for the account we create
12778  if ($< == 0) {
12779    unless (chmod(0755, $home_dir)) {
12780      die("Can't set perms on $home_dir to 0755: $!");
12781    }
12782
12783    unless (chown($uid, $gid, $home_dir)) {
12784      die("Can't set owner of $home_dir to $uid/$gid: $!");
12785    }
12786  }
12787
12788  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
12789    '/bin/bash');
12790  auth_group_write($auth_group_file, $group, $gid, $user);
12791
12792  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12793  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12794
12795  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa4096_key');
12796  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa4096_key.pub');
12797  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa4096_keys');
12798
12799  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12800  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12801    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12802  }
12803
12804  my $config = {
12805    PidFile => $pid_file,
12806    ScoreboardFile => $scoreboard_file,
12807    SystemLog => $log_file,
12808    TraceLog => $log_file,
12809    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12810
12811    AuthUserFile => $auth_user_file,
12812    AuthGroupFile => $auth_group_file,
12813
12814    IfModules => {
12815      'mod_delay.c' => {
12816        DelayEngine => 'off',
12817      },
12818
12819      'mod_sftp.c' => [
12820        "SFTPEngine on",
12821        "SFTPLog $log_file",
12822        "SFTPHostKey $rsa_host_key",
12823        "SFTPHostKey $dsa_host_key",
12824        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12825      ],
12826    },
12827  };
12828
12829  my ($port, $config_user, $config_group) = config_write($config_file, $config);
12830
12831  # Open pipes, for use between the parent and child processes.  Specifically,
12832  # the child will indicate when it's done with its test by writing a message
12833  # to the parent.
12834  my ($rfh, $wfh);
12835  unless (pipe($rfh, $wfh)) {
12836    die("Can't open pipe: $!");
12837  }
12838
12839  require Net::SSH2;
12840
12841  my $ex;
12842
12843  # Fork child
12844  $self->handle_sigchld();
12845  defined(my $pid = fork()) or die("Can't fork: $!");
12846  if ($pid) {
12847    eval {
12848      my $ssh2 = Net::SSH2->new();
12849
12850      sleep(1);
12851
12852      unless ($ssh2->connect('127.0.0.1', $port)) {
12853        my ($err_code, $err_name, $err_str) = $ssh2->error();
12854        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12855      }
12856
12857      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
12858        my ($err_code, $err_name, $err_str) = $ssh2->error();
12859        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
12860      }
12861
12862      $ssh2->disconnect();
12863    };
12864
12865    if ($@) {
12866      $ex = $@;
12867    }
12868
12869    $wfh->print("done\n");
12870    $wfh->flush();
12871
12872  } else {
12873    eval { server_wait($config_file, $rfh) };
12874    if ($@) {
12875      warn($@);
12876      exit 1;
12877    }
12878
12879    exit 0;
12880  }
12881
12882  # Stop server
12883  server_stop($pid_file);
12884
12885  $self->assert_child_ok($pid);
12886
12887  if ($ex) {
12888    test_append_logfile($log_file, $ex);
12889    unlink($log_file);
12890
12891    die($ex);
12892  }
12893
12894  unlink($log_file);
12895}
12896
12897sub ssh2_auth_publickey_rsa8192 {
12898  my $self = shift;
12899  my $tmpdir = $self->{tmpdir};
12900
12901  my $config_file = "$tmpdir/sftp.conf";
12902  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
12903  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
12904
12905  my $log_file = test_get_logfile();
12906
12907  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
12908  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
12909
12910  my $user = 'proftpd';
12911  my $passwd = 'test';
12912  my $group = 'ftpd';
12913  my $home_dir = File::Spec->rel2abs($tmpdir);
12914  my $uid = 500;
12915  my $gid = 500;
12916
12917  # Make sure that, if we're running as root, that the home directory has
12918  # permissions/privs set for the account we create
12919  if ($< == 0) {
12920    unless (chmod(0755, $home_dir)) {
12921      die("Can't set perms on $home_dir to 0755: $!");
12922    }
12923
12924    unless (chown($uid, $gid, $home_dir)) {
12925      die("Can't set owner of $home_dir to $uid/$gid: $!");
12926    }
12927  }
12928
12929  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
12930    '/bin/bash');
12931  auth_group_write($auth_group_file, $group, $gid, $user);
12932
12933  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
12934  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
12935
12936  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa8192_key');
12937  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa8192_key.pub');
12938  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa8192_keys');
12939
12940  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
12941  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
12942    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
12943  }
12944
12945  my $config = {
12946    PidFile => $pid_file,
12947    ScoreboardFile => $scoreboard_file,
12948    SystemLog => $log_file,
12949    TraceLog => $log_file,
12950    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
12951
12952    AuthUserFile => $auth_user_file,
12953    AuthGroupFile => $auth_group_file,
12954
12955    IfModules => {
12956      'mod_delay.c' => {
12957        DelayEngine => 'off',
12958      },
12959
12960      'mod_sftp.c' => [
12961        "SFTPEngine on",
12962        "SFTPLog $log_file",
12963        "SFTPHostKey $rsa_host_key",
12964        "SFTPHostKey $dsa_host_key",
12965        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
12966      ],
12967    },
12968  };
12969
12970  my ($port, $config_user, $config_group) = config_write($config_file, $config);
12971
12972  # Open pipes, for use between the parent and child processes.  Specifically,
12973  # the child will indicate when it's done with its test by writing a message
12974  # to the parent.
12975  my ($rfh, $wfh);
12976  unless (pipe($rfh, $wfh)) {
12977    die("Can't open pipe: $!");
12978  }
12979
12980  require Net::SSH2;
12981
12982  my $ex;
12983
12984  # Fork child
12985  $self->handle_sigchld();
12986  defined(my $pid = fork()) or die("Can't fork: $!");
12987  if ($pid) {
12988    eval {
12989      my $ssh2 = Net::SSH2->new();
12990
12991      sleep(1);
12992
12993      unless ($ssh2->connect('127.0.0.1', $port)) {
12994        my ($err_code, $err_name, $err_str) = $ssh2->error();
12995        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
12996      }
12997
12998      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
12999        my ($err_code, $err_name, $err_str) = $ssh2->error();
13000        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
13001      }
13002
13003      $ssh2->disconnect();
13004    };
13005
13006    if ($@) {
13007      $ex = $@;
13008    }
13009
13010    $wfh->print("done\n");
13011    $wfh->flush();
13012
13013  } else {
13014    eval { server_wait($config_file, $rfh) };
13015    if ($@) {
13016      warn($@);
13017      exit 1;
13018    }
13019
13020    exit 0;
13021  }
13022
13023  # Stop server
13024  server_stop($pid_file);
13025
13026  $self->assert_child_ok($pid);
13027
13028  if ($ex) {
13029    test_append_logfile($log_file, $ex);
13030    unlink($log_file);
13031
13032    die($ex);
13033  }
13034
13035  unlink($log_file);
13036}
13037
13038sub ssh2_auth_publickey_rsa16384 {
13039  my $self = shift;
13040  my $tmpdir = $self->{tmpdir};
13041
13042  my $config_file = "$tmpdir/sftp.conf";
13043  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
13044  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
13045
13046  my $log_file = test_get_logfile();
13047
13048  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
13049  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
13050
13051  my $user = 'proftpd';
13052  my $passwd = 'test';
13053  my $group = 'ftpd';
13054  my $home_dir = File::Spec->rel2abs($tmpdir);
13055  my $uid = 500;
13056  my $gid = 500;
13057
13058  # Make sure that, if we're running as root, that the home directory has
13059  # permissions/privs set for the account we create
13060  if ($< == 0) {
13061    unless (chmod(0755, $home_dir)) {
13062      die("Can't set perms on $home_dir to 0755: $!");
13063    }
13064
13065    unless (chown($uid, $gid, $home_dir)) {
13066      die("Can't set owner of $home_dir to $uid/$gid: $!");
13067    }
13068  }
13069
13070  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
13071    '/bin/bash');
13072  auth_group_write($auth_group_file, $group, $gid, $user);
13073
13074  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
13075  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
13076
13077  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa16384_key');
13078  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa16384_key.pub');
13079  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa16384_keys');
13080
13081  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
13082  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
13083    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
13084  }
13085
13086  my $timeout_idle = 15;
13087
13088  my $config = {
13089    PidFile => $pid_file,
13090    ScoreboardFile => $scoreboard_file,
13091    SystemLog => $log_file,
13092    TraceLog => $log_file,
13093    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
13094
13095    AuthUserFile => $auth_user_file,
13096    AuthGroupFile => $auth_group_file,
13097    TimeoutIdle => $timeout_idle,
13098
13099    IfModules => {
13100      'mod_delay.c' => {
13101        DelayEngine => 'off',
13102      },
13103
13104      'mod_sftp.c' => [
13105        "SFTPEngine on",
13106        "SFTPLog $log_file",
13107        "SFTPHostKey $rsa_host_key",
13108        "SFTPHostKey $dsa_host_key",
13109        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
13110      ],
13111    },
13112  };
13113
13114  my ($port, $config_user, $config_group) = config_write($config_file, $config);
13115
13116  # Open pipes, for use between the parent and child processes.  Specifically,
13117  # the child will indicate when it's done with its test by writing a message
13118  # to the parent.
13119  my ($rfh, $wfh);
13120  unless (pipe($rfh, $wfh)) {
13121    die("Can't open pipe: $!");
13122  }
13123
13124  require Net::SSH2;
13125
13126  my $ex;
13127
13128  # Fork child
13129  $self->handle_sigchld();
13130  defined(my $pid = fork()) or die("Can't fork: $!");
13131  if ($pid) {
13132    eval {
13133      my $ssh2 = Net::SSH2->new();
13134
13135      sleep(1);
13136
13137      unless ($ssh2->connect('127.0.0.1', $port)) {
13138        my ($err_code, $err_name, $err_str) = $ssh2->error();
13139        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
13140      }
13141
13142      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
13143        my ($err_code, $err_name, $err_str) = $ssh2->error();
13144        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
13145      }
13146
13147      $ssh2->disconnect();
13148    };
13149
13150    if ($@) {
13151      $ex = $@;
13152    }
13153
13154    $wfh->print("done\n");
13155    $wfh->flush();
13156
13157  } else {
13158    eval { server_wait($config_file, $rfh, $timeout_idle + 5) };
13159    if ($@) {
13160      warn($@);
13161      exit 1;
13162    }
13163
13164    exit 0;
13165  }
13166
13167  # Stop server
13168  server_stop($pid_file);
13169
13170  $self->assert_child_ok($pid);
13171
13172  if ($ex) {
13173    test_append_logfile($log_file, $ex);
13174    unlink($log_file);
13175
13176    die($ex);
13177  }
13178
13179  unlink($log_file);
13180}
13181
13182sub ssh2_ext_auth_publickey_rsa_sha256 {
13183  my $self = shift;
13184  my $tmpdir = $self->{tmpdir};
13185  my $setup = test_setup($tmpdir, 'sftp');
13186
13187  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
13188  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
13189
13190  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
13191  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
13192  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
13193
13194  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
13195  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
13196    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
13197  }
13198
13199  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
13200  if (open(my $fh, "> $src_file")) {
13201    print $fh "Hello, World!\n";
13202
13203    unless (close($fh)) {
13204      die("Can't write $src_file: $!");
13205    }
13206
13207  } else {
13208    die("Can't open $src_file: $!");
13209  }
13210
13211  my $src_sz = (stat($src_file))[7];
13212  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
13213
13214  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
13215  if (open(my $fh, "> $ssh_config")) {
13216    print $fh <<EOC;
13217PubkeyAcceptedKeyTypes rsa-sha2-256
13218EOC
13219    unless (close($fh)) {
13220      die("Can't write $ssh_config: $!");
13221    }
13222
13223  } else {
13224    die("Can't open $ssh_config: $!");
13225  }
13226
13227  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
13228  if (open(my $fh, "> $batch_file")) {
13229    print $fh "put -P $src_file $dst_file\n";
13230
13231    unless (close($fh)) {
13232      die("Can't write $batch_file: $!");
13233    }
13234
13235  } else {
13236    die("Can't open $batch_file: $!");
13237  }
13238
13239  my $config = {
13240    PidFile => $setup->{pid_file},
13241    ScoreboardFile => $setup->{scoreboard_file},
13242    SystemLog => $setup->{log_file},
13243    TraceLog => $setup->{log_file},
13244    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
13245
13246    AuthUserFile => $setup->{auth_user_file},
13247    AuthGroupFile => $setup->{auth_group_file},
13248
13249    IfModules => {
13250      'mod_delay.c' => {
13251        DelayEngine => 'off',
13252      },
13253
13254      'mod_sftp.c' => [
13255        "SFTPEngine on",
13256        "SFTPLog $setup->{log_file}",
13257        "SFTPHostKey $rsa_host_key",
13258        "SFTPHostKey $dsa_host_key",
13259        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
13260      ],
13261    },
13262  };
13263
13264  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
13265    $config);
13266
13267  # Open pipes, for use between the parent and child processes.  Specifically,
13268  # the child will indicate when it's done with its test by writing a message
13269  # to the parent.
13270  my ($rfh, $wfh);
13271  unless (pipe($rfh, $wfh)) {
13272    die("Can't open pipe: $!");
13273  }
13274
13275  require Net::SSH2;
13276
13277  my $ex;
13278
13279  # Fork child
13280  $self->handle_sigchld();
13281  defined(my $pid = fork()) or die("Can't fork: $!");
13282  if ($pid) {
13283    eval {
13284      # libssh2, and thus Net::SSH2, don't support rsa-sha256 yet.  So we
13285      # use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
13286      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
13287
13288      my @cmd = (
13289        $sftp,
13290        '-F',
13291        $ssh_config,
13292        '-oBatchMode=yes',
13293        '-oCheckHostIP=no',
13294        '-oCompression=yes',
13295        "-oPort=$port",
13296        "-oIdentityFile=$rsa_priv_key",
13297        '-oPubkeyAuthentication=yes',
13298        '-oStrictHostKeyChecking=no',
13299        '-vvv',
13300        '-b',
13301        $batch_file,
13302        "$setup->{user}\@127.0.0.1",
13303      );
13304
13305      my $sftp_rh = IO::Handle->new();
13306      my $sftp_wh = IO::Handle->new();
13307      my $sftp_eh = IO::Handle->new();
13308
13309      $sftp_wh->autoflush(1);
13310
13311      sleep(1);
13312
13313      local $SIG{CHLD} = 'DEFAULT';
13314
13315      # Make sure that the perms on the priv key are what OpenSSH wants
13316      unless (chmod(0400, $rsa_priv_key)) {
13317        die("Can't set perms on $rsa_priv_key to 0400: $!");
13318      }
13319
13320      if ($ENV{TEST_VERBOSE}) {
13321        print STDERR "Executing: ", join(' ', @cmd), "\n";
13322      }
13323
13324      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
13325      waitpid($sftp_pid, 0);
13326      my $exit_status = $?;
13327
13328      # Restore the perms on the priv key
13329      unless (chmod(0644, $rsa_priv_key)) {
13330        die("Can't set perms on $rsa_priv_key to 0644: $!");
13331      }
13332
13333      my ($res, $errstr);
13334      if ($exit_status >> 8 == 0) {
13335        $errstr = join('', <$sftp_eh>);
13336        $res = 0;
13337
13338      } else {
13339        $errstr = join('', <$sftp_eh>);
13340        if ($ENV{TEST_VERBOSE}) {
13341          print STDERR "Stderr: $errstr\n";
13342        }
13343
13344        $res = 1;
13345      }
13346
13347      unless ($res == 0) {
13348        die("Can't upload $src_file to server: $errstr");
13349      }
13350
13351      unless (-f $dst_file) {
13352        die("File '$dst_file' does not exist as expected");
13353      }
13354
13355      my $sz = (stat($dst_file))[7];
13356      my $expected_sz = $src_sz;
13357      $self->assert($expected_sz == $sz,
13358        test_msg("Expected file size $expected_sz, got $sz"));
13359    };
13360
13361    if ($@) {
13362      $ex = $@;
13363    }
13364
13365    $wfh->print("done\n");
13366    $wfh->flush();
13367
13368  } else {
13369    eval { server_wait($setup->{config_file}, $rfh) };
13370    if ($@) {
13371      warn($@);
13372      exit 1;
13373    }
13374
13375    exit 0;
13376  }
13377
13378  # Stop server
13379  server_stop($setup->{pid_file});
13380  $self->assert_child_ok($pid);
13381
13382  test_cleanup($setup->{log_file}, $ex);
13383}
13384
13385sub ssh2_ext_auth_publickey_rsa_sha512 {
13386  my $self = shift;
13387  my $tmpdir = $self->{tmpdir};
13388  my $setup = test_setup($tmpdir, 'sftp');
13389
13390  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
13391  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
13392
13393  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
13394  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
13395  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
13396
13397  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
13398  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
13399    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
13400  }
13401
13402  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
13403  if (open(my $fh, "> $src_file")) {
13404    print $fh "Hello, World!\n";
13405
13406    unless (close($fh)) {
13407      die("Can't write $src_file: $!");
13408    }
13409
13410  } else {
13411    die("Can't open $src_file: $!");
13412  }
13413
13414  my $src_sz = (stat($src_file))[7];
13415  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
13416
13417  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
13418  if (open(my $fh, "> $ssh_config")) {
13419    print $fh <<EOC;
13420IdentityAgent none
13421PubkeyAcceptedKeyTypes rsa-sha2-512
13422EOC
13423    unless (close($fh)) {
13424      die("Can't write $ssh_config: $!");
13425    }
13426
13427  } else {
13428    die("Can't open $ssh_config: $!");
13429  }
13430
13431  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
13432  if (open(my $fh, "> $batch_file")) {
13433    print $fh "put -P $src_file $dst_file\n";
13434
13435    unless (close($fh)) {
13436      die("Can't write $batch_file: $!");
13437    }
13438
13439  } else {
13440    die("Can't open $batch_file: $!");
13441  }
13442
13443  my $config = {
13444    PidFile => $setup->{pid_file},
13445    ScoreboardFile => $setup->{scoreboard_file},
13446    SystemLog => $setup->{log_file},
13447    TraceLog => $setup->{log_file},
13448    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
13449
13450    AuthUserFile => $setup->{auth_user_file},
13451    AuthGroupFile => $setup->{auth_group_file},
13452
13453    IfModules => {
13454      'mod_delay.c' => {
13455        DelayEngine => 'off',
13456      },
13457
13458      'mod_sftp.c' => [
13459        "SFTPEngine on",
13460        "SFTPLog $setup->{log_file}",
13461        "SFTPHostKey $rsa_host_key",
13462        "SFTPHostKey $dsa_host_key",
13463        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
13464      ],
13465    },
13466  };
13467
13468  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
13469    $config);
13470
13471  # Open pipes, for use between the parent and child processes.  Specifically,
13472  # the child will indicate when it's done with its test by writing a message
13473  # to the parent.
13474  my ($rfh, $wfh);
13475  unless (pipe($rfh, $wfh)) {
13476    die("Can't open pipe: $!");
13477  }
13478
13479  require Net::SSH2;
13480
13481  my $ex;
13482
13483  # Fork child
13484  $self->handle_sigchld();
13485  defined(my $pid = fork()) or die("Can't fork: $!");
13486  if ($pid) {
13487    eval {
13488      # libssh2, and thus Net::SSH2, don't support rsa-sha256 yet.  So we
13489      # use the external sftp(1) client (e.g. OpenSSH-7.9p1) to test.
13490      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
13491
13492      my @cmd = (
13493        $sftp,
13494        '-F',
13495        $ssh_config,
13496        '-oBatchMode=yes',
13497        '-oCheckHostIP=no',
13498        '-oCompression=yes',
13499        "-oPort=$port",
13500        "-oIdentityFile=$rsa_priv_key",
13501        '-oPubkeyAuthentication=yes',
13502        '-oStrictHostKeyChecking=no',
13503        '-vvv',
13504        '-b',
13505        $batch_file,
13506        "$setup->{user}\@127.0.0.1",
13507      );
13508
13509      my $sftp_rh = IO::Handle->new();
13510      my $sftp_wh = IO::Handle->new();
13511      my $sftp_eh = IO::Handle->new();
13512
13513      $sftp_wh->autoflush(1);
13514
13515      sleep(1);
13516
13517      local $SIG{CHLD} = 'DEFAULT';
13518
13519      # Make sure that the perms on the priv key are what OpenSSH wants
13520      unless (chmod(0400, $rsa_priv_key)) {
13521        die("Can't set perms on $rsa_priv_key to 0400: $!");
13522      }
13523
13524      if ($ENV{TEST_VERBOSE}) {
13525        print STDERR "Executing: ", join(' ', @cmd), "\n";
13526      }
13527
13528      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
13529      waitpid($sftp_pid, 0);
13530      my $exit_status = $?;
13531
13532      # Restore the perms on the priv key
13533      unless (chmod(0644, $rsa_priv_key)) {
13534        die("Can't set perms on $rsa_priv_key to 0644: $!");
13535      }
13536
13537      my ($res, $errstr);
13538      if ($exit_status >> 8 == 0) {
13539        $errstr = join('', <$sftp_eh>);
13540        $res = 0;
13541
13542      } else {
13543        $errstr = join('', <$sftp_eh>);
13544        if ($ENV{TEST_VERBOSE}) {
13545          print STDERR "Stderr: $errstr\n";
13546        }
13547
13548        $res = 1;
13549      }
13550
13551      unless ($res == 0) {
13552        die("Can't upload $src_file to server: $errstr");
13553      }
13554
13555      unless (-f $dst_file) {
13556        die("File '$dst_file' does not exist as expected");
13557      }
13558
13559      my $sz = (stat($dst_file))[7];
13560      my $expected_sz = $src_sz;
13561      $self->assert($expected_sz == $sz,
13562        test_msg("Expected file size $expected_sz, got $sz"));
13563    };
13564
13565    if ($@) {
13566      $ex = $@;
13567    }
13568
13569    $wfh->print("done\n");
13570    $wfh->flush();
13571
13572  } else {
13573    eval { server_wait($setup->{config_file}, $rfh) };
13574    if ($@) {
13575      warn($@);
13576      exit 1;
13577    }
13578
13579    exit 0;
13580  }
13581
13582  # Stop server
13583  server_stop($setup->{pid_file});
13584  $self->assert_child_ok($pid);
13585
13586  test_cleanup($setup->{log_file}, $ex);
13587}
13588
13589sub ssh2_auth_publickey_dsa1024 {
13590  my $self = shift;
13591  my $tmpdir = $self->{tmpdir};
13592
13593  my $config_file = "$tmpdir/sftp.conf";
13594  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
13595  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
13596
13597  my $log_file = test_get_logfile();
13598
13599  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
13600  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
13601
13602  my $user = 'proftpd';
13603  my $passwd = 'test';
13604  my $group = 'ftpd';
13605  my $home_dir = File::Spec->rel2abs($tmpdir);
13606  my $uid = 500;
13607  my $gid = 500;
13608
13609  # Make sure that, if we're running as root, that the home directory has
13610  # permissions/privs set for the account we create
13611  if ($< == 0) {
13612    unless (chmod(0755, $home_dir)) {
13613      die("Can't set perms on $home_dir to 0755: $!");
13614    }
13615
13616    unless (chown($uid, $gid, $home_dir)) {
13617      die("Can't set owner of $home_dir to $uid/$gid: $!");
13618    }
13619  }
13620
13621  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
13622    '/bin/bash');
13623  auth_group_write($auth_group_file, $group, $gid, $user);
13624
13625  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
13626  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
13627
13628  my $dsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa_key');
13629  my $dsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa_key.pub');
13630  my $dsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_dsa_keys');
13631
13632  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
13633  unless (copy($dsa_rfc4716_key, $authorized_keys)) {
13634    die("Can't copy $dsa_rfc4716_key to $authorized_keys: $!");
13635  }
13636
13637  my $config = {
13638    PidFile => $pid_file,
13639    ScoreboardFile => $scoreboard_file,
13640    SystemLog => $log_file,
13641    TraceLog => $log_file,
13642    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
13643
13644    AuthUserFile => $auth_user_file,
13645    AuthGroupFile => $auth_group_file,
13646
13647    IfModules => {
13648      'mod_delay.c' => {
13649        DelayEngine => 'off',
13650      },
13651
13652      'mod_sftp.c' => [
13653        "SFTPEngine on",
13654        "SFTPLog $log_file",
13655        "SFTPHostKey $rsa_host_key",
13656        "SFTPHostKey $dsa_host_key",
13657        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
13658      ],
13659    },
13660  };
13661
13662  my ($port, $config_user, $config_group) = config_write($config_file, $config);
13663
13664  # Open pipes, for use between the parent and child processes.  Specifically,
13665  # the child will indicate when it's done with its test by writing a message
13666  # to the parent.
13667  my ($rfh, $wfh);
13668  unless (pipe($rfh, $wfh)) {
13669    die("Can't open pipe: $!");
13670  }
13671
13672  require Net::SSH2;
13673
13674  my $ex;
13675
13676  # Fork child
13677  $self->handle_sigchld();
13678  defined(my $pid = fork()) or die("Can't fork: $!");
13679  if ($pid) {
13680    eval {
13681      my $ssh2 = Net::SSH2->new();
13682
13683      sleep(1);
13684
13685      unless ($ssh2->connect('127.0.0.1', $port)) {
13686        my ($err_code, $err_name, $err_str) = $ssh2->error();
13687        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
13688      }
13689
13690      unless ($ssh2->auth_publickey($user, $dsa_pub_key, $dsa_priv_key)) {
13691        my ($err_code, $err_name, $err_str) = $ssh2->error();
13692        die("DSA publickey authentication failed: [$err_name] ($err_code) $err_str");
13693      }
13694
13695      $ssh2->disconnect();
13696    };
13697
13698    if ($@) {
13699      $ex = $@;
13700    }
13701
13702    $wfh->print("done\n");
13703    $wfh->flush();
13704
13705  } else {
13706    eval { server_wait($config_file, $rfh) };
13707    if ($@) {
13708      warn($@);
13709      exit 1;
13710    }
13711
13712    exit 0;
13713  }
13714
13715  # Stop server
13716  server_stop($pid_file);
13717
13718  $self->assert_child_ok($pid);
13719
13720  if ($ex) {
13721    test_append_logfile($log_file, $ex);
13722    unlink($log_file);
13723
13724    die($ex);
13725  }
13726
13727  unlink($log_file);
13728}
13729
13730sub ssh2_auth_publickey_dsa2048 {
13731  my $self = shift;
13732  my $tmpdir = $self->{tmpdir};
13733
13734  my $config_file = "$tmpdir/sftp.conf";
13735  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
13736  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
13737
13738  my $log_file = test_get_logfile();
13739
13740  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
13741  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
13742
13743  my $user = 'proftpd';
13744  my $passwd = 'test';
13745  my $group = 'ftpd';
13746  my $home_dir = File::Spec->rel2abs($tmpdir);
13747  my $uid = 500;
13748  my $gid = 500;
13749
13750  # Make sure that, if we're running as root, that the home directory has
13751  # permissions/privs set for the account we create
13752  if ($< == 0) {
13753    unless (chmod(0755, $home_dir)) {
13754      die("Can't set perms on $home_dir to 0755: $!");
13755    }
13756
13757    unless (chown($uid, $gid, $home_dir)) {
13758      die("Can't set owner of $home_dir to $uid/$gid: $!");
13759    }
13760  }
13761
13762  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
13763    '/bin/bash');
13764  auth_group_write($auth_group_file, $group, $gid, $user);
13765
13766  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
13767  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
13768
13769  my $dsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa2048_key');
13770  my $dsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa2048_key.pub');
13771  my $dsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_dsa2048_keys');
13772
13773  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
13774  unless (copy($dsa_rfc4716_key, $authorized_keys)) {
13775    die("Can't copy $dsa_rfc4716_key to $authorized_keys: $!");
13776  }
13777
13778  my $config = {
13779    PidFile => $pid_file,
13780    ScoreboardFile => $scoreboard_file,
13781    SystemLog => $log_file,
13782    TraceLog => $log_file,
13783    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
13784
13785    AuthUserFile => $auth_user_file,
13786    AuthGroupFile => $auth_group_file,
13787
13788    IfModules => {
13789      'mod_delay.c' => {
13790        DelayEngine => 'off',
13791      },
13792
13793      'mod_sftp.c' => [
13794        "SFTPEngine on",
13795        "SFTPLog $log_file",
13796        "SFTPHostKey $rsa_host_key",
13797        "SFTPHostKey $dsa_host_key",
13798        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
13799      ],
13800    },
13801  };
13802
13803  my ($port, $config_user, $config_group) = config_write($config_file, $config);
13804
13805  # Open pipes, for use between the parent and child processes.  Specifically,
13806  # the child will indicate when it's done with its test by writing a message
13807  # to the parent.
13808  my ($rfh, $wfh);
13809  unless (pipe($rfh, $wfh)) {
13810    die("Can't open pipe: $!");
13811  }
13812
13813  require Net::SSH2;
13814
13815  my $ex;
13816
13817  # Fork child
13818  $self->handle_sigchld();
13819  defined(my $pid = fork()) or die("Can't fork: $!");
13820  if ($pid) {
13821    eval {
13822      my $ssh2 = Net::SSH2->new();
13823
13824      sleep(1);
13825
13826      unless ($ssh2->connect('127.0.0.1', $port)) {
13827        my ($err_code, $err_name, $err_str) = $ssh2->error();
13828        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
13829      }
13830
13831      unless ($ssh2->auth_publickey($user, $dsa_pub_key, $dsa_priv_key)) {
13832        my ($err_code, $err_name, $err_str) = $ssh2->error();
13833        die("DSA publickey authentication failed: [$err_name] ($err_code) $err_str");
13834      }
13835
13836      $ssh2->disconnect();
13837    };
13838
13839    if ($@) {
13840      $ex = $@;
13841    }
13842
13843    $wfh->print("done\n");
13844    $wfh->flush();
13845
13846  } else {
13847    eval { server_wait($config_file, $rfh) };
13848    if ($@) {
13849      warn($@);
13850      exit 1;
13851    }
13852
13853    exit 0;
13854  }
13855
13856  # Stop server
13857  server_stop($pid_file);
13858
13859  $self->assert_child_ok($pid);
13860
13861  if ($ex) {
13862    test_append_logfile($log_file, $ex);
13863    unlink($log_file);
13864
13865    die($ex);
13866  }
13867
13868  unlink($log_file);
13869}
13870
13871sub ssh2_auth_publickey_dsa4096 {
13872  my $self = shift;
13873  my $tmpdir = $self->{tmpdir};
13874
13875  my $config_file = "$tmpdir/sftp.conf";
13876  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
13877  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
13878
13879  my $log_file = test_get_logfile();
13880
13881  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
13882  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
13883
13884  my $user = 'proftpd';
13885  my $passwd = 'test';
13886  my $group = 'ftpd';
13887  my $home_dir = File::Spec->rel2abs($tmpdir);
13888  my $uid = 500;
13889  my $gid = 500;
13890
13891  # Make sure that, if we're running as root, that the home directory has
13892  # permissions/privs set for the account we create
13893  if ($< == 0) {
13894    unless (chmod(0755, $home_dir)) {
13895      die("Can't set perms on $home_dir to 0755: $!");
13896    }
13897
13898    unless (chown($uid, $gid, $home_dir)) {
13899      die("Can't set owner of $home_dir to $uid/$gid: $!");
13900    }
13901  }
13902
13903  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
13904    '/bin/bash');
13905  auth_group_write($auth_group_file, $group, $gid, $user);
13906
13907  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
13908  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
13909
13910  my $dsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa4096_key');
13911  my $dsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa4096_key.pub');
13912  my $dsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_dsa4096_keys');
13913
13914  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
13915  unless (copy($dsa_rfc4716_key, $authorized_keys)) {
13916    die("Can't copy $dsa_rfc4716_key to $authorized_keys: $!");
13917  }
13918
13919  my $config = {
13920    PidFile => $pid_file,
13921    ScoreboardFile => $scoreboard_file,
13922    SystemLog => $log_file,
13923    TraceLog => $log_file,
13924    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
13925
13926    AuthUserFile => $auth_user_file,
13927    AuthGroupFile => $auth_group_file,
13928
13929    IfModules => {
13930      'mod_delay.c' => {
13931        DelayEngine => 'off',
13932      },
13933
13934      'mod_sftp.c' => [
13935        "SFTPEngine on",
13936        "SFTPLog $log_file",
13937        "SFTPHostKey $rsa_host_key",
13938        "SFTPHostKey $dsa_host_key",
13939        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
13940      ],
13941    },
13942  };
13943
13944  my ($port, $config_user, $config_group) = config_write($config_file, $config);
13945
13946  # Open pipes, for use between the parent and child processes.  Specifically,
13947  # the child will indicate when it's done with its test by writing a message
13948  # to the parent.
13949  my ($rfh, $wfh);
13950  unless (pipe($rfh, $wfh)) {
13951    die("Can't open pipe: $!");
13952  }
13953
13954  require Net::SSH2;
13955
13956  my $ex;
13957
13958  # Fork child
13959  $self->handle_sigchld();
13960  defined(my $pid = fork()) or die("Can't fork: $!");
13961  if ($pid) {
13962    eval {
13963      my $ssh2 = Net::SSH2->new();
13964
13965      sleep(1);
13966
13967      unless ($ssh2->connect('127.0.0.1', $port)) {
13968        my ($err_code, $err_name, $err_str) = $ssh2->error();
13969        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
13970      }
13971
13972      unless ($ssh2->auth_publickey($user, $dsa_pub_key, $dsa_priv_key)) {
13973        my ($err_code, $err_name, $err_str) = $ssh2->error();
13974        die("DSA publickey authentication failed: [$err_name] ($err_code) $err_str");
13975      }
13976
13977      $ssh2->disconnect();
13978    };
13979
13980    if ($@) {
13981      $ex = $@;
13982    }
13983
13984    $wfh->print("done\n");
13985    $wfh->flush();
13986
13987  } else {
13988    eval { server_wait($config_file, $rfh) };
13989    if ($@) {
13990      warn($@);
13991      exit 1;
13992    }
13993
13994    exit 0;
13995  }
13996
13997  # Stop server
13998  server_stop($pid_file);
13999
14000  $self->assert_child_ok($pid);
14001
14002  if ($ex) {
14003    test_append_logfile($log_file, $ex);
14004    unlink($log_file);
14005
14006    die($ex);
14007  }
14008
14009  unlink($log_file);
14010}
14011
14012sub ssh2_auth_publickey_dsa8192 {
14013  my $self = shift;
14014  my $tmpdir = $self->{tmpdir};
14015
14016  my $config_file = "$tmpdir/sftp.conf";
14017  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
14018  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
14019
14020  my $log_file = test_get_logfile();
14021
14022  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
14023  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
14024
14025  my $user = 'proftpd';
14026  my $passwd = 'test';
14027  my $group = 'ftpd';
14028  my $home_dir = File::Spec->rel2abs($tmpdir);
14029  my $uid = 500;
14030  my $gid = 500;
14031
14032  # Make sure that, if we're running as root, that the home directory has
14033  # permissions/privs set for the account we create
14034  if ($< == 0) {
14035    unless (chmod(0755, $home_dir)) {
14036      die("Can't set perms on $home_dir to 0755: $!");
14037    }
14038
14039    unless (chown($uid, $gid, $home_dir)) {
14040      die("Can't set owner of $home_dir to $uid/$gid: $!");
14041    }
14042  }
14043
14044  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
14045    '/bin/bash');
14046  auth_group_write($auth_group_file, $group, $gid, $user);
14047
14048  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
14049  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
14050
14051  my $dsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa8192_key');
14052  my $dsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa8192_key.pub');
14053  my $dsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_dsa8192_keys');
14054
14055  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
14056  unless (copy($dsa_rfc4716_key, $authorized_keys)) {
14057    die("Can't copy $dsa_rfc4716_key to $authorized_keys: $!");
14058  }
14059
14060  my $config = {
14061    PidFile => $pid_file,
14062    ScoreboardFile => $scoreboard_file,
14063    SystemLog => $log_file,
14064    TraceLog => $log_file,
14065    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
14066
14067    AuthUserFile => $auth_user_file,
14068    AuthGroupFile => $auth_group_file,
14069
14070    IfModules => {
14071      'mod_delay.c' => {
14072        DelayEngine => 'off',
14073      },
14074
14075      'mod_sftp.c' => [
14076        "SFTPEngine on",
14077        "SFTPLog $log_file",
14078        "SFTPHostKey $rsa_host_key",
14079        "SFTPHostKey $dsa_host_key",
14080        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
14081      ],
14082    },
14083  };
14084
14085  my ($port, $config_user, $config_group) = config_write($config_file, $config);
14086
14087  # Open pipes, for use between the parent and child processes.  Specifically,
14088  # the child will indicate when it's done with its test by writing a message
14089  # to the parent.
14090  my ($rfh, $wfh);
14091  unless (pipe($rfh, $wfh)) {
14092    die("Can't open pipe: $!");
14093  }
14094
14095  require Net::SSH2;
14096
14097  my $ex;
14098
14099  # Fork child
14100  $self->handle_sigchld();
14101  defined(my $pid = fork()) or die("Can't fork: $!");
14102  if ($pid) {
14103    eval {
14104      my $ssh2 = Net::SSH2->new();
14105
14106      sleep(1);
14107
14108      unless ($ssh2->connect('127.0.0.1', $port)) {
14109        my ($err_code, $err_name, $err_str) = $ssh2->error();
14110        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
14111      }
14112
14113      unless ($ssh2->auth_publickey($user, $dsa_pub_key, $dsa_priv_key)) {
14114        my ($err_code, $err_name, $err_str) = $ssh2->error();
14115        die("DSA publickey authentication failed: [$err_name] ($err_code) $err_str");
14116      }
14117
14118      $ssh2->disconnect();
14119    };
14120
14121    if ($@) {
14122      $ex = $@;
14123    }
14124
14125    $wfh->print("done\n");
14126    $wfh->flush();
14127
14128  } else {
14129    eval { server_wait($config_file, $rfh) };
14130    if ($@) {
14131      warn($@);
14132      exit 1;
14133    }
14134
14135    exit 0;
14136  }
14137
14138  # Stop server
14139  server_stop($pid_file);
14140
14141  $self->assert_child_ok($pid);
14142
14143  if ($ex) {
14144    test_append_logfile($log_file, $ex);
14145    unlink($log_file);
14146
14147    die($ex);
14148  }
14149
14150  unlink($log_file);
14151}
14152
14153sub ssh2_auth_publickey_user_var_bug3315 {
14154  my $self = shift;
14155  my $tmpdir = $self->{tmpdir};
14156
14157  my $config_file = "$tmpdir/sftp.conf";
14158  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
14159  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
14160
14161  my $log_file = test_get_logfile();
14162
14163  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
14164  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
14165
14166  my $user = 'proftpd';
14167  my $passwd = 'test';
14168  my $group = 'ftpd';
14169  my $home_dir = File::Spec->rel2abs($tmpdir);
14170  my $uid = 500;
14171  my $gid = 500;
14172
14173  # Make sure that, if we're running as root, that the home directory has
14174  # permissions/privs set for the account we create
14175  if ($< == 0) {
14176    unless (chmod(0755, $home_dir)) {
14177      die("Can't set perms on $home_dir to 0755: $!");
14178    }
14179
14180    unless (chown($uid, $gid, $home_dir)) {
14181      die("Can't set owner of $home_dir to $uid/$gid: $!");
14182    }
14183  }
14184
14185  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
14186    '/bin/bash');
14187  auth_group_write($auth_group_file, $group, $gid, $user);
14188
14189  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
14190  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
14191
14192  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
14193  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
14194  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
14195
14196  my $authorized_keys_dir = File::Spec->rel2abs("$tmpdir/authorized_keys");
14197  mkpath($authorized_keys_dir);
14198
14199  my $authorized_keys = File::Spec->rel2abs("$authorized_keys_dir/$user");
14200  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
14201    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
14202  }
14203
14204  my $config = {
14205    PidFile => $pid_file,
14206    ScoreboardFile => $scoreboard_file,
14207    SystemLog => $log_file,
14208    TraceLog => $log_file,
14209    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
14210
14211    AuthUserFile => $auth_user_file,
14212    AuthGroupFile => $auth_group_file,
14213
14214    IfModules => {
14215      'mod_delay.c' => {
14216        DelayEngine => 'off',
14217      },
14218
14219      'mod_sftp.c' => [
14220        "SFTPEngine on",
14221        "SFTPLog $log_file",
14222        "SFTPHostKey $rsa_host_key",
14223        "SFTPHostKey $dsa_host_key",
14224        "SFTPAuthorizedUserKeys file:$authorized_keys_dir/%u",
14225      ],
14226    },
14227  };
14228
14229  my ($port, $config_user, $config_group) = config_write($config_file, $config);
14230
14231  # Open pipes, for use between the parent and child processes.  Specifically,
14232  # the child will indicate when it's done with its test by writing a message
14233  # to the parent.
14234  my ($rfh, $wfh);
14235  unless (pipe($rfh, $wfh)) {
14236    die("Can't open pipe: $!");
14237  }
14238
14239  require Net::SSH2;
14240
14241  my $ex;
14242
14243  # Fork child
14244  $self->handle_sigchld();
14245  defined(my $pid = fork()) or die("Can't fork: $!");
14246  if ($pid) {
14247    eval {
14248      my $ssh2 = Net::SSH2->new();
14249
14250      sleep(1);
14251
14252      unless ($ssh2->connect('127.0.0.1', $port)) {
14253        my ($err_code, $err_name, $err_str) = $ssh2->error();
14254        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
14255      }
14256
14257      unless ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
14258        my ($err_code, $err_name, $err_str) = $ssh2->error();
14259        die("RSA publickey authentication failed: [$err_name] ($err_code) $err_str");
14260      }
14261
14262      $ssh2->disconnect();
14263    };
14264
14265    if ($@) {
14266      $ex = $@;
14267    }
14268
14269    $wfh->print("done\n");
14270    $wfh->flush();
14271
14272  } else {
14273    eval { server_wait($config_file, $rfh) };
14274    if ($@) {
14275      warn($@);
14276      exit 1;
14277    }
14278
14279    exit 0;
14280  }
14281
14282  # Stop server
14283  server_stop($pid_file);
14284
14285  $self->assert_child_ok($pid);
14286
14287  if ($ex) {
14288    test_append_logfile($log_file, $ex);
14289    unlink($log_file);
14290
14291    die($ex);
14292  }
14293
14294  unlink($log_file);
14295}
14296
14297sub ssh2_ext_auth_publickey_ecdsa256 {
14298  my $self = shift;
14299  my $tmpdir = $self->{tmpdir};
14300
14301  my $config_file = "$tmpdir/sftp.conf";
14302  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
14303  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
14304
14305  my $log_file = test_get_logfile();
14306
14307  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
14308  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
14309
14310  my $user = 'proftpd';
14311  my $passwd = 'test';
14312  my $group = 'ftpd';
14313  my $home_dir = File::Spec->rel2abs($tmpdir);
14314  my $uid = 500;
14315  my $gid = 500;
14316
14317  # Make sure that, if we're running as root, that the home directory has
14318  # permissions/privs set for the account we create
14319  if ($< == 0) {
14320    unless (chmod(0755, $home_dir)) {
14321      die("Can't set perms on $home_dir to 0755: $!");
14322    }
14323
14324    unless (chown($uid, $gid, $home_dir)) {
14325      die("Can't set owner of $home_dir to $uid/$gid: $!");
14326    }
14327  }
14328
14329  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
14330    '/bin/bash');
14331  auth_group_write($auth_group_file, $group, $gid, $user);
14332
14333  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
14334  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
14335
14336  my $ecdsa256_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_ecdsa256_key');
14337  my $ecdsa256_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_ecdsa256_key.pub');
14338  my $ecdsa256_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_ecdsa256_keys');
14339
14340  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
14341  unless (copy($ecdsa256_rfc4716_key, $authorized_keys)) {
14342    die("Can't copy $ecdsa256_rfc4716_key to $authorized_keys: $!");
14343  }
14344
14345  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
14346  if (open(my $fh, "> $src_file")) {
14347    print $fh "Hello, World!\n";
14348
14349    unless (close($fh)) {
14350      die("Can't write $src_file: $!");
14351    }
14352
14353  } else {
14354    die("Can't open $src_file: $!");
14355  }
14356
14357  my $src_sz = (stat($src_file))[7];
14358
14359  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
14360
14361  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
14362  if (open(my $fh, "> $batch_file")) {
14363    print $fh "put -P $src_file $dst_file\n";
14364
14365    unless (close($fh)) {
14366      die("Can't write $batch_file: $!");
14367    }
14368
14369  } else {
14370    die("Can't open $batch_file: $!");
14371  }
14372
14373  my $config = {
14374    PidFile => $pid_file,
14375    ScoreboardFile => $scoreboard_file,
14376    SystemLog => $log_file,
14377    TraceLog => $log_file,
14378    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
14379
14380    AuthUserFile => $auth_user_file,
14381    AuthGroupFile => $auth_group_file,
14382
14383    IfModules => {
14384      'mod_delay.c' => {
14385        DelayEngine => 'off',
14386      },
14387
14388      'mod_sftp.c' => [
14389        "SFTPEngine on",
14390        "SFTPLog $log_file",
14391        "SFTPHostKey $rsa_host_key",
14392        "SFTPHostKey $dsa_host_key",
14393        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
14394      ],
14395    },
14396  };
14397
14398  my ($port, $config_user, $config_group) = config_write($config_file, $config);
14399
14400  # Open pipes, for use between the parent and child processes.  Specifically,
14401  # the child will indicate when it's done with its test by writing a message
14402  # to the parent.
14403  my ($rfh, $wfh);
14404  unless (pipe($rfh, $wfh)) {
14405    die("Can't open pipe: $!");
14406  }
14407
14408  require Net::SSH2;
14409
14410  my $ex;
14411
14412  # Fork child
14413  $self->handle_sigchld();
14414  defined(my $pid = fork()) or die("Can't fork: $!");
14415  if ($pid) {
14416    eval {
14417
14418      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
14419      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
14420
14421      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
14422
14423      my @cmd = (
14424        $sftp,
14425        '-oBatchMode=yes',
14426        '-oCheckHostIP=no',
14427        '-oCompression=yes',
14428        "-oPort=$port",
14429        "-oIdentityFile=$ecdsa256_priv_key",
14430        '-oPubkeyAuthentication=yes',
14431        '-oStrictHostKeyChecking=no',
14432        '-vvv',
14433        '-b',
14434        $batch_file,
14435        "$user\@127.0.0.1",
14436      );
14437
14438      my $sftp_rh = IO::Handle->new();
14439      my $sftp_wh = IO::Handle->new();
14440      my $sftp_eh = IO::Handle->new();
14441
14442      $sftp_wh->autoflush(1);
14443
14444      sleep(1);
14445
14446      local $SIG{CHLD} = 'DEFAULT';
14447
14448      # Make sure that the perms on the priv key are what OpenSSH wants
14449      unless (chmod(0400, $ecdsa256_priv_key)) {
14450        die("Can't set perms on $ecdsa256_priv_key to 0400: $!");
14451      }
14452
14453      if ($ENV{TEST_VERBOSE}) {
14454        print STDERR "Executing: ", join(' ', @cmd), "\n";
14455      }
14456
14457      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
14458      waitpid($sftp_pid, 0);
14459      my $exit_status = $?;
14460
14461      # Restore the perms on the priv key
14462      unless (chmod(0644, $ecdsa256_priv_key)) {
14463        die("Can't set perms on $ecdsa256_priv_key to 0644: $!");
14464      }
14465
14466      my ($res, $errstr);
14467      if ($exit_status >> 8 == 0) {
14468        $errstr = join('', <$sftp_eh>);
14469        $res = 0;
14470
14471      } else {
14472        $errstr = join('', <$sftp_eh>);
14473        if ($ENV{TEST_VERBOSE}) {
14474          print STDERR "Stderr: $errstr\n";
14475        }
14476
14477        $res = 1;
14478      }
14479
14480      unless ($res == 0) {
14481        die("Can't upload $src_file to server: $errstr");
14482      }
14483
14484      unless (-f $dst_file) {
14485        die("File '$dst_file' does not exist as expected");
14486      }
14487
14488      my $sz = (stat($dst_file))[7];
14489      my $expected_sz = $src_sz;
14490      $self->assert($expected_sz == $sz,
14491        test_msg("Expected file size $expected_sz, got $sz"));
14492
14493    };
14494
14495    if ($@) {
14496      $ex = $@;
14497    }
14498
14499    $wfh->print("done\n");
14500    $wfh->flush();
14501
14502  } else {
14503    eval { server_wait($config_file, $rfh) };
14504    if ($@) {
14505      warn($@);
14506      exit 1;
14507    }
14508
14509    exit 0;
14510  }
14511
14512  # Stop server
14513  server_stop($pid_file);
14514
14515  $self->assert_child_ok($pid);
14516
14517  if ($ex) {
14518    test_append_logfile($log_file, $ex);
14519    unlink($log_file);
14520
14521    die($ex);
14522  }
14523
14524  unlink($log_file);
14525}
14526
14527sub ssh2_ext_auth_publickey_ecdsa384 {
14528  my $self = shift;
14529  my $tmpdir = $self->{tmpdir};
14530
14531  my $config_file = "$tmpdir/sftp.conf";
14532  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
14533  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
14534
14535  my $log_file = test_get_logfile();
14536
14537  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
14538  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
14539
14540  my $user = 'proftpd';
14541  my $passwd = 'test';
14542  my $group = 'ftpd';
14543  my $home_dir = File::Spec->rel2abs($tmpdir);
14544  my $uid = 500;
14545  my $gid = 500;
14546
14547  # Make sure that, if we're running as root, that the home directory has
14548  # permissions/privs set for the account we create
14549  if ($< == 0) {
14550    unless (chmod(0755, $home_dir)) {
14551      die("Can't set perms on $home_dir to 0755: $!");
14552    }
14553
14554    unless (chown($uid, $gid, $home_dir)) {
14555      die("Can't set owner of $home_dir to $uid/$gid: $!");
14556    }
14557  }
14558
14559  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
14560    '/bin/bash');
14561  auth_group_write($auth_group_file, $group, $gid, $user);
14562
14563  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
14564  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
14565
14566  my $ecdsa384_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_ecdsa384_key');
14567  my $ecdsa384_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_ecdsa384_key.pub');
14568  my $ecdsa384_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_ecdsa384_keys');
14569
14570  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
14571  unless (copy($ecdsa384_rfc4716_key, $authorized_keys)) {
14572    die("Can't copy $ecdsa384_rfc4716_key to $authorized_keys: $!");
14573  }
14574
14575  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
14576  if (open(my $fh, "> $src_file")) {
14577    print $fh "Hello, World!\n";
14578
14579    unless (close($fh)) {
14580      die("Can't write $src_file: $!");
14581    }
14582
14583  } else {
14584    die("Can't open $src_file: $!");
14585  }
14586
14587  my $src_sz = (stat($src_file))[7];
14588
14589  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
14590
14591  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
14592  if (open(my $fh, "> $batch_file")) {
14593    print $fh "put -P $src_file $dst_file\n";
14594
14595    unless (close($fh)) {
14596      die("Can't write $batch_file: $!");
14597    }
14598
14599  } else {
14600    die("Can't open $batch_file: $!");
14601  }
14602
14603  my $config = {
14604    PidFile => $pid_file,
14605    ScoreboardFile => $scoreboard_file,
14606    SystemLog => $log_file,
14607    TraceLog => $log_file,
14608    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
14609
14610    AuthUserFile => $auth_user_file,
14611    AuthGroupFile => $auth_group_file,
14612
14613    IfModules => {
14614      'mod_delay.c' => {
14615        DelayEngine => 'off',
14616      },
14617
14618      'mod_sftp.c' => [
14619        "SFTPEngine on",
14620        "SFTPLog $log_file",
14621        "SFTPHostKey $rsa_host_key",
14622        "SFTPHostKey $dsa_host_key",
14623        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
14624      ],
14625    },
14626  };
14627
14628  my ($port, $config_user, $config_group) = config_write($config_file, $config);
14629
14630  # Open pipes, for use between the parent and child processes.  Specifically,
14631  # the child will indicate when it's done with its test by writing a message
14632  # to the parent.
14633  my ($rfh, $wfh);
14634  unless (pipe($rfh, $wfh)) {
14635    die("Can't open pipe: $!");
14636  }
14637
14638  require Net::SSH2;
14639
14640  my $ex;
14641
14642  # Fork child
14643  $self->handle_sigchld();
14644  defined(my $pid = fork()) or die("Can't fork: $!");
14645  if ($pid) {
14646    eval {
14647
14648      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
14649      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
14650
14651      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
14652
14653      my @cmd = (
14654        $sftp,
14655        '-oBatchMode=yes',
14656        '-oCheckHostIP=no',
14657        '-oCompression=yes',
14658        "-oPort=$port",
14659        "-oIdentityFile=$ecdsa384_priv_key",
14660        '-oPubkeyAuthentication=yes',
14661        '-oStrictHostKeyChecking=no',
14662        '-vvv',
14663        '-b',
14664        $batch_file,
14665        "$user\@127.0.0.1",
14666      );
14667
14668      my $sftp_rh = IO::Handle->new();
14669      my $sftp_wh = IO::Handle->new();
14670      my $sftp_eh = IO::Handle->new();
14671
14672      $sftp_wh->autoflush(1);
14673
14674      sleep(1);
14675
14676      local $SIG{CHLD} = 'DEFAULT';
14677
14678      # Make sure that the perms on the priv key are what OpenSSH wants
14679      unless (chmod(0400, $ecdsa384_priv_key)) {
14680        die("Can't set perms on $ecdsa384_priv_key to 0400: $!");
14681      }
14682
14683      if ($ENV{TEST_VERBOSE}) {
14684        print STDERR "Executing: ", join(' ', @cmd), "\n";
14685      }
14686
14687      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
14688      waitpid($sftp_pid, 0);
14689      my $exit_status = $?;
14690
14691      # Restore the perms on the priv key
14692      unless (chmod(0644, $ecdsa384_priv_key)) {
14693        die("Can't set perms on $ecdsa384_priv_key to 0644: $!");
14694      }
14695
14696      my ($res, $errstr);
14697      if ($exit_status >> 8 == 0) {
14698        $errstr = join('', <$sftp_eh>);
14699        $res = 0;
14700
14701      } else {
14702        $errstr = join('', <$sftp_eh>);
14703        if ($ENV{TEST_VERBOSE}) {
14704          print STDERR "Stderr: $errstr\n";
14705        }
14706
14707        $res = 1;
14708      }
14709
14710      unless ($res == 0) {
14711        die("Can't upload $src_file to server: $errstr");
14712      }
14713
14714      unless (-f $dst_file) {
14715        die("File '$dst_file' does not exist as expected");
14716      }
14717
14718      my $sz = (stat($dst_file))[7];
14719      my $expected_sz = $src_sz;
14720      $self->assert($expected_sz == $sz,
14721        test_msg("Expected file size $expected_sz, got $sz"));
14722
14723    };
14724
14725    if ($@) {
14726      $ex = $@;
14727    }
14728
14729    $wfh->print("done\n");
14730    $wfh->flush();
14731
14732  } else {
14733    eval { server_wait($config_file, $rfh) };
14734    if ($@) {
14735      warn($@);
14736      exit 1;
14737    }
14738
14739    exit 0;
14740  }
14741
14742  # Stop server
14743  server_stop($pid_file);
14744
14745  $self->assert_child_ok($pid);
14746
14747  if ($ex) {
14748    test_append_logfile($log_file, $ex);
14749    unlink($log_file);
14750
14751    die($ex);
14752  }
14753
14754  unlink($log_file);
14755}
14756
14757sub ssh2_ext_auth_publickey_ecdsa521 {
14758  my $self = shift;
14759  my $tmpdir = $self->{tmpdir};
14760
14761  my $config_file = "$tmpdir/sftp.conf";
14762  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
14763  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
14764
14765  my $log_file = test_get_logfile();
14766
14767  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
14768  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
14769
14770  my $user = 'proftpd';
14771  my $passwd = 'test';
14772  my $group = 'ftpd';
14773  my $home_dir = File::Spec->rel2abs($tmpdir);
14774  my $uid = 500;
14775  my $gid = 500;
14776
14777  # Make sure that, if we're running as root, that the home directory has
14778  # permissions/privs set for the account we create
14779  if ($< == 0) {
14780    unless (chmod(0755, $home_dir)) {
14781      die("Can't set perms on $home_dir to 0755: $!");
14782    }
14783
14784    unless (chown($uid, $gid, $home_dir)) {
14785      die("Can't set owner of $home_dir to $uid/$gid: $!");
14786    }
14787  }
14788
14789  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
14790    '/bin/bash');
14791  auth_group_write($auth_group_file, $group, $gid, $user);
14792
14793  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
14794  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
14795
14796  my $ecdsa521_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_ecdsa521_key');
14797  my $ecdsa521_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_ecdsa521_key.pub');
14798  my $ecdsa521_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_ecdsa521_keys');
14799
14800  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
14801  unless (copy($ecdsa521_rfc4716_key, $authorized_keys)) {
14802    die("Can't copy $ecdsa521_rfc4716_key to $authorized_keys: $!");
14803  }
14804
14805  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
14806  if (open(my $fh, "> $src_file")) {
14807    print $fh "Hello, World!\n";
14808
14809    unless (close($fh)) {
14810      die("Can't write $src_file: $!");
14811    }
14812
14813  } else {
14814    die("Can't open $src_file: $!");
14815  }
14816
14817  my $src_sz = (stat($src_file))[7];
14818
14819  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
14820
14821  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
14822  if (open(my $fh, "> $batch_file")) {
14823    print $fh "put -P $src_file $dst_file\n";
14824
14825    unless (close($fh)) {
14826      die("Can't write $batch_file: $!");
14827    }
14828
14829  } else {
14830    die("Can't open $batch_file: $!");
14831  }
14832
14833  my $config = {
14834    PidFile => $pid_file,
14835    ScoreboardFile => $scoreboard_file,
14836    SystemLog => $log_file,
14837    TraceLog => $log_file,
14838    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
14839
14840    AuthUserFile => $auth_user_file,
14841    AuthGroupFile => $auth_group_file,
14842
14843    IfModules => {
14844      'mod_delay.c' => {
14845        DelayEngine => 'off',
14846      },
14847
14848      'mod_sftp.c' => [
14849        "SFTPEngine on",
14850        "SFTPLog $log_file",
14851        "SFTPHostKey $rsa_host_key",
14852        "SFTPHostKey $dsa_host_key",
14853        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
14854      ],
14855    },
14856  };
14857
14858  my ($port, $config_user, $config_group) = config_write($config_file, $config);
14859
14860  # Open pipes, for use between the parent and child processes.  Specifically,
14861  # the child will indicate when it's done with its test by writing a message
14862  # to the parent.
14863  my ($rfh, $wfh);
14864  unless (pipe($rfh, $wfh)) {
14865    die("Can't open pipe: $!");
14866  }
14867
14868  require Net::SSH2;
14869
14870  my $ex;
14871
14872  # Fork child
14873  $self->handle_sigchld();
14874  defined(my $pid = fork()) or die("Can't fork: $!");
14875  if ($pid) {
14876    eval {
14877
14878      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
14879      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
14880
14881      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
14882
14883      my @cmd = (
14884        $sftp,
14885        '-oBatchMode=yes',
14886        '-oCheckHostIP=no',
14887        '-oCompression=yes',
14888        "-oPort=$port",
14889        "-oIdentityFile=$ecdsa521_priv_key",
14890        '-oPubkeyAuthentication=yes',
14891        '-oStrictHostKeyChecking=no',
14892        '-vvv',
14893        '-b',
14894        $batch_file,
14895        "$user\@127.0.0.1",
14896      );
14897
14898      my $sftp_rh = IO::Handle->new();
14899      my $sftp_wh = IO::Handle->new();
14900      my $sftp_eh = IO::Handle->new();
14901
14902      $sftp_wh->autoflush(1);
14903
14904      sleep(1);
14905
14906      local $SIG{CHLD} = 'DEFAULT';
14907
14908      # Make sure that the perms on the priv key are what OpenSSH wants
14909      unless (chmod(0400, $ecdsa521_priv_key)) {
14910        die("Can't set perms on $ecdsa521_priv_key to 0400: $!");
14911      }
14912
14913      if ($ENV{TEST_VERBOSE}) {
14914        print STDERR "Executing: ", join(' ', @cmd), "\n";
14915      }
14916
14917      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
14918      waitpid($sftp_pid, 0);
14919      my $exit_status = $?;
14920
14921      # Restore the perms on the priv key
14922      unless (chmod(0644, $ecdsa521_priv_key)) {
14923        die("Can't set perms on $ecdsa521_priv_key to 0644: $!");
14924      }
14925
14926      my ($res, $errstr);
14927      if ($exit_status >> 8 == 0) {
14928        $errstr = join('', <$sftp_eh>);
14929        $res = 0;
14930
14931      } else {
14932        $errstr = join('', <$sftp_eh>);
14933        if ($ENV{TEST_VERBOSE}) {
14934          print STDERR "Stderr: $errstr\n";
14935        }
14936
14937        $res = 1;
14938      }
14939
14940      unless ($res == 0) {
14941        die("Can't upload $src_file to server: $errstr");
14942      }
14943
14944      unless (-f $dst_file) {
14945        die("File '$dst_file' does not exist as expected");
14946      }
14947
14948      my $sz = (stat($dst_file))[7];
14949      my $expected_sz = $src_sz;
14950      $self->assert($expected_sz == $sz,
14951        test_msg("Expected file size $expected_sz, got $sz"));
14952
14953    };
14954
14955    if ($@) {
14956      $ex = $@;
14957    }
14958
14959    $wfh->print("done\n");
14960    $wfh->flush();
14961
14962  } else {
14963    eval { server_wait($config_file, $rfh) };
14964    if ($@) {
14965      warn($@);
14966      exit 1;
14967    }
14968
14969    exit 0;
14970  }
14971
14972  # Stop server
14973  server_stop($pid_file);
14974
14975  $self->assert_child_ok($pid);
14976
14977  if ($ex) {
14978    test_append_logfile($log_file, $ex);
14979    unlink($log_file);
14980
14981    die($ex);
14982  }
14983
14984  unlink($log_file);
14985}
14986
14987sub ssh2_ext_auth_publickey_openssh_rsa_bug4221 {
14988  my $self = shift;
14989  my $tmpdir = $self->{tmpdir};
14990  my $setup = test_setup($tmpdir, 'sftp');
14991
14992  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
14993  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
14994
14995  # To generate these keys, I used:
14996  #
14997  #   $ openssh-7.9p1/bin/ssh-keygen -t rsa -C "RSA OpenSSH key format testing" -f ./test_openssh_rsa_key
14998  #   $ openssh-7.9p1/bin/ssh-keygen -m RFC4716 -e -f ./test_openssh_rsa_key > ./authorized_openssh_rsa_keys
14999
15000  my $openssh_rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_openssh_rsa_key');
15001  my $openssh_rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_openssh_rsa_key.pub');
15002  my $openssh_rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_openssh_rsa_keys');
15003
15004  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
15005  unless (copy($openssh_rsa_rfc4716_key, $authorized_keys)) {
15006    die("Can't copy $openssh_rsa_rfc4716_key to $authorized_keys: $!");
15007  }
15008
15009  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
15010  if (open(my $fh, "> $src_file")) {
15011    print $fh "Hello, World!\n";
15012
15013    unless (close($fh)) {
15014      die("Can't write $src_file: $!");
15015    }
15016
15017  } else {
15018    die("Can't open $src_file: $!");
15019  }
15020
15021  my $src_sz = (stat($src_file))[7];
15022  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
15023
15024  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
15025  if (open(my $fh, "> $batch_file")) {
15026    print $fh "put -P $src_file $dst_file\n";
15027
15028    unless (close($fh)) {
15029      die("Can't write $batch_file: $!");
15030    }
15031
15032  } else {
15033    die("Can't open $batch_file: $!");
15034  }
15035
15036  my $config = {
15037    PidFile => $setup->{pid_file},
15038    ScoreboardFile => $setup->{scoreboard_file},
15039    SystemLog => $setup->{log_file},
15040    TraceLog => $setup->{log_file},
15041    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
15042
15043    AuthUserFile => $setup->{auth_user_file},
15044    AuthGroupFile => $setup->{auth_group_file},
15045
15046    IfModules => {
15047      'mod_delay.c' => {
15048        DelayEngine => 'off',
15049      },
15050
15051      'mod_sftp.c' => [
15052        "SFTPEngine on",
15053        "SFTPLog $setup->{log_file}",
15054        "SFTPHostKey $rsa_host_key",
15055        "SFTPHostKey $dsa_host_key",
15056        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
15057      ],
15058    },
15059  };
15060
15061  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
15062    $config);
15063
15064  # Open pipes, for use between the parent and child processes.  Specifically,
15065  # the child will indicate when it's done with its test by writing a message
15066  # to the parent.
15067  my ($rfh, $wfh);
15068  unless (pipe($rfh, $wfh)) {
15069    die("Can't open pipe: $!");
15070  }
15071
15072  require Net::SSH2;
15073
15074  my $ex;
15075
15076  # Fork child
15077  $self->handle_sigchld();
15078  defined(my $pid = fork()) or die("Can't fork: $!");
15079  if ($pid) {
15080    eval {
15081      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
15082      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
15083
15084      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
15085
15086      my @cmd = (
15087        $sftp,
15088        '-oBatchMode=yes',
15089        '-oCheckHostIP=no',
15090        '-oCompression=yes',
15091        "-oPort=$port",
15092        "-oIdentityFile=$openssh_rsa_priv_key",
15093        '-oPubkeyAuthentication=yes',
15094        '-oStrictHostKeyChecking=no',
15095        '-vvv',
15096        '-b',
15097        $batch_file,
15098        "$setup->{user}\@127.0.0.1",
15099      );
15100
15101      my $sftp_rh = IO::Handle->new();
15102      my $sftp_wh = IO::Handle->new();
15103      my $sftp_eh = IO::Handle->new();
15104
15105      $sftp_wh->autoflush(1);
15106
15107      sleep(1);
15108
15109      local $SIG{CHLD} = 'DEFAULT';
15110
15111      # Make sure that the perms on the priv key are what OpenSSH wants
15112      unless (chmod(0400, $openssh_rsa_priv_key)) {
15113        die("Can't set perms on $openssh_rsa_priv_key to 0400: $!");
15114      }
15115
15116      if ($ENV{TEST_VERBOSE}) {
15117        print STDERR "Executing: ", join(' ', @cmd), "\n";
15118      }
15119
15120      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
15121      waitpid($sftp_pid, 0);
15122      my $exit_status = $?;
15123
15124      # Restore the perms on the priv key
15125      unless (chmod(0644, $openssh_rsa_priv_key)) {
15126        die("Can't set perms on $openssh_rsa_priv_key to 0644: $!");
15127      }
15128
15129      my ($res, $errstr);
15130      if ($exit_status >> 8 == 0) {
15131        $errstr = join('', <$sftp_eh>);
15132        $res = 0;
15133
15134      } else {
15135        $errstr = join('', <$sftp_eh>);
15136        if ($ENV{TEST_VERBOSE}) {
15137          print STDERR "Stderr: $errstr\n";
15138        }
15139
15140        $res = 1;
15141      }
15142
15143      unless ($res == 0) {
15144        die("Can't upload $src_file to server: $errstr");
15145      }
15146
15147      unless (-f $dst_file) {
15148        die("File '$dst_file' does not exist as expected");
15149      }
15150
15151      my $sz = (stat($dst_file))[7];
15152      my $expected_sz = $src_sz;
15153      $self->assert($expected_sz == $sz,
15154        test_msg("Expected file size $expected_sz, got $sz"));
15155    };
15156    if ($@) {
15157      $ex = $@;
15158    }
15159
15160    $wfh->print("done\n");
15161    $wfh->flush();
15162
15163  } else {
15164    eval { server_wait($setup->{config_file}, $rfh) };
15165    if ($@) {
15166      warn($@);
15167      exit 1;
15168    }
15169
15170    exit 0;
15171  }
15172
15173  # Stop server
15174  server_stop($setup->{pid_file});
15175  $self->assert_child_ok($pid);
15176
15177  test_cleanup($setup->{log_file}, $ex);
15178}
15179
15180sub ssh2_ext_auth_publickey_openssh_ed25519_bug4221 {
15181  my $self = shift;
15182  my $tmpdir = $self->{tmpdir};
15183  my $setup = test_setup($tmpdir, 'sftp');
15184
15185  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
15186  my $ecdsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_ecdsa256_key');
15187
15188  # To generate these keys, I used:
15189  #
15190  #   $ openssh-7.9p1/bin/ssh-keygen -t ed25519 -C "ED25519 OpenSSH key format testing" -f ./test_openssh_ed25519_key
15191  #   $ openssh-7.9p1/bin/ssh-keygen -m RFC4716 -e -f ./test_openssh_ed25519_key > ./authorized_openssh_ed25519_keys
15192
15193  my $openssh_ed25519_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_openssh_ed25519_key');
15194  my $openssh_ed25519_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_openssh_ed25519_key.pub');
15195  my $openssh_ed25519_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_openssh_ed25519_keys');
15196
15197  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
15198  unless (copy($openssh_ed25519_rfc4716_key, $authorized_keys)) {
15199    die("Can't copy $openssh_ed25519_rfc4716_key to $authorized_keys: $!");
15200  }
15201
15202  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
15203  if (open(my $fh, "> $src_file")) {
15204    print $fh "Hello, World!\n";
15205
15206    unless (close($fh)) {
15207      die("Can't write $src_file: $!");
15208    }
15209
15210  } else {
15211    die("Can't open $src_file: $!");
15212  }
15213
15214  my $src_sz = (stat($src_file))[7];
15215  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
15216
15217  my $ssh_config = File::Spec->rel2abs("$tmpdir/ssh.conf");
15218  if (open(my $fh, "> $ssh_config")) {
15219    print $fh <<EOC;
15220PubkeyAcceptedKeyTypes ssh-ed25519
15221EOC
15222    unless (close($fh)) {
15223      die("Can't write $ssh_config: $!");
15224    }
15225
15226  } else {
15227    die("Can't open $ssh_config: $!");
15228  }
15229
15230  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.conf");
15231  if (open(my $fh, "> $batch_file")) {
15232    print $fh "put -P $src_file $dst_file\n";
15233
15234    unless (close($fh)) {
15235      die("Can't write $batch_file: $!");
15236    }
15237
15238  } else {
15239    die("Can't open $batch_file: $!");
15240  }
15241
15242  my $config = {
15243    PidFile => $setup->{pid_file},
15244    ScoreboardFile => $setup->{scoreboard_file},
15245    SystemLog => $setup->{log_file},
15246    TraceLog => $setup->{log_file},
15247    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
15248
15249    AuthUserFile => $setup->{auth_user_file},
15250    AuthGroupFile => $setup->{auth_group_file},
15251
15252    IfModules => {
15253      'mod_delay.c' => {
15254        DelayEngine => 'off',
15255      },
15256
15257      'mod_sftp.c' => [
15258        "SFTPEngine on",
15259        "SFTPLog $setup->{log_file}",
15260        "SFTPHostKey $rsa_host_key",
15261        "SFTPHostKey $ecdsa_host_key",
15262        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
15263      ],
15264    },
15265  };
15266
15267  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
15268    $config);
15269
15270  # Open pipes, for use between the parent and child processes.  Specifically,
15271  # the child will indicate when it's done with its test by writing a message
15272  # to the parent.
15273  my ($rfh, $wfh);
15274  unless (pipe($rfh, $wfh)) {
15275    die("Can't open pipe: $!");
15276  }
15277
15278  require Net::SSH2;
15279
15280  my $ex;
15281
15282  # Fork child
15283  $self->handle_sigchld();
15284  defined(my $pid = fork()) or die("Can't fork: $!");
15285  if ($pid) {
15286    eval {
15287      # libssh2, and thus Net::SSH2, don't support ECC/ECDH yet.  So we
15288      # use the external sftp(1) client (e.g. OpenSSH-5.9p1) to test.
15289
15290      my $sftp = '/Users/tj/local/openssh-7.9p1/bin/sftp';
15291
15292      my @cmd = (
15293        $sftp,
15294        '-F',
15295        $ssh_config,
15296        '-oBatchMode=yes',
15297        '-oCheckHostIP=no',
15298        '-oCompression=yes',
15299        "-oPort=$port",
15300        "-oIdentityFile=$openssh_ed25519_priv_key",
15301        '-oPubkeyAuthentication=yes',
15302        '-oStrictHostKeyChecking=no',
15303        '-vvv',
15304        '-b',
15305        $batch_file,
15306        "$setup->{user}\@127.0.0.1",
15307      );
15308
15309      my $sftp_rh = IO::Handle->new();
15310      my $sftp_wh = IO::Handle->new();
15311      my $sftp_eh = IO::Handle->new();
15312
15313      $sftp_wh->autoflush(1);
15314
15315      sleep(1);
15316
15317      local $SIG{CHLD} = 'DEFAULT';
15318
15319      # Make sure that the perms on the priv key are what OpenSSH wants
15320      unless (chmod(0400, $openssh_ed25519_priv_key)) {
15321        die("Can't set perms on $openssh_ed25519_priv_key to 0400: $!");
15322      }
15323
15324      if ($ENV{TEST_VERBOSE}) {
15325        print STDERR "Executing: ", join(' ', @cmd), "\n";
15326      }
15327
15328      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
15329      waitpid($sftp_pid, 0);
15330      my $exit_status = $?;
15331
15332      # Restore the perms on the priv key
15333      unless (chmod(0644, $openssh_ed25519_priv_key)) {
15334        die("Can't set perms on $openssh_ed25519_priv_key to 0644: $!");
15335      }
15336
15337      my ($res, $errstr);
15338      if ($exit_status >> 8 == 0) {
15339        $errstr = join('', <$sftp_eh>);
15340        $res = 0;
15341
15342      } else {
15343        $errstr = join('', <$sftp_eh>);
15344        if ($ENV{TEST_VERBOSE}) {
15345          print STDERR "Stderr: $errstr\n";
15346        }
15347
15348        $res = 1;
15349      }
15350
15351      unless ($res == 0) {
15352        die("Can't upload $src_file to server: $errstr");
15353      }
15354
15355      unless (-f $dst_file) {
15356        die("File '$dst_file' does not exist as expected");
15357      }
15358
15359      my $sz = (stat($dst_file))[7];
15360      my $expected_sz = $src_sz;
15361      $self->assert($expected_sz == $sz,
15362        test_msg("Expected file size $expected_sz, got $sz"));
15363    };
15364    if ($@) {
15365      $ex = $@;
15366    }
15367
15368    $wfh->print("done\n");
15369    $wfh->flush();
15370
15371  } else {
15372    eval { server_wait($setup->{config_file}, $rfh) };
15373    if ($@) {
15374      warn($@);
15375      exit 1;
15376    }
15377
15378    exit 0;
15379  }
15380
15381  # Stop server
15382  server_stop($setup->{pid_file});
15383  $self->assert_child_ok($pid);
15384
15385  test_cleanup($setup->{log_file}, $ex);
15386}
15387
15388sub ssh2_auth_no_authorized_keys {
15389  my $self = shift;
15390  my $tmpdir = $self->{tmpdir};
15391
15392  my $config_file = "$tmpdir/sftp.conf";
15393  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
15394  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
15395
15396  my $log_file = test_get_logfile();
15397
15398  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
15399  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
15400
15401  my $user = 'proftpd';
15402  my $passwd = 'test';
15403  my $group = 'ftpd';
15404  my $home_dir = File::Spec->rel2abs($tmpdir);
15405  my $uid = 500;
15406  my $gid = 500;
15407
15408  # Make sure that, if we're running as root, that the home directory has
15409  # permissions/privs set for the account we create
15410  if ($< == 0) {
15411    unless (chmod(0755, $home_dir)) {
15412      die("Can't set perms on $home_dir to 0755: $!");
15413    }
15414
15415    unless (chown($uid, $gid, $home_dir)) {
15416      die("Can't set owner of $home_dir to $uid/$gid: $!");
15417    }
15418  }
15419
15420  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
15421    '/bin/bash');
15422  auth_group_write($auth_group_file, $group, $gid, $user);
15423
15424  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
15425  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
15426
15427  my $config = {
15428    PidFile => $pid_file,
15429    ScoreboardFile => $scoreboard_file,
15430    SystemLog => $log_file,
15431    TraceLog => $log_file,
15432    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
15433
15434    AuthUserFile => $auth_user_file,
15435    AuthGroupFile => $auth_group_file,
15436
15437    IfModules => {
15438      'mod_delay.c' => {
15439        DelayEngine => 'off',
15440      },
15441
15442      'mod_sftp.c' => [
15443        "SFTPEngine on",
15444        "SFTPLog $log_file",
15445        "SFTPHostKey $rsa_host_key",
15446        "SFTPHostKey $dsa_host_key",
15447      ],
15448    },
15449  };
15450
15451  my ($port, $config_user, $config_group) = config_write($config_file, $config);
15452
15453  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
15454
15455  # Open pipes, for use between the parent and child processes.  Specifically,
15456  # the child will indicate when it's done with its test by writing a message
15457  # to the parent.
15458  my ($rfh, $wfh);
15459  unless (pipe($rfh, $wfh)) {
15460    die("Can't open pipe: $!");
15461  }
15462
15463  require Net::SSH2;
15464
15465  my $ex;
15466
15467  # Fork child
15468  $self->handle_sigchld();
15469  defined(my $pid = fork()) or die("Can't fork: $!");
15470  if ($pid) {
15471    eval {
15472      my $ssh2 = Net::SSH2->new();
15473
15474      sleep(1);
15475
15476      unless ($ssh2->connect('127.0.0.1', $port)) {
15477        my ($err_code, $err_name, $err_str) = $ssh2->error();
15478        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
15479      }
15480
15481      my $auth_meths = [$ssh2->auth_list($user)];
15482      foreach my $meth (@$auth_meths) {
15483        # With no configured SFTPAuthorizedUserKeys nor SFTPAuthorizedHostKeys,
15484        # we should NOT see 'publickey' or 'hostbased' in the authentication
15485        # method list.
15486        if ($meth eq 'publickey' ||
15487            $meth eq 'hostbased') {
15488          die("Unexpected SSH2 authentication method '$meth' provided");
15489        }
15490
15491        # Unless we have mod_sftp_pam involved, we shouldn't see
15492        # 'keyboard-interactive', either.
15493        if ($have_sftp_pam &&
15494            $meth eq 'keyboard-interactive') {
15495          die("Unexpected SSH2 authentication method '$meth' provided");
15496        }
15497      }
15498
15499      $ssh2->disconnect();
15500    };
15501
15502    if ($@) {
15503      $ex = $@;
15504    }
15505
15506    $wfh->print("done\n");
15507    $wfh->flush();
15508
15509  } else {
15510    eval { server_wait($config_file, $rfh) };
15511    if ($@) {
15512      warn($@);
15513      exit 1;
15514    }
15515
15516    exit 0;
15517  }
15518
15519  # Stop server
15520  server_stop($pid_file);
15521
15522  $self->assert_child_ok($pid);
15523
15524  if ($ex) {
15525    test_append_logfile($log_file, $ex);
15526    unlink($log_file);
15527
15528    die($ex);
15529  }
15530
15531  unlink($log_file);
15532}
15533
15534sub ssh2_auth_password_failed {
15535  my $self = shift;
15536  my $tmpdir = $self->{tmpdir};
15537  my $setup = test_setup($tmpdir, 'sftp');
15538
15539  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
15540  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
15541
15542  my $config = {
15543    PidFile => $setup->{pid_file},
15544    ScoreboardFile => $setup->{scoreboard_file},
15545    SystemLog => $setup->{log_file},
15546    TraceLog => $setup->{log_file},
15547    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
15548
15549    AuthUserFile => $setup->{auth_user_file},
15550    AuthGroupFile => $setup->{auth_group_file},
15551
15552    IfModules => {
15553      'mod_delay.c' => {
15554        DelayEngine => 'off',
15555      },
15556
15557      'mod_sftp.c' => [
15558        "SFTPEngine on",
15559        "SFTPLog $setup->{log_file}",
15560        "SFTPHostKey $rsa_host_key",
15561        "SFTPHostKey $dsa_host_key",
15562        "SFTPAuthMethods password",
15563      ],
15564    },
15565  };
15566
15567  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
15568    $config);
15569
15570  # Open pipes, for use between the parent and child processes.  Specifically,
15571  # the child will indicate when it's done with its test by writing a message
15572  # to the parent.
15573  my ($rfh, $wfh);
15574  unless (pipe($rfh, $wfh)) {
15575    die("Can't open pipe: $!");
15576  }
15577
15578  require Net::SSH2;
15579
15580  my $ex;
15581
15582  # Fork child
15583  $self->handle_sigchld();
15584  defined(my $pid = fork()) or die("Can't fork: $!");
15585  if ($pid) {
15586    eval {
15587      my $ssh2 = Net::SSH2->new();
15588
15589      sleep(1);
15590
15591      unless ($ssh2->connect('127.0.0.1', $port)) {
15592        my ($err_code, $err_name, $err_str) = $ssh2->error();
15593        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
15594      }
15595
15596      my $bad_passwd = 'FOOBAR';
15597      for (my $i = 0; $i < 4; $i++) {
15598        if ($ssh2->auth_password($setup->{user}, $bad_passwd)) {
15599          die("Password authentication succeeded unexpectedly");
15600        }
15601      }
15602
15603      $ssh2->disconnect();
15604    };
15605
15606    if ($@) {
15607      $ex = $@;
15608    }
15609
15610    $wfh->print("done\n");
15611    $wfh->flush();
15612
15613  } else {
15614    eval { server_wait($setup->{config_file}, $rfh) };
15615    if ($@) {
15616      warn($@);
15617      exit 1;
15618    }
15619
15620    exit 0;
15621  }
15622
15623  # Stop server
15624  server_stop($setup->{pid_file});
15625  $self->assert_child_ok($pid);
15626
15627  test_cleanup($setup->{log_file}, $ex);
15628}
15629
15630sub ssh2_auth_kbdint_failed_password_ok {
15631  my $self = shift;
15632  my $tmpdir = $self->{tmpdir};
15633
15634  my $config_file = "$tmpdir/sftp.conf";
15635  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
15636  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
15637
15638  my $log_file = test_get_logfile();
15639
15640  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
15641  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
15642
15643  my $user = 'proftpd';
15644  my $passwd = 'test';
15645  my $group = 'ftpd';
15646  my $home_dir = File::Spec->rel2abs($tmpdir);
15647  my $uid = 500;
15648  my $gid = 500;
15649
15650  # Make sure that, if we're running as root, that the home directory has
15651  # permissions/privs set for the account we create
15652  if ($< == 0) {
15653    unless (chmod(0755, $home_dir)) {
15654      die("Can't set perms on $home_dir to 0755: $!");
15655    }
15656
15657    unless (chown($uid, $gid, $home_dir)) {
15658      die("Can't set owner of $home_dir to $uid/$gid: $!");
15659    }
15660  }
15661
15662  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
15663    '/bin/bash');
15664  auth_group_write($auth_group_file, $group, $gid, $user);
15665
15666  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
15667  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
15668
15669  my $auth_meths = "publickey keyboard-interactive password";
15670
15671  my $config = {
15672    PidFile => $pid_file,
15673    ScoreboardFile => $scoreboard_file,
15674    SystemLog => $log_file,
15675    TraceLog => $log_file,
15676    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
15677
15678    AuthUserFile => $auth_user_file,
15679    AuthGroupFile => $auth_group_file,
15680
15681    IfModules => {
15682      'mod_delay.c' => {
15683        DelayEngine => 'off',
15684      },
15685
15686      'mod_sftp.c' => [
15687        "SFTPEngine on",
15688        "SFTPLog $log_file",
15689        "SFTPHostKey $rsa_host_key",
15690        "SFTPHostKey $dsa_host_key",
15691
15692        # We want to specifically configure the list of offered auth methods,
15693        # such that 'keyboard-interactive' is in the middle of the list.
15694        # This bug occurred because mod_sftp was not properly splicing
15695        # out of the middle of the auth method list.
15696        "SFTPAuthMethods $auth_meths",
15697      ],
15698    },
15699  };
15700
15701  my ($port, $config_user, $config_group) = config_write($config_file, $config);
15702
15703  # Open pipes, for use between the parent and child processes.  Specifically,
15704  # the child will indicate when it's done with its test by writing a message
15705  # to the parent.
15706  my ($rfh, $wfh);
15707  unless (pipe($rfh, $wfh)) {
15708    die("Can't open pipe: $!");
15709  }
15710
15711  require Net::SSH2;
15712
15713  my $ex;
15714
15715  # Fork child
15716  $self->handle_sigchld();
15717  defined(my $pid = fork()) or die("Can't fork: $!");
15718  if ($pid) {
15719    eval {
15720      my $ssh2 = Net::SSH2->new();
15721
15722      sleep(1);
15723
15724      unless ($ssh2->connect('127.0.0.1', $port)) {
15725        my ($err_code, $err_name, $err_str) = $ssh2->error();
15726        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
15727      }
15728
15729      if ($ssh2->auth_keyboard($user, $passwd)) {
15730        die("Keyboard-interactive authentication succeeded unexpectedly");
15731      }
15732
15733      # Try to use 'keyboard-interactive' again, just to make sure that
15734      # it has been properly disabled.
15735      if ($ssh2->auth_keyboard($user, $passwd)) {
15736        die("Keyboard-interactive authentication succeeded unexpectedly");
15737      }
15738
15739      # XXX Ideally I could use $ssh2->error() to differentiate the
15740      # error codes/reasons between the two failures above, but it looks like
15741      # there is a bug in Net::SSH2 which precludes this.  So, for now,
15742      # I'll rely on the TraceLog output from mod_sftp.
15743
15744      # XXX This causes a segfault on Mac OSX 10.5; not sure whether it's
15745      # in Net::SSH2's XS bindings or in libssh2 itself.
15746=pod
15747      # Get the offered auth method list and make sure that
15748      # 'keyboard-interactive' has been properly removed.
15749      my $auth_list = $ssh2->auth_list($user);
15750
15751      my $expected = "publickey,password";
15752      $self->assert($expected eq $auth_list,
15753        test_msg("Expected '$expected', got '$auth_list'"));
15754=cut
15755
15756      unless ($ssh2->auth_password($user, $passwd)) {
15757        my ($err_code, $err_name, $err_str) = $ssh2->error();
15758        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
15759      }
15760
15761      $ssh2->disconnect();
15762    };
15763
15764    if ($@) {
15765      $ex = $@;
15766    }
15767
15768    $wfh->print("done\n");
15769    $wfh->flush();
15770
15771  } else {
15772    eval { server_wait($config_file, $rfh) };
15773    if ($@) {
15774      warn($@);
15775      exit 1;
15776    }
15777
15778    exit 0;
15779  }
15780
15781  # Stop server
15782  server_stop($pid_file);
15783
15784  $self->assert_child_ok($pid);
15785
15786  if ($ex) {
15787    test_append_logfile($log_file, $ex);
15788    unlink($log_file);
15789
15790    die($ex);
15791  }
15792
15793  unlink($log_file);
15794}
15795
15796sub ssh2_auth_twice {
15797  my $self = shift;
15798  my $tmpdir = $self->{tmpdir};
15799
15800  my $config_file = "$tmpdir/sftp.conf";
15801  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
15802  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
15803
15804  my $log_file = test_get_logfile();
15805
15806  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
15807  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
15808
15809  my $user = 'proftpd';
15810  my $passwd = 'test';
15811  my $group = 'ftpd';
15812  my $home_dir = File::Spec->rel2abs($tmpdir);
15813  my $uid = 500;
15814  my $gid = 500;
15815
15816  # Make sure that, if we're running as root, that the home directory has
15817  # permissions/privs set for the account we create
15818  if ($< == 0) {
15819    unless (chmod(0755, $home_dir)) {
15820      die("Can't set perms on $home_dir to 0755: $!");
15821    }
15822
15823    unless (chown($uid, $gid, $home_dir)) {
15824      die("Can't set owner of $home_dir to $uid/$gid: $!");
15825    }
15826  }
15827
15828  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
15829    '/bin/bash');
15830  auth_group_write($auth_group_file, $group, $gid, $user);
15831
15832  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
15833  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
15834
15835  my $config = {
15836    PidFile => $pid_file,
15837    ScoreboardFile => $scoreboard_file,
15838    SystemLog => $log_file,
15839    TraceLog => $log_file,
15840    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
15841
15842    AuthUserFile => $auth_user_file,
15843    AuthGroupFile => $auth_group_file,
15844
15845    IfModules => {
15846      'mod_delay.c' => {
15847        DelayEngine => 'off',
15848      },
15849
15850      'mod_sftp.c' => [
15851        "SFTPEngine on",
15852        "SFTPLog $log_file",
15853        "SFTPHostKey $rsa_host_key",
15854        "SFTPHostKey $dsa_host_key",
15855      ],
15856    },
15857  };
15858
15859  my ($port, $config_user, $config_group) = config_write($config_file, $config);
15860
15861  my $config_size = (stat($config_file))[7];
15862
15863  # Open pipes, for use between the parent and child processes.  Specifically,
15864  # the child will indicate when it's done with its test by writing a message
15865  # to the parent.
15866  my ($rfh, $wfh);
15867  unless (pipe($rfh, $wfh)) {
15868    die("Can't open pipe: $!");
15869  }
15870
15871  require Net::SSH2;
15872
15873  my $ex;
15874
15875  # Fork child
15876  $self->handle_sigchld();
15877  defined(my $pid = fork()) or die("Can't fork: $!");
15878  if ($pid) {
15879    eval {
15880      my $ssh2 = Net::SSH2->new();
15881
15882      sleep(1);
15883
15884      unless ($ssh2->connect('127.0.0.1', $port)) {
15885        my ($err_code, $err_name, $err_str) = $ssh2->error();
15886        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
15887      }
15888
15889      unless ($ssh2->auth_password($user, $passwd)) {
15890        my ($err_code, $err_name, $err_str) = $ssh2->error();
15891        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
15892      }
15893
15894      # Since mod_sftp should be ignoring this additional USERAUTH_REQUEST,
15895      # we need to time out the libssh2 request before the testcase times out.
15896
15897      my $auth_timed_out = 0;
15898
15899      eval {
15900        local %SIG;
15901        $SIG{ALRM} = sub { $auth_timed_out = 1; };
15902
15903        alarm(2);
15904        if ($ssh2->auth_password($user, $passwd)) {
15905          alarm(0);
15906          die("Second login succeeded unexpectedly");
15907        }
15908
15909        # Clear the pending alarm
15910        alarm(0);
15911      };
15912
15913      $self->assert($auth_timed_out,
15914        test_msg("Expected timeout out auth request"));
15915
15916      $ssh2->disconnect();
15917    };
15918
15919    if ($@) {
15920      $ex = $@;
15921    }
15922
15923    $wfh->print("done\n");
15924    $wfh->flush();
15925
15926  } else {
15927    eval { server_wait($config_file, $rfh) };
15928    if ($@) {
15929      warn($@);
15930      exit 1;
15931    }
15932
15933    exit 0;
15934  }
15935
15936  # Stop server
15937  server_stop($pid_file);
15938
15939  $self->assert_child_ok($pid);
15940
15941  if ($ex) {
15942    test_append_logfile($log_file, $ex);
15943    unlink($log_file);
15944
15945    die($ex);
15946  }
15947
15948  unlink($log_file);
15949}
15950
15951sub ssh2_auth_publickey_password_chain_bug4153 {
15952  my $self = shift;
15953  my $tmpdir = $self->{tmpdir};
15954
15955  my $config_file = "$tmpdir/sftp.conf";
15956  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
15957  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
15958
15959  my $log_file = test_get_logfile();
15960
15961  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
15962  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
15963
15964  my $user = 'proftpd';
15965  my $passwd = 'test';
15966  my $group = 'ftpd';
15967  my $home_dir = File::Spec->rel2abs($tmpdir);
15968  my $uid = 500;
15969  my $gid = 500;
15970
15971  # Make sure that, if we're running as root, that the home directory has
15972  # permissions/privs set for the account we create
15973  if ($< == 0) {
15974    unless (chmod(0755, $home_dir)) {
15975      die("Can't set perms on $home_dir to 0755: $!");
15976    }
15977
15978    unless (chown($uid, $gid, $home_dir)) {
15979      die("Can't set owner of $home_dir to $uid/$gid: $!");
15980    }
15981  }
15982
15983  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
15984    '/bin/bash');
15985  auth_group_write($auth_group_file, $group, $gid, $user);
15986
15987  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
15988  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
15989
15990  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
15991  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
15992  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
15993
15994  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
15995  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
15996    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
15997  }
15998
15999  my $config = {
16000    PidFile => $pid_file,
16001    ScoreboardFile => $scoreboard_file,
16002    SystemLog => $log_file,
16003    TraceLog => $log_file,
16004    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
16005
16006    AuthUserFile => $auth_user_file,
16007    AuthGroupFile => $auth_group_file,
16008
16009    IfModules => {
16010      'mod_delay.c' => {
16011        DelayEngine => 'off',
16012      },
16013
16014      'mod_sftp.c' => [
16015        "SFTPEngine on",
16016        "SFTPLog $log_file",
16017        "SFTPHostKey $rsa_host_key",
16018        "SFTPHostKey $dsa_host_key",
16019        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
16020        "SFTPAuthMethods publickey+password",
16021      ],
16022    },
16023  };
16024
16025  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16026
16027  # Open pipes, for use between the parent and child processes.  Specifically,
16028  # the child will indicate when it's done with its test by writing a message
16029  # to the parent.
16030  my ($rfh, $wfh);
16031  unless (pipe($rfh, $wfh)) {
16032    die("Can't open pipe: $!");
16033  }
16034
16035  require Net::SSH2;
16036
16037  my $ex;
16038
16039  # Fork child
16040  $self->handle_sigchld();
16041  defined(my $pid = fork()) or die("Can't fork: $!");
16042  if ($pid) {
16043    eval {
16044      my $ssh2 = Net::SSH2->new();
16045
16046      sleep(1);
16047
16048      unless ($ssh2->connect('127.0.0.1', $port)) {
16049        my ($err_code, $err_name, $err_str) = $ssh2->error();
16050        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
16051      }
16052
16053      if ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
16054        die("Login succeeded unexpectedly with just publickey authentication");
16055      }
16056
16057      unless ($ssh2->auth_password($user, $passwd)) {
16058        my ($err_code, $err_name, $err_str) = $ssh2->error();
16059        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
16060      }
16061
16062      my $sftp = $ssh2->sftp();
16063      unless ($sftp) {
16064        my ($err_code, $err_name, $err_str) = $ssh2->error();
16065        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
16066      }
16067
16068      $sftp = undef;
16069      $ssh2->disconnect();
16070    };
16071
16072    if ($@) {
16073      $ex = $@;
16074    }
16075
16076    $wfh->print("done\n");
16077    $wfh->flush();
16078
16079  } else {
16080    eval { server_wait($config_file, $rfh) };
16081    if ($@) {
16082      warn($@);
16083      exit 1;
16084    }
16085
16086    exit 0;
16087  }
16088
16089  # Stop server
16090  server_stop($pid_file);
16091
16092  $self->assert_child_ok($pid);
16093
16094  if ($ex) {
16095    test_append_logfile($log_file, $ex);
16096    unlink($log_file);
16097
16098    die($ex);
16099  }
16100
16101  unlink($log_file);
16102}
16103
16104sub ssh2_auth_publickey_publickey_chain_bug4153 {
16105  my $self = shift;
16106  my $tmpdir = $self->{tmpdir};
16107
16108  my $config_file = "$tmpdir/sftp.conf";
16109  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
16110  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
16111
16112  my $log_file = test_get_logfile();
16113
16114  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
16115  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
16116
16117  my $user = 'proftpd';
16118  my $passwd = 'test';
16119  my $group = 'ftpd';
16120  my $home_dir = File::Spec->rel2abs($tmpdir);
16121  my $uid = 500;
16122  my $gid = 500;
16123
16124  # Make sure that, if we're running as root, that the home directory has
16125  # permissions/privs set for the account we create
16126  if ($< == 0) {
16127    unless (chmod(0755, $home_dir)) {
16128      die("Can't set perms on $home_dir to 0755: $!");
16129    }
16130
16131    unless (chown($uid, $gid, $home_dir)) {
16132      die("Can't set owner of $home_dir to $uid/$gid: $!");
16133    }
16134  }
16135
16136  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
16137    '/bin/bash');
16138  auth_group_write($auth_group_file, $group, $gid, $user);
16139
16140  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
16141  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
16142
16143  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
16144  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
16145  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
16146
16147  my $dsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa_key');
16148  my $dsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_dsa_key.pub');
16149  my $dsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_dsa_keys');
16150
16151  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
16152  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
16153    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
16154  }
16155
16156  unless (concat_files($dsa_rfc4716_key, $authorized_keys)) {
16157    die("Can't append $dsa_rfc4716_key to $authorized_keys");
16158  }
16159
16160  my $config = {
16161    PidFile => $pid_file,
16162    ScoreboardFile => $scoreboard_file,
16163    SystemLog => $log_file,
16164    TraceLog => $log_file,
16165    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
16166
16167    AuthUserFile => $auth_user_file,
16168    AuthGroupFile => $auth_group_file,
16169
16170    IfModules => {
16171      'mod_delay.c' => {
16172        DelayEngine => 'off',
16173      },
16174
16175      'mod_sftp.c' => [
16176        "SFTPEngine on",
16177        "SFTPLog $log_file",
16178        "SFTPHostKey $rsa_host_key",
16179        "SFTPHostKey $dsa_host_key",
16180        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
16181        "SFTPAuthMethods publickey+publickey",
16182      ],
16183    },
16184  };
16185
16186  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16187
16188  # Open pipes, for use between the parent and child processes.  Specifically,
16189  # the child will indicate when it's done with its test by writing a message
16190  # to the parent.
16191  my ($rfh, $wfh);
16192  unless (pipe($rfh, $wfh)) {
16193    die("Can't open pipe: $!");
16194  }
16195
16196  require Net::SSH2;
16197
16198  my $ex;
16199
16200  # Fork child
16201  $self->handle_sigchld();
16202  defined(my $pid = fork()) or die("Can't fork: $!");
16203  if ($pid) {
16204    eval {
16205      my $ssh2 = Net::SSH2->new();
16206
16207      sleep(1);
16208
16209      unless ($ssh2->connect('127.0.0.1', $port)) {
16210        my ($err_code, $err_name, $err_str) = $ssh2->error();
16211        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
16212      }
16213
16214      if ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
16215        die("Login succeeded unexpectedly with just publickey authentication");
16216      }
16217
16218      unless ($ssh2->auth_publickey($user, $dsa_pub_key, $dsa_priv_key)) {
16219        my ($err_code, $err_name, $err_str) = $ssh2->error();
16220        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
16221      }
16222
16223      my $sftp = $ssh2->sftp();
16224      unless ($sftp) {
16225        my ($err_code, $err_name, $err_str) = $ssh2->error();
16226        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
16227      }
16228
16229      $sftp = undef;
16230      $ssh2->disconnect();
16231    };
16232
16233    if ($@) {
16234      $ex = $@;
16235    }
16236
16237    $wfh->print("done\n");
16238    $wfh->flush();
16239
16240  } else {
16241    eval { server_wait($config_file, $rfh) };
16242    if ($@) {
16243      warn($@);
16244      exit 1;
16245    }
16246
16247    exit 0;
16248  }
16249
16250  # Stop server
16251  server_stop($pid_file);
16252
16253  $self->assert_child_ok($pid);
16254
16255  if ($ex) {
16256    test_append_logfile($log_file, $ex);
16257    unlink($log_file);
16258
16259    die($ex);
16260  }
16261
16262  unlink($log_file);
16263}
16264
16265sub ssh2_interop_scanner {
16266  my $self = shift;
16267  my $tmpdir = $self->{tmpdir};
16268
16269  my $config_file = "$tmpdir/sftp.conf";
16270  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
16271  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
16272
16273  my $log_file = test_get_logfile();
16274
16275  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
16276  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
16277
16278  my $user = 'proftpd';
16279  my $passwd = 'test';
16280  my $group = 'ftpd';
16281  my $home_dir = File::Spec->rel2abs($tmpdir);
16282  my $uid = 500;
16283  my $gid = 500;
16284
16285  # Make sure that, if we're running as root, that the home directory has
16286  # permissions/privs set for the account we create
16287  if ($< == 0) {
16288    unless (chmod(0755, $home_dir)) {
16289      die("Can't set perms on $home_dir to 0755: $!");
16290    }
16291
16292    unless (chown($uid, $gid, $home_dir)) {
16293      die("Can't set owner of $home_dir to $uid/$gid: $!");
16294    }
16295  }
16296
16297  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
16298    '/bin/bash');
16299  auth_group_write($auth_group_file, $group, $gid, $user);
16300
16301  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
16302  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
16303
16304  my $banner = "SSH_Version_Mapper";
16305
16306  my $config = {
16307    PidFile => $pid_file,
16308    ScoreboardFile => $scoreboard_file,
16309    SystemLog => $log_file,
16310    TraceLog => $log_file,
16311    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
16312
16313    AuthUserFile => $auth_user_file,
16314    AuthGroupFile => $auth_group_file,
16315
16316    IfModules => {
16317      'mod_delay.c' => {
16318        DelayEngine => 'off',
16319      },
16320
16321      'mod_sftp.c' => [
16322        "SFTPEngine on",
16323        "SFTPLog $log_file",
16324        "SFTPHostKey $rsa_host_key",
16325        "SFTPHostKey $dsa_host_key",
16326      ],
16327    },
16328  };
16329
16330  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16331
16332  # Open pipes, for use between the parent and child processes.  Specifically,
16333  # the child will indicate when it's done with its test by writing a message
16334  # to the parent.
16335  my ($rfh, $wfh);
16336  unless (pipe($rfh, $wfh)) {
16337    die("Can't open pipe: $!");
16338  }
16339
16340  require Net::SSH2;
16341
16342  my $ex;
16343
16344  # Fork child
16345  $self->handle_sigchld();
16346  defined(my $pid = fork()) or die("Can't fork: $!");
16347  if ($pid) {
16348    eval {
16349      my $ssh2 = Net::SSH2->new();
16350      $ssh2->banner($banner);
16351
16352      sleep(1);
16353
16354      if ($ssh2->connect('127.0.0.1', $port)) {
16355        die("Connect to SSH2 server succeeded unexpectedly");
16356      }
16357    };
16358
16359    if ($@) {
16360      $ex = $@;
16361    }
16362
16363    $wfh->print("done\n");
16364    $wfh->flush();
16365
16366  } else {
16367    eval { server_wait($config_file, $rfh) };
16368    if ($@) {
16369      warn($@);
16370      exit 1;
16371    }
16372
16373    exit 0;
16374  }
16375
16376  # Stop server
16377  server_stop($pid_file);
16378
16379  $self->assert_child_ok($pid);
16380
16381  if ($ex) {
16382    test_append_logfile($log_file, $ex);
16383    unlink($log_file);
16384
16385    die($ex);
16386  }
16387
16388  if (open(my $fh, "< $log_file")) {
16389    my $ok = 0;
16390
16391    while (my $line = <$fh>) {
16392      chomp($line);
16393
16394      if ($line =~ /SSH2 scan from '(\S+)',/) {
16395          my $text = $1;
16396
16397          if ($text eq $banner) {
16398            $ok = 1;
16399            last;
16400          }
16401      }
16402    }
16403
16404    close($fh);
16405
16406    unless ($ok) {
16407      die("SFTPLog message about scanner unexpectedly missing");
16408    }
16409
16410  } else {
16411    die("Can't read $log_file: $!");
16412  }
16413
16414
16415  unlink($log_file);
16416}
16417
16418sub ssh2_interop_probe {
16419  my $self = shift;
16420  my $tmpdir = $self->{tmpdir};
16421
16422  my $config_file = "$tmpdir/sftp.conf";
16423  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
16424  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
16425
16426  my $log_file = test_get_logfile();
16427
16428  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
16429  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
16430
16431  my $user = 'proftpd';
16432  my $passwd = 'test';
16433  my $group = 'ftpd';
16434  my $home_dir = File::Spec->rel2abs($tmpdir);
16435  my $uid = 500;
16436  my $gid = 500;
16437
16438  # Make sure that, if we're running as root, that the home directory has
16439  # permissions/privs set for the account we create
16440  if ($< == 0) {
16441    unless (chmod(0755, $home_dir)) {
16442      die("Can't set perms on $home_dir to 0755: $!");
16443    }
16444
16445    unless (chown($uid, $gid, $home_dir)) {
16446      die("Can't set owner of $home_dir to $uid/$gid: $!");
16447    }
16448  }
16449
16450  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
16451    '/bin/bash');
16452  auth_group_write($auth_group_file, $group, $gid, $user);
16453
16454  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
16455  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
16456
16457  my $banner = "Probe-Me";
16458
16459  my $config = {
16460    PidFile => $pid_file,
16461    ScoreboardFile => $scoreboard_file,
16462    SystemLog => $log_file,
16463    TraceLog => $log_file,
16464    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
16465
16466    AuthUserFile => $auth_user_file,
16467    AuthGroupFile => $auth_group_file,
16468
16469    IfModules => {
16470      'mod_delay.c' => {
16471        DelayEngine => 'off',
16472      },
16473
16474      'mod_sftp.c' => [
16475        "SFTPEngine on",
16476        "SFTPLog $log_file",
16477        "SFTPHostKey $rsa_host_key",
16478        "SFTPHostKey $dsa_host_key",
16479      ],
16480    },
16481  };
16482
16483  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16484
16485  # Open pipes, for use between the parent and child processes.  Specifically,
16486  # the child will indicate when it's done with its test by writing a message
16487  # to the parent.
16488  my ($rfh, $wfh);
16489  unless (pipe($rfh, $wfh)) {
16490    die("Can't open pipe: $!");
16491  }
16492
16493  require Net::SSH2;
16494
16495  my $ex;
16496
16497  # Fork child
16498  $self->handle_sigchld();
16499  defined(my $pid = fork()) or die("Can't fork: $!");
16500  if ($pid) {
16501    eval {
16502      my $ssh2 = Net::SSH2->new();
16503      $ssh2->banner($banner);
16504
16505      sleep(1);
16506
16507      if ($ssh2->connect('127.0.0.1', $port)) {
16508        die("Connect to SSH2 server succeeded unexpectedly");
16509      }
16510    };
16511
16512    if ($@) {
16513      $ex = $@;
16514    }
16515
16516    $wfh->print("done\n");
16517    $wfh->flush();
16518
16519  } else {
16520    eval { server_wait($config_file, $rfh) };
16521    if ($@) {
16522      warn($@);
16523      exit 1;
16524    }
16525
16526    exit 0;
16527  }
16528
16529  # Stop server
16530  server_stop($pid_file);
16531
16532  $self->assert_child_ok($pid);
16533
16534  if ($ex) {
16535    test_append_logfile($log_file, $ex);
16536    unlink($log_file);
16537
16538    die($ex);
16539  }
16540
16541  if (open(my $fh, "< $log_file")) {
16542    my $ok = 0;
16543
16544    while (my $line = <$fh>) {
16545      chomp($line);
16546
16547      if ($line =~ /SSH2 probe from '(\S+)',/) {
16548          my $text = $1;
16549
16550          if ($text eq $banner) {
16551            $ok = 1;
16552            last;
16553          }
16554      }
16555    }
16556
16557    close($fh);
16558
16559    unless ($ok) {
16560      die("SFTPLog message about scanner unexpectedly missing");
16561    }
16562
16563  } else {
16564    die("Can't read $log_file: $!");
16565  }
16566
16567
16568  unlink($log_file);
16569}
16570
16571sub ssh2_channel_failed_ptyreq {
16572  my $self = shift;
16573  my $tmpdir = $self->{tmpdir};
16574
16575  my $config_file = "$tmpdir/sftp.conf";
16576  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
16577  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
16578
16579  my $log_file = test_get_logfile();
16580
16581  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
16582  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
16583
16584  my $user = 'proftpd';
16585  my $passwd = 'test';
16586  my $group = 'ftpd';
16587  my $home_dir = File::Spec->rel2abs($tmpdir);
16588  my $uid = 500;
16589  my $gid = 500;
16590
16591  # Make sure that, if we're running as root, that the home directory has
16592  # permissions/privs set for the account we create
16593  if ($< == 0) {
16594    unless (chmod(0755, $home_dir)) {
16595      die("Can't set perms on $home_dir to 0755: $!");
16596    }
16597
16598    unless (chown($uid, $gid, $home_dir)) {
16599      die("Can't set owner of $home_dir to $uid/$gid: $!");
16600    }
16601  }
16602
16603  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
16604    '/bin/bash');
16605  auth_group_write($auth_group_file, $group, $gid, $user);
16606
16607  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
16608  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
16609
16610  my $config = {
16611    PidFile => $pid_file,
16612    ScoreboardFile => $scoreboard_file,
16613    SystemLog => $log_file,
16614    TraceLog => $log_file,
16615    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
16616
16617    AuthUserFile => $auth_user_file,
16618    AuthGroupFile => $auth_group_file,
16619
16620    IfModules => {
16621      'mod_delay.c' => {
16622        DelayEngine => 'off',
16623      },
16624
16625      'mod_sftp.c' => [
16626        "SFTPEngine on",
16627        "SFTPLog $log_file",
16628        "SFTPHostKey $rsa_host_key",
16629        "SFTPHostKey $dsa_host_key",
16630      ],
16631    },
16632  };
16633
16634  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16635
16636  # Open pipes, for use between the parent and child processes.  Specifically,
16637  # the child will indicate when it's done with its test by writing a message
16638  # to the parent.
16639  my ($rfh, $wfh);
16640  unless (pipe($rfh, $wfh)) {
16641    die("Can't open pipe: $!");
16642  }
16643
16644  require Net::SSH2;
16645
16646  my $ex;
16647
16648  # Fork child
16649  $self->handle_sigchld();
16650  defined(my $pid = fork()) or die("Can't fork: $!");
16651  if ($pid) {
16652    eval {
16653      my $ssh2 = Net::SSH2->new();
16654
16655      sleep(1);
16656
16657      unless ($ssh2->connect('127.0.0.1', $port)) {
16658        my ($err_code, $err_name, $err_str) = $ssh2->error();
16659        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
16660      }
16661
16662      unless ($ssh2->auth_password($user, $passwd)) {
16663        my ($err_code, $err_name, $err_str) = $ssh2->error();
16664        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
16665      }
16666
16667      my $chan = $ssh2->channel('session');
16668      unless ($chan) {
16669        my ($err_code, $err_name, $err_str) = $ssh2->error();
16670        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
16671      }
16672
16673      if ($chan->pty('vt100')) {
16674        die("'pty-req' session channel request succeeded unexpectedly");
16675      }
16676
16677      $chan->eof();
16678      $chan->close();
16679      $ssh2->disconnect();
16680    };
16681
16682    if ($@) {
16683      $ex = $@;
16684    }
16685
16686    $wfh->print("done\n");
16687    $wfh->flush();
16688
16689  } else {
16690    eval { server_wait($config_file, $rfh) };
16691    if ($@) {
16692      warn($@);
16693      exit 1;
16694    }
16695
16696    exit 0;
16697  }
16698
16699  # Stop server
16700  server_stop($pid_file);
16701
16702  $self->assert_child_ok($pid);
16703
16704  if ($ex) {
16705    test_append_logfile($log_file, $ex);
16706    unlink($log_file);
16707
16708    die($ex);
16709  }
16710
16711  unlink($log_file);
16712}
16713
16714sub ssh2_channel_failed_shell {
16715  my $self = shift;
16716  my $tmpdir = $self->{tmpdir};
16717
16718  my $config_file = "$tmpdir/sftp.conf";
16719  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
16720  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
16721
16722  my $log_file = test_get_logfile();
16723
16724  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
16725  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
16726
16727  my $user = 'proftpd';
16728  my $passwd = 'test';
16729  my $group = 'ftpd';
16730  my $home_dir = File::Spec->rel2abs($tmpdir);
16731  my $uid = 500;
16732  my $gid = 500;
16733
16734  # Make sure that, if we're running as root, that the home directory has
16735  # permissions/privs set for the account we create
16736  if ($< == 0) {
16737    unless (chmod(0755, $home_dir)) {
16738      die("Can't set perms on $home_dir to 0755: $!");
16739    }
16740
16741    unless (chown($uid, $gid, $home_dir)) {
16742      die("Can't set owner of $home_dir to $uid/$gid: $!");
16743    }
16744  }
16745
16746  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
16747    '/bin/bash');
16748  auth_group_write($auth_group_file, $group, $gid, $user);
16749
16750  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
16751  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
16752
16753  my $config = {
16754    PidFile => $pid_file,
16755    ScoreboardFile => $scoreboard_file,
16756    SystemLog => $log_file,
16757    TraceLog => $log_file,
16758    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
16759
16760    AuthUserFile => $auth_user_file,
16761    AuthGroupFile => $auth_group_file,
16762
16763    IfModules => {
16764      'mod_delay.c' => {
16765        DelayEngine => 'off',
16766      },
16767
16768      'mod_sftp.c' => [
16769        "SFTPEngine on",
16770        "SFTPLog $log_file",
16771        "SFTPHostKey $rsa_host_key",
16772        "SFTPHostKey $dsa_host_key",
16773      ],
16774    },
16775  };
16776
16777  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16778
16779  # Open pipes, for use between the parent and child processes.  Specifically,
16780  # the child will indicate when it's done with its test by writing a message
16781  # to the parent.
16782  my ($rfh, $wfh);
16783  unless (pipe($rfh, $wfh)) {
16784    die("Can't open pipe: $!");
16785  }
16786
16787  require Net::SSH2;
16788
16789  my $ex;
16790
16791  # Fork child
16792  $self->handle_sigchld();
16793  defined(my $pid = fork()) or die("Can't fork: $!");
16794  if ($pid) {
16795    eval {
16796      my $ssh2 = Net::SSH2->new();
16797
16798      sleep(1);
16799
16800      unless ($ssh2->connect('127.0.0.1', $port)) {
16801        my ($err_code, $err_name, $err_str) = $ssh2->error();
16802        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
16803      }
16804
16805      unless ($ssh2->auth_password($user, $passwd)) {
16806        my ($err_code, $err_name, $err_str) = $ssh2->error();
16807        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
16808      }
16809
16810      my $chan = $ssh2->channel('session');
16811      unless ($chan) {
16812        my ($err_code, $err_name, $err_str) = $ssh2->error();
16813        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
16814      }
16815
16816      if ($chan->shell()) {
16817        die("'shell' session channel request succeeded unexpectedly");
16818      }
16819
16820      $chan->eof();
16821      $chan->close();
16822      $ssh2->disconnect();
16823    };
16824
16825    if ($@) {
16826      $ex = $@;
16827    }
16828
16829    $wfh->print("done\n");
16830    $wfh->flush();
16831
16832  } else {
16833    eval { server_wait($config_file, $rfh) };
16834    if ($@) {
16835      warn($@);
16836      exit 1;
16837    }
16838
16839    exit 0;
16840  }
16841
16842  # Stop server
16843  server_stop($pid_file);
16844
16845  $self->assert_child_ok($pid);
16846
16847  if ($ex) {
16848    test_append_logfile($log_file, $ex);
16849    unlink($log_file);
16850
16851    die($ex);
16852  }
16853
16854  unlink($log_file);
16855}
16856
16857sub ssh2_channel_failed_exec_cmd {
16858  my $self = shift;
16859  my $tmpdir = $self->{tmpdir};
16860
16861  my $config_file = "$tmpdir/sftp.conf";
16862  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
16863  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
16864
16865  my $log_file = test_get_logfile();
16866
16867  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
16868  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
16869
16870  my $user = 'proftpd';
16871  my $passwd = 'test';
16872  my $group = 'ftpd';
16873  my $home_dir = File::Spec->rel2abs($tmpdir);
16874  my $uid = 500;
16875  my $gid = 500;
16876
16877  # Make sure that, if we're running as root, that the home directory has
16878  # permissions/privs set for the account we create
16879  if ($< == 0) {
16880    unless (chmod(0755, $home_dir)) {
16881      die("Can't set perms on $home_dir to 0755: $!");
16882    }
16883
16884    unless (chown($uid, $gid, $home_dir)) {
16885      die("Can't set owner of $home_dir to $uid/$gid: $!");
16886    }
16887  }
16888
16889  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
16890    '/bin/bash');
16891  auth_group_write($auth_group_file, $group, $gid, $user);
16892
16893  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
16894  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
16895
16896  my $config = {
16897    PidFile => $pid_file,
16898    ScoreboardFile => $scoreboard_file,
16899    SystemLog => $log_file,
16900    TraceLog => $log_file,
16901    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
16902
16903    AuthUserFile => $auth_user_file,
16904    AuthGroupFile => $auth_group_file,
16905
16906    IfModules => {
16907      'mod_delay.c' => {
16908        DelayEngine => 'off',
16909      },
16910
16911      'mod_sftp.c' => [
16912        "SFTPEngine on",
16913        "SFTPLog $log_file",
16914        "SFTPHostKey $rsa_host_key",
16915        "SFTPHostKey $dsa_host_key",
16916      ],
16917    },
16918  };
16919
16920  my ($port, $config_user, $config_group) = config_write($config_file, $config);
16921
16922  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
16923
16924  # Open pipes, for use between the parent and child processes.  Specifically,
16925  # the child will indicate when it's done with its test by writing a message
16926  # to the parent.
16927  my ($rfh, $wfh);
16928  unless (pipe($rfh, $wfh)) {
16929    die("Can't open pipe: $!");
16930  }
16931
16932  require Net::SSH2;
16933
16934  my $ex;
16935
16936  # Fork child
16937  $self->handle_sigchld();
16938  defined(my $pid = fork()) or die("Can't fork: $!");
16939  if ($pid) {
16940    eval {
16941      my $ssh2 = Net::SSH2->new();
16942
16943      sleep(1);
16944
16945      unless ($ssh2->connect('127.0.0.1', $port)) {
16946        my ($err_code, $err_name, $err_str) = $ssh2->error();
16947        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
16948      }
16949
16950      unless ($ssh2->auth_password($user, $passwd)) {
16951        my ($err_code, $err_name, $err_str) = $ssh2->error();
16952        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
16953      }
16954
16955      my $chan = $ssh2->channel('session');
16956      unless ($chan) {
16957        my ($err_code, $err_name, $err_str) = $ssh2->error();
16958        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
16959      }
16960
16961      if ($chan->exec('date')) {
16962        die("'exec' session channel request succeeded unexpectedly");
16963      }
16964
16965      $chan->eof();
16966      $chan->close();
16967      $ssh2->disconnect();
16968    };
16969
16970    if ($@) {
16971      $ex = $@;
16972    }
16973
16974    $wfh->print("done\n");
16975    $wfh->flush();
16976
16977  } else {
16978    eval { server_wait($config_file, $rfh) };
16979    if ($@) {
16980      warn($@);
16981      exit 1;
16982    }
16983
16984    exit 0;
16985  }
16986
16987  # Stop server
16988  server_stop($pid_file);
16989
16990  $self->assert_child_ok($pid);
16991
16992  if ($ex) {
16993    test_append_logfile($log_file, $ex);
16994    unlink($log_file);
16995
16996    die($ex);
16997  }
16998
16999  unlink($log_file);
17000}
17001
17002sub ssh2_channel_env_default {
17003  my $self = shift;
17004  my $tmpdir = $self->{tmpdir};
17005
17006  my $config_file = "$tmpdir/sftp.conf";
17007  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
17008  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
17009
17010  my $log_file = test_get_logfile();
17011
17012  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
17013  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
17014
17015  my $user = 'proftpd';
17016  my $passwd = 'test';
17017  my $group = 'ftpd';
17018  my $home_dir = File::Spec->rel2abs($tmpdir);
17019  my $uid = 500;
17020  my $gid = 500;
17021
17022  # Make sure that, if we're running as root, that the home directory has
17023  # permissions/privs set for the account we create
17024  if ($< == 0) {
17025    unless (chmod(0755, $home_dir)) {
17026      die("Can't set perms on $home_dir to 0755: $!");
17027    }
17028
17029    unless (chown($uid, $gid, $home_dir)) {
17030      die("Can't set owner of $home_dir to $uid/$gid: $!");
17031    }
17032  }
17033
17034  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
17035    '/bin/bash');
17036  auth_group_write($auth_group_file, $group, $gid, $user);
17037
17038  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17039  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17040
17041  my $config = {
17042    PidFile => $pid_file,
17043    ScoreboardFile => $scoreboard_file,
17044    SystemLog => $log_file,
17045    TraceLog => $log_file,
17046    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17047
17048    AuthUserFile => $auth_user_file,
17049    AuthGroupFile => $auth_group_file,
17050
17051    IfModules => {
17052      'mod_delay.c' => {
17053        DelayEngine => 'off',
17054      },
17055
17056      'mod_sftp.c' => [
17057        "SFTPEngine on",
17058        "SFTPLog $log_file",
17059        "SFTPHostKey $rsa_host_key",
17060        "SFTPHostKey $dsa_host_key",
17061      ],
17062    },
17063  };
17064
17065  my ($port, $config_user, $config_group) = config_write($config_file, $config);
17066
17067  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
17068
17069  # Open pipes, for use between the parent and child processes.  Specifically,
17070  # the child will indicate when it's done with its test by writing a message
17071  # to the parent.
17072  my ($rfh, $wfh);
17073  unless (pipe($rfh, $wfh)) {
17074    die("Can't open pipe: $!");
17075  }
17076
17077  require Net::SSH2;
17078
17079  my $ex;
17080
17081  # Fork child
17082  $self->handle_sigchld();
17083  defined(my $pid = fork()) or die("Can't fork: $!");
17084  if ($pid) {
17085    eval {
17086      my $ssh2 = Net::SSH2->new();
17087
17088      sleep(1);
17089
17090      unless ($ssh2->connect('127.0.0.1', $port)) {
17091        my ($err_code, $err_name, $err_str) = $ssh2->error();
17092        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17093      }
17094
17095      unless ($ssh2->auth_password($user, $passwd)) {
17096        my ($err_code, $err_name, $err_str) = $ssh2->error();
17097        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
17098      }
17099
17100      my $chan = $ssh2->channel('session');
17101      unless ($chan) {
17102        my ($err_code, $err_name, $err_str) = $ssh2->error();
17103        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
17104      }
17105
17106      my $barred = [qw(
17107        SFTP
17108        SFTP_LIBRARY_VERSION
17109        SFTP_CLIENT_CIPHER_ALGO
17110        SFTP_CLIENT_MAC_ALGO
17111        SFTP_CLIENT_COMPRESSION_ALGO
17112        SFTP_KEX_ALGO
17113        SFTP_SERVER_CIPHER_ALGO
17114        SFTP_SERVER_MAC_ALGO
17115        SFTP_SERVER_COMPRESSION_ALGO
17116      )];
17117
17118      foreach my $key (@$barred) {
17119        if ($chan->setenv($key, "1")) {
17120          die("Setting environment variable '$key' via 'env' channel succeeded unexpectedly");
17121        }
17122      }
17123
17124      unless ($chan->setenv('LANG', 'FOO')) {
17125        my ($err_code, $err_name, $err_str) = $ssh2->error();
17126        die("Setting environment variable 'LANG' failed: [$err_name] ($err_code) $err_str");
17127      }
17128
17129      $chan->eof();
17130      $chan->close();
17131      $ssh2->disconnect();
17132    };
17133
17134    if ($@) {
17135      $ex = $@;
17136    }
17137
17138    $wfh->print("done\n");
17139    $wfh->flush();
17140
17141  } else {
17142    eval { server_wait($config_file, $rfh) };
17143    if ($@) {
17144      warn($@);
17145      exit 1;
17146    }
17147
17148    exit 0;
17149  }
17150
17151  # Stop server
17152  server_stop($pid_file);
17153
17154  $self->assert_child_ok($pid);
17155
17156  if ($ex) {
17157    test_append_logfile($log_file, $ex);
17158    unlink($log_file);
17159
17160    die($ex);
17161  }
17162
17163  unlink($log_file);
17164}
17165
17166sub ssh2_channel_env_accept_glob_char {
17167  my $self = shift;
17168  my $tmpdir = $self->{tmpdir};
17169
17170  my $config_file = "$tmpdir/sftp.conf";
17171  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
17172  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
17173
17174  my $log_file = test_get_logfile();
17175
17176  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
17177  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
17178
17179  my $user = 'proftpd';
17180  my $passwd = 'test';
17181  my $group = 'ftpd';
17182  my $home_dir = File::Spec->rel2abs($tmpdir);
17183  my $uid = 500;
17184  my $gid = 500;
17185
17186  # Make sure that, if we're running as root, that the home directory has
17187  # permissions/privs set for the account we create
17188  if ($< == 0) {
17189    unless (chmod(0755, $home_dir)) {
17190      die("Can't set perms on $home_dir to 0755: $!");
17191    }
17192
17193    unless (chown($uid, $gid, $home_dir)) {
17194      die("Can't set owner of $home_dir to $uid/$gid: $!");
17195    }
17196  }
17197
17198  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
17199    '/bin/bash');
17200  auth_group_write($auth_group_file, $group, $gid, $user);
17201
17202  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17203  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17204
17205  my $config = {
17206    PidFile => $pid_file,
17207    ScoreboardFile => $scoreboard_file,
17208    SystemLog => $log_file,
17209    TraceLog => $log_file,
17210    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17211
17212    AuthUserFile => $auth_user_file,
17213    AuthGroupFile => $auth_group_file,
17214
17215    IfModules => {
17216      'mod_delay.c' => {
17217        DelayEngine => 'off',
17218      },
17219
17220      'mod_sftp.c' => [
17221        'SFTPAcceptEnv L*',
17222        "SFTPEngine on",
17223        "SFTPLog $log_file",
17224        "SFTPHostKey $rsa_host_key",
17225        "SFTPHostKey $dsa_host_key",
17226      ],
17227    },
17228  };
17229
17230  my ($port, $config_user, $config_group) = config_write($config_file, $config);
17231
17232  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
17233
17234  # Open pipes, for use between the parent and child processes.  Specifically,
17235  # the child will indicate when it's done with its test by writing a message
17236  # to the parent.
17237  my ($rfh, $wfh);
17238  unless (pipe($rfh, $wfh)) {
17239    die("Can't open pipe: $!");
17240  }
17241
17242  require Net::SSH2;
17243
17244  my $ex;
17245
17246  # Fork child
17247  $self->handle_sigchld();
17248  defined(my $pid = fork()) or die("Can't fork: $!");
17249  if ($pid) {
17250    eval {
17251      my $ssh2 = Net::SSH2->new();
17252
17253      sleep(1);
17254
17255      unless ($ssh2->connect('127.0.0.1', $port)) {
17256        my ($err_code, $err_name, $err_str) = $ssh2->error();
17257        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17258      }
17259
17260      unless ($ssh2->auth_password($user, $passwd)) {
17261        my ($err_code, $err_name, $err_str) = $ssh2->error();
17262        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
17263      }
17264
17265      my $chan = $ssh2->channel('session');
17266      unless ($chan) {
17267        my ($err_code, $err_name, $err_str) = $ssh2->error();
17268        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
17269      }
17270
17271      my $barred = [qw(
17272        SFTP
17273        SFTP_LIBRARY_VERSION
17274        SFTP_CLIENT_CIPHER_ALGO
17275        SFTP_CLIENT_MAC_ALGO
17276        SFTP_CLIENT_COMPRESSION_ALGO
17277        SFTP_KEX_ALGO
17278        SFTP_SERVER_CIPHER_ALGO
17279        SFTP_SERVER_MAC_ALGO
17280        SFTP_SERVER_COMPRESSION_ALGO
17281      )];
17282
17283      foreach my $key (@$barred) {
17284        if ($chan->setenv($key, "1")) {
17285          die("Setting environment variable '$key' via 'env' channel succeeded unexpectedly");
17286        }
17287      }
17288
17289      unless ($chan->setenv('LANG', 'FOO')) {
17290        my ($err_code, $err_name, $err_str) = $ssh2->error();
17291        die("Setting environment variable 'LANG' failed: [$err_name] ($err_code) $err_str");
17292      }
17293
17294      unless ($chan->setenv('LOG', 'FOO')) {
17295        my ($err_code, $err_name, $err_str) = $ssh2->error();
17296        die("Setting environment variable 'LOG' failed: [$err_name] ($err_code) $err_str");
17297      }
17298
17299      $chan->eof();
17300      $chan->close();
17301      $ssh2->disconnect();
17302    };
17303
17304    if ($@) {
17305      $ex = $@;
17306    }
17307
17308    $wfh->print("done\n");
17309    $wfh->flush();
17310
17311  } else {
17312    eval { server_wait($config_file, $rfh) };
17313    if ($@) {
17314      warn($@);
17315      exit 1;
17316    }
17317
17318    exit 0;
17319  }
17320
17321  # Stop server
17322  server_stop($pid_file);
17323
17324  $self->assert_child_ok($pid);
17325
17326  if ($ex) {
17327    test_append_logfile($log_file, $ex);
17328    unlink($log_file);
17329
17330    die($ex);
17331  }
17332
17333  unlink($log_file);
17334}
17335
17336sub ssh2_channel_env_accept_single_char {
17337  my $self = shift;
17338  my $tmpdir = $self->{tmpdir};
17339
17340  my $config_file = "$tmpdir/sftp.conf";
17341  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
17342  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
17343
17344  my $log_file = test_get_logfile();
17345
17346  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
17347  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
17348
17349  my $user = 'proftpd';
17350  my $passwd = 'test';
17351  my $group = 'ftpd';
17352  my $home_dir = File::Spec->rel2abs($tmpdir);
17353  my $uid = 500;
17354  my $gid = 500;
17355
17356  # Make sure that, if we're running as root, that the home directory has
17357  # permissions/privs set for the account we create
17358  if ($< == 0) {
17359    unless (chmod(0755, $home_dir)) {
17360      die("Can't set perms on $home_dir to 0755: $!");
17361    }
17362
17363    unless (chown($uid, $gid, $home_dir)) {
17364      die("Can't set owner of $home_dir to $uid/$gid: $!");
17365    }
17366  }
17367
17368  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
17369    '/bin/bash');
17370  auth_group_write($auth_group_file, $group, $gid, $user);
17371
17372  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17373  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17374
17375  my $config = {
17376    PidFile => $pid_file,
17377    ScoreboardFile => $scoreboard_file,
17378    SystemLog => $log_file,
17379    TraceLog => $log_file,
17380    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17381
17382    AuthUserFile => $auth_user_file,
17383    AuthGroupFile => $auth_group_file,
17384
17385    IfModules => {
17386      'mod_delay.c' => {
17387        DelayEngine => 'off',
17388      },
17389
17390      'mod_sftp.c' => [
17391        'SFTPAcceptEnv L?G',
17392        "SFTPEngine on",
17393        "SFTPLog $log_file",
17394        "SFTPHostKey $rsa_host_key",
17395        "SFTPHostKey $dsa_host_key",
17396      ],
17397    },
17398  };
17399
17400  my ($port, $config_user, $config_group) = config_write($config_file, $config);
17401
17402  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
17403
17404  # Open pipes, for use between the parent and child processes.  Specifically,
17405  # the child will indicate when it's done with its test by writing a message
17406  # to the parent.
17407  my ($rfh, $wfh);
17408  unless (pipe($rfh, $wfh)) {
17409    die("Can't open pipe: $!");
17410  }
17411
17412  require Net::SSH2;
17413
17414  my $ex;
17415
17416  # Fork child
17417  $self->handle_sigchld();
17418  defined(my $pid = fork()) or die("Can't fork: $!");
17419  if ($pid) {
17420    eval {
17421      my $ssh2 = Net::SSH2->new();
17422
17423      sleep(1);
17424
17425      unless ($ssh2->connect('127.0.0.1', $port)) {
17426        my ($err_code, $err_name, $err_str) = $ssh2->error();
17427        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17428      }
17429
17430      unless ($ssh2->auth_password($user, $passwd)) {
17431        my ($err_code, $err_name, $err_str) = $ssh2->error();
17432        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
17433      }
17434
17435      my $chan = $ssh2->channel('session');
17436      unless ($chan) {
17437        my ($err_code, $err_name, $err_str) = $ssh2->error();
17438        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
17439      }
17440
17441      my $barred = [qw(
17442        SFTP
17443        SFTP_LIBRARY_VERSION
17444        SFTP_CLIENT_CIPHER_ALGO
17445        SFTP_CLIENT_MAC_ALGO
17446        SFTP_CLIENT_COMPRESSION_ALGO
17447        SFTP_KEX_ALGO
17448        SFTP_SERVER_CIPHER_ALGO
17449        SFTP_SERVER_MAC_ALGO
17450        SFTP_SERVER_COMPRESSION_ALGO
17451      )];
17452
17453      foreach my $key (@$barred) {
17454        if ($chan->setenv($key, "1")) {
17455          die("Setting environment variable '$key' via 'env' channel succeeded unexpectedly");
17456        }
17457      }
17458
17459      if ($chan->setenv('LANG', 'FOO')) {
17460        die("Setting environment variable 'LANG' via 'env' channel succeeded unexpectedly");
17461      }
17462
17463      unless ($chan->setenv('LOG', 'FOO')) {
17464        my ($err_code, $err_name, $err_str) = $ssh2->error();
17465        die("Setting environment variable 'LOG' failed: [$err_name] ($err_code) $err_str");
17466      }
17467
17468      $chan->eof();
17469      $chan->close();
17470      $ssh2->disconnect();
17471    };
17472
17473    if ($@) {
17474      $ex = $@;
17475    }
17476
17477    $wfh->print("done\n");
17478    $wfh->flush();
17479
17480  } else {
17481    eval { server_wait($config_file, $rfh) };
17482    if ($@) {
17483      warn($@);
17484      exit 1;
17485    }
17486
17487    exit 0;
17488  }
17489
17490  # Stop server
17491  server_stop($pid_file);
17492
17493  $self->assert_child_ok($pid);
17494
17495  if ($ex) {
17496    test_append_logfile($log_file, $ex);
17497    unlink($log_file);
17498
17499    die($ex);
17500  }
17501
17502  unlink($log_file);
17503}
17504
17505sub ssh2_channel_max_exceeded {
17506  my $self = shift;
17507  my $tmpdir = $self->{tmpdir};
17508
17509  my $config_file = "$tmpdir/sftp.conf";
17510  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
17511  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
17512
17513  my $log_file = test_get_logfile();
17514
17515  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
17516  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
17517
17518  my $user = 'proftpd';
17519  my $passwd = 'test';
17520  my $group = 'ftpd';
17521  my $home_dir = File::Spec->rel2abs($tmpdir);
17522  my $uid = 500;
17523  my $gid = 500;
17524
17525  # Make sure that, if we're running as root, that the home directory has
17526  # permissions/privs set for the account we create
17527  if ($< == 0) {
17528    unless (chmod(0755, $home_dir)) {
17529      die("Can't set perms on $home_dir to 0755: $!");
17530    }
17531
17532    unless (chown($uid, $gid, $home_dir)) {
17533      die("Can't set owner of $home_dir to $uid/$gid: $!");
17534    }
17535  }
17536
17537  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
17538    '/bin/bash');
17539  auth_group_write($auth_group_file, $group, $gid, $user);
17540
17541  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17542  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17543
17544  my $config = {
17545    PidFile => $pid_file,
17546    ScoreboardFile => $scoreboard_file,
17547    SystemLog => $log_file,
17548    TraceLog => $log_file,
17549    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17550
17551    AuthUserFile => $auth_user_file,
17552    AuthGroupFile => $auth_group_file,
17553
17554    IfModules => {
17555      'mod_delay.c' => {
17556        DelayEngine => 'off',
17557      },
17558
17559      'mod_sftp.c' => [
17560        "SFTPEngine on",
17561        "SFTPLog $log_file",
17562        "SFTPHostKey $rsa_host_key",
17563        "SFTPHostKey $dsa_host_key",
17564        "SFTPMaxChannels 1",
17565      ],
17566    },
17567  };
17568
17569  my ($port, $config_user, $config_group) = config_write($config_file, $config);
17570
17571  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
17572
17573  # Open pipes, for use between the parent and child processes.  Specifically,
17574  # the child will indicate when it's done with its test by writing a message
17575  # to the parent.
17576  my ($rfh, $wfh);
17577  unless (pipe($rfh, $wfh)) {
17578    die("Can't open pipe: $!");
17579  }
17580
17581  require Net::SSH2;
17582
17583  my $ex;
17584
17585  # Fork child
17586  $self->handle_sigchld();
17587  defined(my $pid = fork()) or die("Can't fork: $!");
17588  if ($pid) {
17589    eval {
17590      my $ssh2 = Net::SSH2->new();
17591
17592      sleep(1);
17593
17594      unless ($ssh2->connect('127.0.0.1', $port)) {
17595        my ($err_code, $err_name, $err_str) = $ssh2->error();
17596        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17597      }
17598
17599      unless ($ssh2->auth_password($user, $passwd)) {
17600        my ($err_code, $err_name, $err_str) = $ssh2->error();
17601        die("Can't authenticate to SSH2 server: [$err_name] ($err_code) $err_str");
17602      }
17603
17604      my $chan = $ssh2->channel('session');
17605      unless ($chan) {
17606        my ($err_code, $err_name, $err_str) = $ssh2->error();
17607        die("Can't open 'session' channel: [$err_name] ($err_code) $err_str");
17608      }
17609
17610      my $sftp = $ssh2->sftp();
17611      if ($sftp) {
17612        die("Open 'sftp' channel succeeded unexpectedly");
17613      }
17614
17615      $chan->eof();
17616      $chan->close();
17617      $ssh2->disconnect();
17618    };
17619
17620    if ($@) {
17621      $ex = $@;
17622    }
17623
17624    $wfh->print("done\n");
17625    $wfh->flush();
17626
17627  } else {
17628    eval { server_wait($config_file, $rfh) };
17629    if ($@) {
17630      warn($@);
17631      exit 1;
17632    }
17633
17634    exit 0;
17635  }
17636
17637  # Stop server
17638  server_stop($pid_file);
17639
17640  $self->assert_child_ok($pid);
17641
17642  if ($ex) {
17643    test_append_logfile($log_file, $ex);
17644    unlink($log_file);
17645
17646    die($ex);
17647  }
17648
17649  unlink($log_file);
17650}
17651
17652sub ssh2_disconnect_client {
17653  my $self = shift;
17654  my $tmpdir = $self->{tmpdir};
17655
17656  my $config_file = "$tmpdir/sftp.conf";
17657  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
17658  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
17659
17660  my $log_file = test_get_logfile();
17661
17662  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
17663  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
17664
17665  my $user = 'proftpd';
17666  my $passwd = 'test';
17667  my $group = 'ftpd';
17668  my $home_dir = File::Spec->rel2abs($tmpdir);
17669  my $uid = 500;
17670  my $gid = 500;
17671
17672  # Make sure that, if we're running as root, that the home directory has
17673  # permissions/privs set for the account we create
17674  if ($< == 0) {
17675    unless (chmod(0755, $home_dir)) {
17676      die("Can't set perms on $home_dir to 0755: $!");
17677    }
17678
17679    unless (chown($uid, $gid, $home_dir)) {
17680      die("Can't set owner of $home_dir to $uid/$gid: $!");
17681    }
17682  }
17683
17684  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
17685    '/bin/bash');
17686  auth_group_write($auth_group_file, $group, $gid, $user);
17687
17688  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17689  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17690
17691  my $timeout_idle = 5;
17692
17693  my $config = {
17694    PidFile => $pid_file,
17695    ScoreboardFile => $scoreboard_file,
17696    SystemLog => $log_file,
17697    TraceLog => $log_file,
17698    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17699
17700    AuthUserFile => $auth_user_file,
17701    AuthGroupFile => $auth_group_file,
17702
17703    TimeoutIdle => $timeout_idle,
17704
17705    IfModules => {
17706      'mod_delay.c' => {
17707        DelayEngine => 'off',
17708      },
17709
17710      'mod_sftp.c' => [
17711        "SFTPEngine on",
17712        "SFTPLog $log_file",
17713        "SFTPHostKey $rsa_host_key",
17714        "SFTPHostKey $dsa_host_key",
17715      ],
17716    },
17717  };
17718
17719  my ($port, $config_user, $config_group) = config_write($config_file, $config);
17720
17721  my $have_sftp_pam = feature_have_module_compiled('mod_sftp_pam.c');
17722
17723  # Open pipes, for use between the parent and child processes.  Specifically,
17724  # the child will indicate when it's done with its test by writing a message
17725  # to the parent.
17726  my ($rfh, $wfh);
17727  unless (pipe($rfh, $wfh)) {
17728    die("Can't open pipe: $!");
17729  }
17730
17731  require Net::SSH2;
17732
17733  my $ex;
17734
17735  my $start_time = time();
17736
17737  # Fork child
17738  $self->handle_sigchld();
17739  defined(my $pid = fork()) or die("Can't fork: $!");
17740  if ($pid) {
17741    eval {
17742      my $ssh2 = Net::SSH2->new();
17743
17744      sleep(1);
17745
17746      unless ($ssh2->connect('127.0.0.1', $port)) {
17747        my ($err_code, $err_name, $err_str) = $ssh2->error();
17748        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17749      }
17750
17751      # Don't explicitly disconnect.  But idle for 2 seconds, to see if
17752      # the server is properly waiting (up to TimeoutIdle); this will be
17753      # reflected in the generated logs.
17754      sleep(2);
17755    };
17756
17757    if ($@) {
17758      $ex = $@;
17759    }
17760
17761    $wfh->print("done\n");
17762    $wfh->flush();
17763
17764  } else {
17765    eval { server_wait($config_file, $rfh) };
17766    if ($@) {
17767      warn($@);
17768      exit 1;
17769    }
17770
17771    exit 0;
17772  }
17773
17774  # Stop server
17775  server_stop($pid_file);
17776
17777  $self->assert_child_ok($pid);
17778
17779  if ($ex) {
17780    test_append_logfile($log_file, $ex);
17781    unlink($log_file);
17782
17783    die($ex);
17784  }
17785
17786  my $elapsed = time()- $start_time;
17787  if ($elapsed > $timeout_idle) {
17788    die("Expected less than $timeout_idle, got $elapsed");
17789  }
17790
17791  unlink($log_file);
17792}
17793
17794sub sftp_without_auth {
17795  my $self = shift;
17796  my $tmpdir = $self->{tmpdir};
17797
17798  my $config_file = "$tmpdir/sftp.conf";
17799  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
17800  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
17801
17802  my $log_file = test_get_logfile();
17803
17804  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
17805  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
17806
17807  my $user = 'proftpd';
17808  my $passwd = 'test';
17809  my $group = 'ftpd';
17810  my $home_dir = File::Spec->rel2abs($tmpdir);
17811  my $uid = 500;
17812  my $gid = 500;
17813
17814  # Make sure that, if we're running as root, that the home directory has
17815  # permissions/privs set for the account we create
17816  if ($< == 0) {
17817    unless (chmod(0755, $home_dir)) {
17818      die("Can't set perms on $home_dir to 0755: $!");
17819    }
17820
17821    unless (chown($uid, $gid, $home_dir)) {
17822      die("Can't set owner of $home_dir to $uid/$gid: $!");
17823    }
17824  }
17825
17826  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
17827    '/bin/bash');
17828  auth_group_write($auth_group_file, $group, $gid, $user);
17829
17830  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17831  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17832
17833  my $config = {
17834    PidFile => $pid_file,
17835    ScoreboardFile => $scoreboard_file,
17836    SystemLog => $log_file,
17837    TraceLog => $log_file,
17838    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17839
17840    AuthUserFile => $auth_user_file,
17841    AuthGroupFile => $auth_group_file,
17842
17843    IfModules => {
17844      'mod_delay.c' => {
17845        DelayEngine => 'off',
17846      },
17847
17848      'mod_sftp.c' => [
17849        "SFTPEngine on",
17850        "SFTPLog $log_file",
17851        "SFTPHostKey $rsa_host_key",
17852        "SFTPHostKey $dsa_host_key",
17853      ],
17854    },
17855  };
17856
17857  my ($port, $config_user, $config_group) = config_write($config_file, $config);
17858
17859  # Open pipes, for use between the parent and child processes.  Specifically,
17860  # the child will indicate when it's done with its test by writing a message
17861  # to the parent.
17862  my ($rfh, $wfh);
17863  unless (pipe($rfh, $wfh)) {
17864    die("Can't open pipe: $!");
17865  }
17866
17867  require Net::SSH2;
17868
17869  my $ex;
17870
17871  # Fork child
17872  $self->handle_sigchld();
17873  defined(my $pid = fork()) or die("Can't fork: $!");
17874  if ($pid) {
17875    eval {
17876      my $ssh2 = Net::SSH2->new();
17877
17878      sleep(1);
17879
17880      unless ($ssh2->connect('127.0.0.1', $port)) {
17881        my ($err_code, $err_name, $err_str) = $ssh2->error();
17882        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17883      }
17884
17885      my $sftp = $ssh2->sftp();
17886      if ($sftp) {
17887        die("Started SFTP channel unexpectedly");
17888      }
17889
17890      my ($err_code, $err_name, $err_str) = $ssh2->error();
17891
17892      my $expected;
17893
17894      # The expected error messages depend on the version of libssh2 being
17895      # used.
17896      $self->assert($err_name eq 'LIBSSH2_ERROR_INVAL' or
17897                    $err_name eq 'LIBSSH2_ERROR_CHANNEL_FAILURE',
17898        test_msg("Expected 'LIBSSH2_ERROR_INVAL' or 'LIBSSH2_ERROR_CHANNEL_FAILURE', got '$err_name'"));
17899
17900      $ssh2->disconnect();
17901    };
17902
17903    if ($@) {
17904      $ex = $@;
17905    }
17906
17907    $wfh->print("done\n");
17908    $wfh->flush();
17909
17910  } else {
17911    eval { server_wait($config_file, $rfh) };
17912    if ($@) {
17913      warn($@);
17914      exit 1;
17915    }
17916
17917    exit 0;
17918  }
17919
17920  # Stop server
17921  server_stop($pid_file);
17922
17923  $self->assert_child_ok($pid);
17924
17925  if ($ex) {
17926    test_append_logfile($log_file, $ex);
17927    unlink($log_file);
17928
17929    die($ex);
17930  }
17931
17932  unlink($log_file);
17933}
17934
17935sub sftp_stat {
17936  my $self = shift;
17937  my $tmpdir = $self->{tmpdir};
17938  my $setup = test_setup($tmpdir, 'sftp');
17939
17940  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
17941  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
17942
17943  my $config = {
17944    PidFile => $setup->{pid_file},
17945    ScoreboardFile => $setup->{scoreboard_file},
17946    SystemLog => $setup->{log_file},
17947    TraceLog => $setup->{log_file},
17948    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
17949
17950    AuthUserFile => $setup->{auth_user_file},
17951    AuthGroupFile => $setup->{auth_group_file},
17952
17953    IfModules => {
17954      'mod_delay.c' => {
17955        DelayEngine => 'off',
17956      },
17957
17958      'mod_sftp.c' => [
17959        "SFTPEngine on",
17960        "SFTPLog $setup->{log_file}",
17961        "SFTPHostKey $rsa_host_key",
17962        "SFTPHostKey $dsa_host_key",
17963      ],
17964    },
17965  };
17966
17967  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
17968    $config);
17969
17970  my $config_size = (stat($setup->{config_file}))[7];
17971
17972  # Open pipes, for use between the parent and child processes.  Specifically,
17973  # the child will indicate when it's done with its test by writing a message
17974  # to the parent.
17975  my ($rfh, $wfh);
17976  unless (pipe($rfh, $wfh)) {
17977    die("Can't open pipe: $!");
17978  }
17979
17980  require Net::SSH2;
17981
17982  my $ex;
17983
17984  # Fork child
17985  $self->handle_sigchld();
17986  defined(my $pid = fork()) or die("Can't fork: $!");
17987  if ($pid) {
17988    eval {
17989      my $ssh2 = Net::SSH2->new();
17990
17991      sleep(1);
17992
17993      unless ($ssh2->connect('127.0.0.1', $port)) {
17994        my ($err_code, $err_name, $err_str) = $ssh2->error();
17995        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
17996      }
17997
17998      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
17999        my ($err_code, $err_name, $err_str) = $ssh2->error();
18000        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18001      }
18002
18003      my $sftp = $ssh2->sftp();
18004      unless ($sftp) {
18005        my ($err_code, $err_name, $err_str) = $ssh2->error();
18006        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18007      }
18008
18009      my $path = 'sftp.conf';
18010      my $attrs = $sftp->stat($path, 1);
18011      unless ($attrs) {
18012        my ($err_code, $err_name) = $sftp->error();
18013        die("STAT $path failed: [$err_name] ($err_code)");
18014      }
18015
18016      my $expected = $config_size;
18017      my $file_size = $attrs->{size};
18018      $self->assert($expected == $file_size,
18019        test_msg("Expected file size '$expected', got '$file_size'"));
18020
18021      $expected = $<;
18022      my $file_uid = $attrs->{uid};
18023      $self->assert($expected == $file_uid,
18024        test_msg("Expected file UID '$expected', got '$file_uid'"));
18025
18026      $expected = $(;
18027      my $file_gid = $attrs->{gid};
18028      $self->assert($expected == $file_gid,
18029        test_msg("Expected file GID '$expected', got '$file_gid'"));
18030
18031      $sftp = undef;
18032      $ssh2->disconnect();
18033    };
18034    if ($@) {
18035      $ex = $@;
18036    }
18037
18038    $wfh->print("done\n");
18039    $wfh->flush();
18040
18041  } else {
18042    eval { server_wait($setup->{config_file}, $rfh) };
18043    if ($@) {
18044      warn($@);
18045      exit 1;
18046    }
18047
18048    exit 0;
18049  }
18050
18051  # Stop server
18052  server_stop($setup->{pid_file});
18053  $self->assert_child_ok($pid);
18054
18055  test_cleanup($setup->{log_file}, $ex);
18056}
18057
18058sub sftp_stat_abs_symlink {
18059  my $self = shift;
18060  my $tmpdir = $self->{tmpdir};
18061  my $setup = test_setup($tmpdir, 'sftp');
18062
18063  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
18064  mkpath($test_dir);
18065
18066  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
18067  if (open(my $fh, "> $test_file")) {
18068    print $fh "Hello, World!\n";
18069    unless (close($fh)) {
18070      die("Can't write $test_file: $!");
18071    }
18072
18073  } else {
18074    die("Can't open $test_file: $!");
18075  }
18076
18077  my $test_size = (stat($test_file))[7];
18078
18079  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
18080
18081  my $dst_path = $test_file;
18082  if ($^O eq 'darwin') {
18083    # MacOSX-specific hack
18084    $dst_path = '/private' . $dst_path;
18085  }
18086
18087  unless (symlink($dst_path, $test_symlink)) {
18088    die("Can't symlink $test_symlink to $dst_path: $!");
18089  }
18090
18091  if ($< == 0) {
18092    unless (chmod(0755, $test_dir)) {
18093      die("Can't set perms on $test_dir to 0755: $!");
18094    }
18095
18096    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
18097      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
18098    }
18099  }
18100
18101  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
18102  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
18103
18104  my $config = {
18105    PidFile => $setup->{pid_file},
18106    ScoreboardFile => $setup->{scoreboard_file},
18107    SystemLog => $setup->{log_file},
18108    TraceLog => $setup->{log_file},
18109    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
18110
18111    AuthUserFile => $setup->{auth_user_file},
18112    AuthGroupFile => $setup->{auth_group_file},
18113
18114    IfModules => {
18115      'mod_delay.c' => {
18116        DelayEngine => 'off',
18117      },
18118
18119      'mod_sftp.c' => [
18120        "SFTPEngine on",
18121        "SFTPLog $setup->{log_file}",
18122        "SFTPHostKey $rsa_host_key",
18123        "SFTPHostKey $dsa_host_key",
18124      ],
18125    },
18126  };
18127
18128  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
18129    $config);
18130
18131  # Open pipes, for use between the parent and child processes.  Specifically,
18132  # the child will indicate when it's done with its test by writing a message
18133  # to the parent.
18134  my ($rfh, $wfh);
18135  unless (pipe($rfh, $wfh)) {
18136    die("Can't open pipe: $!");
18137  }
18138
18139  require Net::SSH2;
18140
18141  my $ex;
18142
18143  # Fork child
18144  $self->handle_sigchld();
18145  defined(my $pid = fork()) or die("Can't fork: $!");
18146  if ($pid) {
18147    eval {
18148      my $ssh2 = Net::SSH2->new();
18149
18150      sleep(1);
18151
18152      unless ($ssh2->connect('127.0.0.1', $port)) {
18153        my ($err_code, $err_name, $err_str) = $ssh2->error();
18154        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
18155      }
18156
18157      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
18158        my ($err_code, $err_name, $err_str) = $ssh2->error();
18159        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18160      }
18161
18162      my $sftp = $ssh2->sftp();
18163      unless ($sftp) {
18164        my ($err_code, $err_name, $err_str) = $ssh2->error();
18165        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18166      }
18167
18168      my $path = 'test.d/test.lnk';
18169      my $attrs = $sftp->stat($path, 1);
18170      unless ($attrs) {
18171        my ($err_code, $err_name) = $sftp->error();
18172        die("STAT $path failed: [$err_name] ($err_code)");
18173      }
18174
18175      my $expected = $test_size;
18176      my $file_size = $attrs->{size};
18177      $self->assert($expected == $file_size,
18178        test_msg("Expected file size '$expected', got '$file_size'"));
18179
18180      $expected = $<;
18181      my $file_uid = $attrs->{uid};
18182      $self->assert($expected == $file_uid,
18183        test_msg("Expected file UID '$expected', got '$file_uid'"));
18184
18185      $expected = $(;
18186      my $file_gid = $attrs->{gid};
18187      $self->assert($expected == $file_gid,
18188        test_msg("Expected file GID '$expected', got '$file_gid'"));
18189
18190      $sftp = undef;
18191      $ssh2->disconnect();
18192    };
18193    if ($@) {
18194      $ex = $@;
18195    }
18196
18197    $wfh->print("done\n");
18198    $wfh->flush();
18199
18200  } else {
18201    eval { server_wait($setup->{config_file}, $rfh) };
18202    if ($@) {
18203      warn($@);
18204      exit 1;
18205    }
18206
18207    exit 0;
18208  }
18209
18210  # Stop server
18211  server_stop($setup->{pid_file});
18212  $self->assert_child_ok($pid);
18213
18214  test_cleanup($setup->{log_file}, $ex);
18215}
18216
18217sub sftp_stat_abs_symlink_chrooted_bug4219 {
18218  my $self = shift;
18219  my $tmpdir = $self->{tmpdir};
18220  my $setup = test_setup($tmpdir, 'sftp');
18221
18222  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
18223  mkpath($test_dir);
18224
18225  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
18226  if (open(my $fh, "> $test_file")) {
18227    print $fh "Hello, World!\n";
18228    unless (close($fh)) {
18229      die("Can't write $test_file: $!");
18230    }
18231
18232  } else {
18233    die("Can't open $test_file: $!");
18234  }
18235
18236  my $test_size = (stat($test_file))[7];
18237
18238  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
18239
18240  my $dst_path = $test_file;
18241  if ($^O eq 'darwin') {
18242    # MacOSX-specific hack
18243    $dst_path = '/private' . $dst_path;
18244  }
18245
18246  unless (symlink($dst_path, $test_symlink)) {
18247    die("Can't symlink $test_symlink to $dst_path: $!");
18248  }
18249
18250  if ($< == 0) {
18251    unless (chmod(0755, $test_dir)) {
18252      die("Can't set perms on $test_dir to 0755: $!");
18253    }
18254
18255    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
18256      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
18257    }
18258  }
18259
18260  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
18261  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
18262
18263  my $config = {
18264    PidFile => $setup->{pid_file},
18265    ScoreboardFile => $setup->{scoreboard_file},
18266    SystemLog => $setup->{log_file},
18267    TraceLog => $setup->{log_file},
18268    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
18269
18270    AuthUserFile => $setup->{auth_user_file},
18271    AuthGroupFile => $setup->{auth_group_file},
18272
18273    DefaultRoot => '~',
18274
18275    IfModules => {
18276      'mod_delay.c' => {
18277        DelayEngine => 'off',
18278      },
18279
18280      'mod_sftp.c' => [
18281        "SFTPEngine on",
18282        "SFTPLog $setup->{log_file}",
18283        "SFTPHostKey $rsa_host_key",
18284        "SFTPHostKey $dsa_host_key",
18285      ],
18286    },
18287  };
18288
18289  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
18290    $config);
18291
18292  # Open pipes, for use between the parent and child processes.  Specifically,
18293  # the child will indicate when it's done with its test by writing a message
18294  # to the parent.
18295  my ($rfh, $wfh);
18296  unless (pipe($rfh, $wfh)) {
18297    die("Can't open pipe: $!");
18298  }
18299
18300  require Net::SSH2;
18301
18302  my $ex;
18303
18304  # Fork child
18305  $self->handle_sigchld();
18306  defined(my $pid = fork()) or die("Can't fork: $!");
18307  if ($pid) {
18308    eval {
18309      my $ssh2 = Net::SSH2->new();
18310
18311      sleep(1);
18312
18313      unless ($ssh2->connect('127.0.0.1', $port)) {
18314        my ($err_code, $err_name, $err_str) = $ssh2->error();
18315        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
18316      }
18317
18318      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
18319        my ($err_code, $err_name, $err_str) = $ssh2->error();
18320        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18321      }
18322
18323      my $sftp = $ssh2->sftp();
18324      unless ($sftp) {
18325        my ($err_code, $err_name, $err_str) = $ssh2->error();
18326        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18327      }
18328
18329      my $path = 'test.d/test.lnk';
18330      my $attrs = $sftp->stat($path, 1);
18331      unless ($attrs) {
18332        my ($err_code, $err_name) = $sftp->error();
18333        die("STAT $path failed: [$err_name] ($err_code)");
18334      }
18335
18336      my $expected = $test_size;
18337      my $file_size = $attrs->{size};
18338      $self->assert($expected == $file_size,
18339        test_msg("Expected file size '$expected', got '$file_size'"));
18340
18341      $expected = $<;
18342      if ($< == 0) {
18343        $expected = $setup->{uid};
18344      }
18345
18346      my $file_uid = $attrs->{uid};
18347      $self->assert($expected == $file_uid,
18348        test_msg("Expected file UID '$expected', got '$file_uid'"));
18349
18350      $expected = $(;
18351      if ($< == 0) {
18352        $expected = $setup->{gid};
18353      }
18354
18355      my $file_gid = $attrs->{gid};
18356      $self->assert($expected == $file_gid,
18357        test_msg("Expected file GID '$expected', got '$file_gid'"));
18358
18359      $sftp = undef;
18360      $ssh2->disconnect();
18361    };
18362    if ($@) {
18363      $ex = $@;
18364    }
18365
18366    $wfh->print("done\n");
18367    $wfh->flush();
18368
18369  } else {
18370    eval { server_wait($setup->{config_file}, $rfh) };
18371    if ($@) {
18372      warn($@);
18373      exit 1;
18374    }
18375
18376    exit 0;
18377  }
18378
18379  # Stop server
18380  server_stop($setup->{pid_file});
18381  $self->assert_child_ok($pid);
18382
18383  test_cleanup($setup->{log_file}, $ex);
18384}
18385
18386sub sftp_stat_abs_symlink_enoent {
18387  my $self = shift;
18388  my $tmpdir = $self->{tmpdir};
18389  my $setup = test_setup($tmpdir, 'sftp');
18390
18391  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
18392  mkpath($test_dir);
18393
18394  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
18395  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
18396
18397  my $dst_path = $test_file;
18398  if ($^O eq 'darwin') {
18399    # MacOSX-specific hack
18400    $dst_path = '/private' . $dst_path;
18401  }
18402
18403  unless (symlink($dst_path, $test_symlink)) {
18404    die("Can't symlink $test_symlink to $dst_path: $!");
18405  }
18406
18407  if ($< == 0) {
18408    unless (chmod(0755, $test_dir)) {
18409      die("Can't set perms on $test_dir to 0755: $!");
18410    }
18411
18412    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
18413      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
18414    }
18415  }
18416
18417  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
18418  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
18419
18420  my $config = {
18421    PidFile => $setup->{pid_file},
18422    ScoreboardFile => $setup->{scoreboard_file},
18423    SystemLog => $setup->{log_file},
18424    TraceLog => $setup->{log_file},
18425    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
18426
18427    AuthUserFile => $setup->{auth_user_file},
18428    AuthGroupFile => $setup->{auth_group_file},
18429
18430    IfModules => {
18431      'mod_delay.c' => {
18432        DelayEngine => 'off',
18433      },
18434
18435      'mod_sftp.c' => [
18436        "SFTPEngine on",
18437        "SFTPLog $setup->{log_file}",
18438        "SFTPHostKey $rsa_host_key",
18439        "SFTPHostKey $dsa_host_key",
18440      ],
18441    },
18442  };
18443
18444  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
18445    $config);
18446
18447  # Open pipes, for use between the parent and child processes.  Specifically,
18448  # the child will indicate when it's done with its test by writing a message
18449  # to the parent.
18450  my ($rfh, $wfh);
18451  unless (pipe($rfh, $wfh)) {
18452    die("Can't open pipe: $!");
18453  }
18454
18455  require Net::SSH2;
18456
18457  my $ex;
18458
18459  # Fork child
18460  $self->handle_sigchld();
18461  defined(my $pid = fork()) or die("Can't fork: $!");
18462  if ($pid) {
18463    eval {
18464      my $ssh2 = Net::SSH2->new();
18465
18466      sleep(1);
18467
18468      unless ($ssh2->connect('127.0.0.1', $port)) {
18469        my ($err_code, $err_name, $err_str) = $ssh2->error();
18470        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
18471      }
18472
18473      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
18474        my ($err_code, $err_name, $err_str) = $ssh2->error();
18475        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18476      }
18477
18478      my $sftp = $ssh2->sftp();
18479      unless ($sftp) {
18480        my ($err_code, $err_name, $err_str) = $ssh2->error();
18481        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18482      }
18483
18484      my $path = 'test.d/test.lnk';
18485      my $attrs = $sftp->stat($path, 1);
18486      if ($attrs) {
18487        die("STAT $path succeeded unexpectedly");
18488      }
18489
18490      my ($err_code, $err_name) = $sftp->error();
18491      my $expected = 'SSH_FX_NO_SUCH_FILE';
18492      $self->assert($expected eq $err_name,
18493        test_msg("Expected error name '$expected', got '$err_name'"));
18494
18495      $sftp = undef;
18496      $ssh2->disconnect();
18497    };
18498    if ($@) {
18499      $ex = $@;
18500    }
18501
18502    $wfh->print("done\n");
18503    $wfh->flush();
18504
18505  } else {
18506    eval { server_wait($setup->{config_file}, $rfh) };
18507    if ($@) {
18508      warn($@);
18509      exit 1;
18510    }
18511
18512    exit 0;
18513  }
18514
18515  # Stop server
18516  server_stop($setup->{pid_file});
18517  $self->assert_child_ok($pid);
18518
18519  test_cleanup($setup->{log_file}, $ex);
18520}
18521
18522sub sftp_stat_abs_symlink_enoent_chrooted_bug4219 {
18523  my $self = shift;
18524  my $tmpdir = $self->{tmpdir};
18525  my $setup = test_setup($tmpdir, 'sftp');
18526
18527  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
18528  mkpath($test_dir);
18529
18530  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
18531  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
18532
18533  my $dst_path = $test_file;
18534  if ($^O eq 'darwin') {
18535    # MacOSX-specific hack
18536    $dst_path = '/private' . $dst_path;
18537  }
18538
18539  unless (symlink($dst_path, $test_symlink)) {
18540    die("Can't symlink $test_symlink to $dst_path: $!");
18541  }
18542
18543  if ($< == 0) {
18544    unless (chmod(0755, $test_dir)) {
18545      die("Can't set perms on $test_dir to 0755: $!");
18546    }
18547
18548    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
18549      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
18550    }
18551  }
18552
18553  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
18554  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
18555
18556  my $config = {
18557    PidFile => $setup->{pid_file},
18558    ScoreboardFile => $setup->{scoreboard_file},
18559    SystemLog => $setup->{log_file},
18560    TraceLog => $setup->{log_file},
18561    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
18562
18563    AuthUserFile => $setup->{auth_user_file},
18564    AuthGroupFile => $setup->{auth_group_file},
18565
18566    DefaultRoot => '~',
18567
18568    IfModules => {
18569      'mod_delay.c' => {
18570        DelayEngine => 'off',
18571      },
18572
18573      'mod_sftp.c' => [
18574        "SFTPEngine on",
18575        "SFTPLog $setup->{log_file}",
18576        "SFTPHostKey $rsa_host_key",
18577        "SFTPHostKey $dsa_host_key",
18578      ],
18579    },
18580  };
18581
18582  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
18583    $config);
18584
18585  # Open pipes, for use between the parent and child processes.  Specifically,
18586  # the child will indicate when it's done with its test by writing a message
18587  # to the parent.
18588  my ($rfh, $wfh);
18589  unless (pipe($rfh, $wfh)) {
18590    die("Can't open pipe: $!");
18591  }
18592
18593  require Net::SSH2;
18594
18595  my $ex;
18596
18597  # Fork child
18598  $self->handle_sigchld();
18599  defined(my $pid = fork()) or die("Can't fork: $!");
18600  if ($pid) {
18601    eval {
18602      my $ssh2 = Net::SSH2->new();
18603
18604      sleep(1);
18605
18606      unless ($ssh2->connect('127.0.0.1', $port)) {
18607        my ($err_code, $err_name, $err_str) = $ssh2->error();
18608        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
18609      }
18610
18611      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
18612        my ($err_code, $err_name, $err_str) = $ssh2->error();
18613        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18614      }
18615
18616      my $sftp = $ssh2->sftp();
18617      unless ($sftp) {
18618        my ($err_code, $err_name, $err_str) = $ssh2->error();
18619        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18620      }
18621
18622      my $path = 'test.d/test.lnk';
18623      my $attrs = $sftp->stat($path, 1);
18624      if ($attrs) {
18625        die("STAT $path succeeded unexpectedly");
18626      }
18627
18628      my ($err_code, $err_name) = $sftp->error();
18629      my $expected = 'SSH_FX_NO_SUCH_FILE';
18630      $self->assert($expected eq $err_name,
18631        test_msg("Expected error name '$expected', got '$err_name'"));
18632
18633      $sftp = undef;
18634      $ssh2->disconnect();
18635    };
18636    if ($@) {
18637      $ex = $@;
18638    }
18639
18640    $wfh->print("done\n");
18641    $wfh->flush();
18642
18643  } else {
18644    eval { server_wait($setup->{config_file}, $rfh) };
18645    if ($@) {
18646      warn($@);
18647      exit 1;
18648    }
18649
18650    exit 0;
18651  }
18652
18653  # Stop server
18654  server_stop($setup->{pid_file});
18655  $self->assert_child_ok($pid);
18656
18657  test_cleanup($setup->{log_file}, $ex);
18658}
18659
18660sub sftp_stat_rel_symlink {
18661  my $self = shift;
18662  my $tmpdir = $self->{tmpdir};
18663  my $setup = test_setup($tmpdir, 'sftp');
18664
18665  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
18666  mkpath($test_dir);
18667
18668  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
18669  if (open(my $fh, "> $test_file")) {
18670    print $fh "Hello, World!\n";
18671    unless (close($fh)) {
18672      die("Can't write $test_file: $!");
18673    }
18674
18675  } else {
18676    die("Can't open $test_file: $!");
18677  }
18678
18679  my $test_size = (stat($test_file))[7];
18680
18681  # Change to the test directory in order to create a relative path in the
18682  # symlink we need
18683
18684  my $cwd = getcwd();
18685  unless (chdir($test_dir)) {
18686    die("Can't chdir to $test_dir: $!");
18687  }
18688
18689  unless (symlink('./test.txt', './test.lnk')) {
18690    die("Can't symlink 'test.lnk' to './test.txt': $!");
18691  }
18692
18693  unless (chdir($cwd)) {
18694    die("Can't chdir to $cwd: $!");
18695  }
18696
18697  if ($< == 0) {
18698    unless (chmod(0755, $test_dir)) {
18699      die("Can't set perms on $test_dir to 0755: $!");
18700    }
18701
18702    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
18703      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
18704    }
18705  }
18706
18707  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
18708  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
18709
18710  my $config = {
18711    PidFile => $setup->{pid_file},
18712    ScoreboardFile => $setup->{scoreboard_file},
18713    SystemLog => $setup->{log_file},
18714    TraceLog => $setup->{log_file},
18715    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
18716
18717    AuthUserFile => $setup->{auth_user_file},
18718    AuthGroupFile => $setup->{auth_group_file},
18719
18720    IfModules => {
18721      'mod_delay.c' => {
18722        DelayEngine => 'off',
18723      },
18724
18725      'mod_sftp.c' => [
18726        "SFTPEngine on",
18727        "SFTPLog $setup->{log_file}",
18728        "SFTPHostKey $rsa_host_key",
18729        "SFTPHostKey $dsa_host_key",
18730      ],
18731    },
18732  };
18733
18734  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
18735    $config);
18736
18737  # Open pipes, for use between the parent and child processes.  Specifically,
18738  # the child will indicate when it's done with its test by writing a message
18739  # to the parent.
18740  my ($rfh, $wfh);
18741  unless (pipe($rfh, $wfh)) {
18742    die("Can't open pipe: $!");
18743  }
18744
18745  require Net::SSH2;
18746
18747  my $ex;
18748
18749  # Fork child
18750  $self->handle_sigchld();
18751  defined(my $pid = fork()) or die("Can't fork: $!");
18752  if ($pid) {
18753    eval {
18754      my $ssh2 = Net::SSH2->new();
18755
18756      sleep(1);
18757
18758      unless ($ssh2->connect('127.0.0.1', $port)) {
18759        my ($err_code, $err_name, $err_str) = $ssh2->error();
18760        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
18761      }
18762
18763      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
18764        my ($err_code, $err_name, $err_str) = $ssh2->error();
18765        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18766      }
18767
18768      my $sftp = $ssh2->sftp();
18769      unless ($sftp) {
18770        my ($err_code, $err_name, $err_str) = $ssh2->error();
18771        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18772      }
18773
18774      my $path = 'test.d/test.lnk';
18775      my $attrs = $sftp->stat($path, 1);
18776      unless ($attrs) {
18777        my ($err_code, $err_name) = $sftp->error();
18778        die("STAT $path failed: [$err_name] ($err_code)");
18779      }
18780
18781      my $expected = $test_size;
18782      my $file_size = $attrs->{size};
18783      $self->assert($expected == $file_size,
18784        test_msg("Expected file size '$expected', got '$file_size'"));
18785
18786      $expected = $<;
18787      my $file_uid = $attrs->{uid};
18788      $self->assert($expected == $file_uid,
18789        test_msg("Expected file UID '$expected', got '$file_uid'"));
18790
18791      $expected = $(;
18792      my $file_gid = $attrs->{gid};
18793      $self->assert($expected == $file_gid,
18794        test_msg("Expected file GID '$expected', got '$file_gid'"));
18795
18796      $sftp = undef;
18797      $ssh2->disconnect();
18798    };
18799    if ($@) {
18800      $ex = $@;
18801    }
18802
18803    $wfh->print("done\n");
18804    $wfh->flush();
18805
18806  } else {
18807    eval { server_wait($setup->{config_file}, $rfh) };
18808    if ($@) {
18809      warn($@);
18810      exit 1;
18811    }
18812
18813    exit 0;
18814  }
18815
18816  # Stop server
18817  server_stop($setup->{pid_file});
18818  $self->assert_child_ok($pid);
18819
18820  test_cleanup($setup->{log_file}, $ex);
18821}
18822
18823sub sftp_stat_rel_symlink_chrooted_bug4219 {
18824  my $self = shift;
18825  my $tmpdir = $self->{tmpdir};
18826  my $setup = test_setup($tmpdir, 'sftp');
18827
18828  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
18829  mkpath($test_dir);
18830
18831  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
18832  if (open(my $fh, "> $test_file")) {
18833    print $fh "Hello, World!\n";
18834    unless (close($fh)) {
18835      die("Can't write $test_file: $!");
18836    }
18837
18838  } else {
18839    die("Can't open $test_file: $!");
18840  }
18841
18842  my $test_size = (stat($test_file))[7];
18843
18844  # Change to the test directory in order to create a relative path in the
18845  # symlink we need
18846
18847  my $cwd = getcwd();
18848  unless (chdir($test_dir)) {
18849    die("Can't chdir to $test_dir: $!");
18850  }
18851
18852  unless (symlink('./test.txt', './test.lnk')) {
18853    die("Can't symlink 'test.lnk' to './test.txt': $!");
18854  }
18855
18856  unless (chdir($cwd)) {
18857    die("Can't chdir to $cwd: $!");
18858  }
18859
18860  if ($< == 0) {
18861    unless (chmod(0755, $test_dir)) {
18862      die("Can't set perms on $test_dir to 0755: $!");
18863    }
18864
18865    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
18866      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
18867    }
18868  }
18869
18870  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
18871  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
18872
18873  my $config = {
18874    PidFile => $setup->{pid_file},
18875    ScoreboardFile => $setup->{scoreboard_file},
18876    SystemLog => $setup->{log_file},
18877    TraceLog => $setup->{log_file},
18878    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
18879
18880    AuthUserFile => $setup->{auth_user_file},
18881    AuthGroupFile => $setup->{auth_group_file},
18882
18883    DefaultRoot => '~',
18884
18885    IfModules => {
18886      'mod_delay.c' => {
18887        DelayEngine => 'off',
18888      },
18889
18890      'mod_sftp.c' => [
18891        "SFTPEngine on",
18892        "SFTPLog $setup->{log_file}",
18893        "SFTPHostKey $rsa_host_key",
18894        "SFTPHostKey $dsa_host_key",
18895      ],
18896    },
18897  };
18898
18899  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
18900    $config);
18901
18902  # Open pipes, for use between the parent and child processes.  Specifically,
18903  # the child will indicate when it's done with its test by writing a message
18904  # to the parent.
18905  my ($rfh, $wfh);
18906  unless (pipe($rfh, $wfh)) {
18907    die("Can't open pipe: $!");
18908  }
18909
18910  require Net::SSH2;
18911
18912  my $ex;
18913
18914  # Fork child
18915  $self->handle_sigchld();
18916  defined(my $pid = fork()) or die("Can't fork: $!");
18917  if ($pid) {
18918    eval {
18919      my $ssh2 = Net::SSH2->new();
18920
18921      sleep(1);
18922
18923      unless ($ssh2->connect('127.0.0.1', $port)) {
18924        my ($err_code, $err_name, $err_str) = $ssh2->error();
18925        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
18926      }
18927
18928      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
18929        my ($err_code, $err_name, $err_str) = $ssh2->error();
18930        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
18931      }
18932
18933      my $sftp = $ssh2->sftp();
18934      unless ($sftp) {
18935        my ($err_code, $err_name, $err_str) = $ssh2->error();
18936        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
18937      }
18938
18939      my $path = 'test.d/test.lnk';
18940      my $attrs = $sftp->stat($path, 1);
18941      unless ($attrs) {
18942        my ($err_code, $err_name) = $sftp->error();
18943        die("STAT $path failed: [$err_name] ($err_code)");
18944      }
18945
18946      my $expected = $test_size;
18947      my $file_size = $attrs->{size};
18948      $self->assert($expected == $file_size,
18949        test_msg("Expected file size '$expected', got '$file_size'"));
18950
18951      $expected = $<;
18952      if ($< == 0) {
18953        $expected = $setup->{uid};
18954      }
18955
18956      my $file_uid = $attrs->{uid};
18957      $self->assert($expected == $file_uid,
18958        test_msg("Expected file UID '$expected', got '$file_uid'"));
18959
18960      $expected = $(;
18961      if ($< == 0) {
18962        $expected = $setup->{gid};
18963      }
18964
18965      my $file_gid = $attrs->{gid};
18966      $self->assert($expected == $file_gid,
18967        test_msg("Expected file GID '$expected', got '$file_gid'"));
18968
18969      $sftp = undef;
18970      $ssh2->disconnect();
18971    };
18972    if ($@) {
18973      $ex = $@;
18974    }
18975
18976    $wfh->print("done\n");
18977    $wfh->flush();
18978
18979  } else {
18980    eval { server_wait($setup->{config_file}, $rfh) };
18981    if ($@) {
18982      warn($@);
18983      exit 1;
18984    }
18985
18986    exit 0;
18987  }
18988
18989  # Stop server
18990  server_stop($setup->{pid_file});
18991  $self->assert_child_ok($pid);
18992
18993  test_cleanup($setup->{log_file}, $ex);
18994}
18995
18996sub sftp_stat_rel_symlink_enoent {
18997  my $self = shift;
18998  my $tmpdir = $self->{tmpdir};
18999  my $setup = test_setup($tmpdir, 'sftp');
19000
19001  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
19002  mkpath($test_dir);
19003
19004  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
19005
19006  # Change to the test directory in order to create a relative path in the
19007  # symlink we need
19008
19009  my $cwd = getcwd();
19010  unless (chdir($test_dir)) {
19011    die("Can't chdir to $test_dir: $!");
19012  }
19013
19014  unless (symlink('./test.txt', './test.lnk')) {
19015    die("Can't symlink 'test.lnk' to './test.txt': $!");
19016  }
19017
19018  unless (chdir($cwd)) {
19019    die("Can't chdir to $cwd: $!");
19020  }
19021
19022  if ($< == 0) {
19023    unless (chmod(0755, $test_dir)) {
19024      die("Can't set perms on $test_dir to 0755: $!");
19025    }
19026
19027    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
19028      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
19029    }
19030  }
19031
19032  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19033  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19034
19035  my $config = {
19036    PidFile => $setup->{pid_file},
19037    ScoreboardFile => $setup->{scoreboard_file},
19038    SystemLog => $setup->{log_file},
19039    TraceLog => $setup->{log_file},
19040    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19041
19042    AuthUserFile => $setup->{auth_user_file},
19043    AuthGroupFile => $setup->{auth_group_file},
19044
19045    IfModules => {
19046      'mod_delay.c' => {
19047        DelayEngine => 'off',
19048      },
19049
19050      'mod_sftp.c' => [
19051        "SFTPEngine on",
19052        "SFTPLog $setup->{log_file}",
19053        "SFTPHostKey $rsa_host_key",
19054        "SFTPHostKey $dsa_host_key",
19055      ],
19056    },
19057  };
19058
19059  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
19060    $config);
19061
19062  # Open pipes, for use between the parent and child processes.  Specifically,
19063  # the child will indicate when it's done with its test by writing a message
19064  # to the parent.
19065  my ($rfh, $wfh);
19066  unless (pipe($rfh, $wfh)) {
19067    die("Can't open pipe: $!");
19068  }
19069
19070  require Net::SSH2;
19071
19072  my $ex;
19073
19074  # Fork child
19075  $self->handle_sigchld();
19076  defined(my $pid = fork()) or die("Can't fork: $!");
19077  if ($pid) {
19078    eval {
19079      my $ssh2 = Net::SSH2->new();
19080
19081      sleep(1);
19082
19083      unless ($ssh2->connect('127.0.0.1', $port)) {
19084        my ($err_code, $err_name, $err_str) = $ssh2->error();
19085        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
19086      }
19087
19088      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
19089        my ($err_code, $err_name, $err_str) = $ssh2->error();
19090        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
19091      }
19092
19093      my $sftp = $ssh2->sftp();
19094      unless ($sftp) {
19095        my ($err_code, $err_name, $err_str) = $ssh2->error();
19096        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
19097      }
19098
19099      my $path = 'test.d/test.lnk';
19100      my $attrs = $sftp->stat($path, 1);
19101      if ($attrs) {
19102        die("STAT $path succeeded unexpectedly");
19103      }
19104
19105      my ($err_code, $err_name) = $sftp->error();
19106      my $expected = 'SSH_FX_NO_SUCH_FILE';
19107      $self->assert($expected eq $err_name,
19108        test_msg("Expected error name '$expected', got '$err_name'"));
19109
19110      $sftp = undef;
19111      $ssh2->disconnect();
19112    };
19113    if ($@) {
19114      $ex = $@;
19115    }
19116
19117    $wfh->print("done\n");
19118    $wfh->flush();
19119
19120  } else {
19121    eval { server_wait($setup->{config_file}, $rfh) };
19122    if ($@) {
19123      warn($@);
19124      exit 1;
19125    }
19126
19127    exit 0;
19128  }
19129
19130  # Stop server
19131  server_stop($setup->{pid_file});
19132  $self->assert_child_ok($pid);
19133
19134  test_cleanup($setup->{log_file}, $ex);
19135}
19136
19137sub sftp_stat_rel_symlink_enoent_chrooted_bug4219 {
19138  my $self = shift;
19139  my $tmpdir = $self->{tmpdir};
19140  my $setup = test_setup($tmpdir, 'sftp');
19141
19142  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
19143  mkpath($test_dir);
19144
19145  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
19146
19147  # Change to the test directory in order to create a relative path in the
19148  # symlink we need
19149
19150  my $cwd = getcwd();
19151  unless (chdir($test_dir)) {
19152    die("Can't chdir to $test_dir: $!");
19153  }
19154
19155  unless (symlink('./test.txt', './test.lnk')) {
19156    die("Can't symlink 'test.lnk' to './test.txt': $!");
19157  }
19158
19159  unless (chdir($cwd)) {
19160    die("Can't chdir to $cwd: $!");
19161  }
19162
19163  if ($< == 0) {
19164    unless (chmod(0755, $test_dir)) {
19165      die("Can't set perms on $test_dir to 0755: $!");
19166    }
19167
19168    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
19169      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
19170    }
19171  }
19172
19173  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19174  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19175
19176  my $config = {
19177    PidFile => $setup->{pid_file},
19178    ScoreboardFile => $setup->{scoreboard_file},
19179    SystemLog => $setup->{log_file},
19180    TraceLog => $setup->{log_file},
19181    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19182
19183    AuthUserFile => $setup->{auth_user_file},
19184    AuthGroupFile => $setup->{auth_group_file},
19185
19186    DefaultRoot => '~',
19187
19188    IfModules => {
19189      'mod_delay.c' => {
19190        DelayEngine => 'off',
19191      },
19192
19193      'mod_sftp.c' => [
19194        "SFTPEngine on",
19195        "SFTPLog $setup->{log_file}",
19196        "SFTPHostKey $rsa_host_key",
19197        "SFTPHostKey $dsa_host_key",
19198      ],
19199    },
19200  };
19201
19202  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
19203    $config);
19204
19205  # Open pipes, for use between the parent and child processes.  Specifically,
19206  # the child will indicate when it's done with its test by writing a message
19207  # to the parent.
19208  my ($rfh, $wfh);
19209  unless (pipe($rfh, $wfh)) {
19210    die("Can't open pipe: $!");
19211  }
19212
19213  require Net::SSH2;
19214
19215  my $ex;
19216
19217  # Fork child
19218  $self->handle_sigchld();
19219  defined(my $pid = fork()) or die("Can't fork: $!");
19220  if ($pid) {
19221    eval {
19222      my $ssh2 = Net::SSH2->new();
19223
19224      sleep(1);
19225
19226      unless ($ssh2->connect('127.0.0.1', $port)) {
19227        my ($err_code, $err_name, $err_str) = $ssh2->error();
19228        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
19229      }
19230
19231      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
19232        my ($err_code, $err_name, $err_str) = $ssh2->error();
19233        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
19234      }
19235
19236      my $sftp = $ssh2->sftp();
19237      unless ($sftp) {
19238        my ($err_code, $err_name, $err_str) = $ssh2->error();
19239        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
19240      }
19241
19242      my $path = 'test.d/test.lnk';
19243      my $attrs = $sftp->stat($path, 1);
19244      if ($attrs) {
19245        die("STAT $path succeeded unexpectedly");
19246      }
19247
19248      my ($err_code, $err_name) = $sftp->error();
19249      my $expected = 'SSH_FX_NO_SUCH_FILE';
19250      $self->assert($expected eq $err_name,
19251        test_msg("Expected error name '$expected', got '$err_name'"));
19252
19253      $sftp = undef;
19254      $ssh2->disconnect();
19255    };
19256    if ($@) {
19257      $ex = $@;
19258    }
19259
19260    $wfh->print("done\n");
19261    $wfh->flush();
19262
19263  } else {
19264    eval { server_wait($setup->{config_file}, $rfh) };
19265    if ($@) {
19266      warn($@);
19267      exit 1;
19268    }
19269
19270    exit 0;
19271  }
19272
19273  # Stop server
19274  server_stop($setup->{pid_file});
19275  $self->assert_child_ok($pid);
19276
19277  test_cleanup($setup->{log_file}, $ex);
19278}
19279
19280sub sftp_fstat {
19281  my $self = shift;
19282  my $tmpdir = $self->{tmpdir};
19283
19284  my $config_file = "$tmpdir/sftp.conf";
19285  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
19286  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
19287
19288  my $log_file = test_get_logfile();
19289
19290  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
19291  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
19292
19293  my $user = 'proftpd';
19294  my $passwd = 'test';
19295  my $group = 'ftpd';
19296  my $home_dir = File::Spec->rel2abs($tmpdir);
19297  my $uid = 500;
19298  my $gid = 500;
19299
19300  # Make sure that, if we're running as root, that the home directory has
19301  # permissions/privs set for the account we create
19302  if ($< == 0) {
19303    unless (chmod(0755, $home_dir)) {
19304      die("Can't set perms on $home_dir to 0755: $!");
19305    }
19306
19307    unless (chown($uid, $gid, $home_dir)) {
19308      die("Can't set owner of $home_dir to $uid/$gid: $!");
19309    }
19310  }
19311
19312  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
19313    '/bin/bash');
19314  auth_group_write($auth_group_file, $group, $gid, $user);
19315
19316  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19317  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19318
19319  my $config = {
19320    PidFile => $pid_file,
19321    ScoreboardFile => $scoreboard_file,
19322    SystemLog => $log_file,
19323    TraceLog => $log_file,
19324    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19325
19326    AuthUserFile => $auth_user_file,
19327    AuthGroupFile => $auth_group_file,
19328
19329    IfModules => {
19330      'mod_delay.c' => {
19331        DelayEngine => 'off',
19332      },
19333
19334      'mod_sftp.c' => [
19335        "SFTPEngine on",
19336        "SFTPLog $log_file",
19337        "SFTPHostKey $rsa_host_key",
19338        "SFTPHostKey $dsa_host_key",
19339      ],
19340    },
19341  };
19342
19343  my ($port, $config_user, $config_group) = config_write($config_file, $config);
19344
19345  my $config_size = (stat($config_file))[7];
19346
19347  # Open pipes, for use between the parent and child processes.  Specifically,
19348  # the child will indicate when it's done with its test by writing a message
19349  # to the parent.
19350  my ($rfh, $wfh);
19351  unless (pipe($rfh, $wfh)) {
19352    die("Can't open pipe: $!");
19353  }
19354
19355  require Net::SSH2;
19356
19357  my $ex;
19358
19359  # Fork child
19360  $self->handle_sigchld();
19361  defined(my $pid = fork()) or die("Can't fork: $!");
19362  if ($pid) {
19363    eval {
19364      my $ssh2 = Net::SSH2->new();
19365
19366      sleep(1);
19367
19368      unless ($ssh2->connect('127.0.0.1', $port)) {
19369        my ($err_code, $err_name, $err_str) = $ssh2->error();
19370        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
19371      }
19372
19373      unless ($ssh2->auth_password($user, $passwd)) {
19374        my ($err_code, $err_name, $err_str) = $ssh2->error();
19375        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
19376      }
19377
19378      my $sftp = $ssh2->sftp();
19379      unless ($sftp) {
19380        my ($err_code, $err_name, $err_str) = $ssh2->error();
19381        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
19382      }
19383
19384      my $fh = $sftp->open('sftp.conf', O_RDONLY);
19385      unless ($fh) {
19386        my ($err_code, $err_name) = $sftp->error();
19387        die("Can't open sftp.conf: [$err_name] ($err_code)");
19388      }
19389
19390      my $attrs = $fh->stat();
19391      unless ($attrs) {
19392        my ($err_code, $err_name) = $sftp->error();
19393        die("FXP_FSTAT sftp.conf failed: [$err_name] ($err_code)");
19394      }
19395
19396      # Explicitly destroy the handle so that an FXP_CLOSE is sent.
19397      $fh = undef;
19398
19399      my $expected;
19400
19401      $expected = $config_size;
19402      my $file_size = $attrs->{size};
19403      $self->assert($expected == $file_size,
19404        test_msg("Expected '$expected', got '$file_size'"));
19405
19406      $expected = $<;
19407      my $file_uid = $attrs->{uid};
19408      $self->assert($expected == $file_uid,
19409        test_msg("Expected '$expected', got '$file_uid'"));
19410
19411      $expected = $(;
19412      my $file_gid = $attrs->{gid};
19413      $self->assert($expected == $file_gid,
19414        test_msg("Expected '$expected', got '$file_gid'"));
19415
19416      $sftp = undef;
19417      $ssh2->disconnect();
19418    };
19419
19420    if ($@) {
19421      $ex = $@;
19422    }
19423
19424    $wfh->print("done\n");
19425    $wfh->flush();
19426
19427  } else {
19428    eval { server_wait($config_file, $rfh) };
19429    if ($@) {
19430      warn($@);
19431      exit 1;
19432    }
19433
19434    exit 0;
19435  }
19436
19437  # Stop server
19438  server_stop($pid_file);
19439
19440  $self->assert_child_ok($pid);
19441
19442  if ($ex) {
19443    test_append_logfile($log_file, $ex);
19444    unlink($log_file);
19445
19446    die($ex);
19447  }
19448
19449  unlink($log_file);
19450}
19451
19452sub sftp_lstat {
19453  my $self = shift;
19454  my $tmpdir = $self->{tmpdir};
19455
19456  my $config_file = "$tmpdir/sftp.conf";
19457  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
19458  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
19459
19460  my $log_file = test_get_logfile();
19461
19462  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
19463  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
19464
19465  my $user = 'proftpd';
19466  my $passwd = 'test';
19467  my $group = 'ftpd';
19468  my $home_dir = File::Spec->rel2abs($tmpdir);
19469  my $uid = 500;
19470  my $gid = 500;
19471
19472  # Make sure that, if we're running as root, that the home directory has
19473  # permissions/privs set for the account we create
19474  if ($< == 0) {
19475    unless (chmod(0755, $home_dir)) {
19476      die("Can't set perms on $home_dir to 0755: $!");
19477    }
19478
19479    unless (chown($uid, $gid, $home_dir)) {
19480      die("Can't set owner of $home_dir to $uid/$gid: $!");
19481    }
19482  }
19483
19484  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
19485    '/bin/bash');
19486  auth_group_write($auth_group_file, $group, $gid, $user);
19487
19488  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19489  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19490
19491  my $config = {
19492    PidFile => $pid_file,
19493    ScoreboardFile => $scoreboard_file,
19494    SystemLog => $log_file,
19495    TraceLog => $log_file,
19496    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19497
19498    AuthUserFile => $auth_user_file,
19499    AuthGroupFile => $auth_group_file,
19500
19501    IfModules => {
19502      'mod_delay.c' => {
19503        DelayEngine => 'off',
19504      },
19505
19506      'mod_sftp.c' => [
19507        "SFTPEngine on",
19508        "SFTPLog $log_file",
19509        "SFTPHostKey $rsa_host_key",
19510        "SFTPHostKey $dsa_host_key",
19511      ],
19512    },
19513  };
19514
19515  my ($port, $config_user, $config_group) = config_write($config_file, $config);
19516
19517  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
19518  if (open(my $fh, "> $test_file")) {
19519    print $fh "ABCD" x 1024;
19520    unless (close($fh)) {
19521      die("Can't write $test_file: $!");
19522    }
19523
19524  } else {
19525    die("Can't open $test_file: $!");
19526  }
19527
19528  my $test_size = (stat($test_file))[7];
19529
19530  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
19531  unless (symlink($test_file, $test_symlink)) {
19532    die("Can't symlink $test_symlink to $test_file: $!");
19533  }
19534
19535  my $test_symlink_size = (lstat($test_symlink))[7];
19536
19537  # Open pipes, for use between the parent and child processes.  Specifically,
19538  # the child will indicate when it's done with its test by writing a message
19539  # to the parent.
19540  my ($rfh, $wfh);
19541  unless (pipe($rfh, $wfh)) {
19542    die("Can't open pipe: $!");
19543  }
19544
19545  require Net::SSH2;
19546
19547  my $ex;
19548
19549  # Fork child
19550  $self->handle_sigchld();
19551  defined(my $pid = fork()) or die("Can't fork: $!");
19552  if ($pid) {
19553    eval {
19554      my $ssh2 = Net::SSH2->new();
19555
19556      sleep(1);
19557
19558      unless ($ssh2->connect('127.0.0.1', $port)) {
19559        my ($err_code, $err_name, $err_str) = $ssh2->error();
19560        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
19561      }
19562
19563      unless ($ssh2->auth_password($user, $passwd)) {
19564        my ($err_code, $err_name, $err_str) = $ssh2->error();
19565        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
19566      }
19567
19568      my $sftp = $ssh2->sftp();
19569      unless ($sftp) {
19570        my ($err_code, $err_name, $err_str) = $ssh2->error();
19571        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
19572      }
19573
19574      my $attrs = $sftp->stat('test.lnk', 0);
19575      unless ($attrs) {
19576        my ($err_code, $err_name) = $sftp->error();
19577        die("FXP_LSTAT test.lnk failed: [$err_name] ($err_code)");
19578      }
19579
19580      my $expected;
19581
19582      $expected = $test_symlink_size;
19583      my $file_size = $attrs->{size};
19584      $self->assert($expected == $file_size,
19585        test_msg("Expected file size '$expected', got '$file_size'"));
19586
19587      $expected = $<;
19588      my $file_uid = $attrs->{uid};
19589      $self->assert($expected == $file_uid,
19590        test_msg("Expected file UID '$expected', got '$file_uid'"));
19591
19592      $expected = $(;
19593      my $file_gid = $attrs->{gid};
19594      $self->assert($expected == $file_gid,
19595        test_msg("Expected file GID '$expected', got '$file_gid'"));
19596
19597      $sftp = undef;
19598      $ssh2->disconnect();
19599    };
19600
19601    if ($@) {
19602      $ex = $@;
19603    }
19604
19605    $wfh->print("done\n");
19606    $wfh->flush();
19607
19608  } else {
19609    eval { server_wait($config_file, $rfh) };
19610    if ($@) {
19611      warn($@);
19612      exit 1;
19613    }
19614
19615    exit 0;
19616  }
19617
19618  # Stop server
19619  server_stop($pid_file);
19620
19621  $self->assert_child_ok($pid);
19622
19623  if ($ex) {
19624    test_append_logfile($log_file, $ex);
19625    unlink($log_file);
19626
19627    die($ex);
19628  }
19629
19630  unlink($log_file);
19631}
19632
19633sub sftp_setstat {
19634  my $self = shift;
19635  my $tmpdir = $self->{tmpdir};
19636  my $setup = test_setup($tmpdir, 'sftp');
19637
19638  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19639  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19640
19641  my $config = {
19642    PidFile => $setup->{pid_file},
19643    ScoreboardFile => $setup->{scoreboard_file},
19644    SystemLog => $setup->{log_file},
19645    TraceLog => $setup->{log_file},
19646    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19647
19648    AuthUserFile => $setup->{auth_user_file},
19649    AuthGroupFile => $setup->{auth_group_file},
19650
19651    IfModules => {
19652      'mod_delay.c' => {
19653        DelayEngine => 'off',
19654      },
19655
19656      'mod_sftp.c' => [
19657        "SFTPEngine on",
19658        "SFTPLog $setup->{log_file}",
19659        "SFTPHostKey $rsa_host_key",
19660        "SFTPHostKey $dsa_host_key",
19661      ],
19662    },
19663  };
19664
19665  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
19666    $config);
19667
19668  # Open pipes, for use between the parent and child processes.  Specifically,
19669  # the child will indicate when it's done with its test by writing a message
19670  # to the parent.
19671  my ($rfh, $wfh);
19672  unless (pipe($rfh, $wfh)) {
19673    die("Can't open pipe: $!");
19674  }
19675
19676  require Net::SSH2;
19677
19678  my $ex;
19679
19680  # Fork child
19681  $self->handle_sigchld();
19682  defined(my $pid = fork()) or die("Can't fork: $!");
19683  if ($pid) {
19684    eval {
19685      my $ssh2 = Net::SSH2->new();
19686
19687      sleep(1);
19688
19689      unless ($ssh2->connect('127.0.0.1', $port)) {
19690        my ($err_code, $err_name, $err_str) = $ssh2->error();
19691        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
19692      }
19693
19694      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
19695        my ($err_code, $err_name, $err_str) = $ssh2->error();
19696        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
19697      }
19698
19699      my $sftp = $ssh2->sftp();
19700      unless ($sftp) {
19701        my ($err_code, $err_name, $err_str) = $ssh2->error();
19702        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
19703      }
19704
19705      my $path = 'sftp.conf';
19706      my $res = $sftp->setstat($path,
19707        atime => 0,
19708        mtime => 0,
19709      );
19710      unless ($res) {
19711        my ($err_code, $err_name) = $sftp->error();
19712        die("Can't setstat $path: [$err_name] ($err_code)");
19713      }
19714
19715      my $attrs = $sftp->stat($path);
19716      unless ($attrs) {
19717        my ($err_code, $err_name) = $sftp->error();
19718        die("STAT $path failed: [$err_name] ($err_code)");
19719      }
19720
19721      $sftp = undef;
19722      $ssh2->disconnect();
19723
19724      my $expected = 0;
19725      my $file_atime = $attrs->{atime};
19726      $self->assert($expected == $file_atime,
19727        test_msg("Expected file atime '$expected', got '$file_atime'"));
19728
19729      my $file_mtime = $attrs->{mtime};
19730      $self->assert($expected == $file_mtime,
19731        test_msg("Expected file mtime '$expected', got '$file_mtime'"));
19732    };
19733    if ($@) {
19734      $ex = $@;
19735    }
19736
19737    $wfh->print("done\n");
19738    $wfh->flush();
19739
19740  } else {
19741    eval { server_wait($setup->{config_file}, $rfh) };
19742    if ($@) {
19743      warn($@);
19744      exit 1;
19745    }
19746
19747    exit 0;
19748  }
19749
19750  # Stop server
19751  server_stop($setup->{pid_file});
19752  $self->assert_child_ok($pid);
19753
19754  test_cleanup($setup->{log_file}, $ex);
19755}
19756
19757sub sftp_setstat_sgid {
19758  my $self = shift;
19759  my $tmpdir = $self->{tmpdir};
19760
19761  my $config_file = "$tmpdir/sftp.conf";
19762  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
19763  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
19764
19765  my $log_file = test_get_logfile();
19766
19767  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
19768  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
19769
19770  my $user = 'proftpd';
19771  my $passwd = 'test';
19772  my $group = 'ftpd';
19773  my $home_dir = File::Spec->rel2abs($tmpdir);
19774  my $uid = 500;
19775  my $gid = 500;
19776
19777  # Make sure that, if we're running as root, that the home directory has
19778  # permissions/privs set for the account we create
19779  if ($< == 0) {
19780    unless (chmod(0755, $home_dir)) {
19781      die("Can't set perms on $home_dir to 0755: $!");
19782    }
19783
19784    unless (chown($uid, $gid, $home_dir)) {
19785      die("Can't set owner of $home_dir to $uid/$gid: $!");
19786    }
19787  }
19788
19789  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
19790    '/bin/bash');
19791  auth_group_write($auth_group_file, $group, $gid, $user);
19792
19793  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19794  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19795
19796  my $config = {
19797    PidFile => $pid_file,
19798    ScoreboardFile => $scoreboard_file,
19799    SystemLog => $log_file,
19800    TraceLog => $log_file,
19801    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19802
19803    AuthUserFile => $auth_user_file,
19804    AuthGroupFile => $auth_group_file,
19805
19806    IfModules => {
19807      'mod_delay.c' => {
19808        DelayEngine => 'off',
19809      },
19810
19811      'mod_sftp.c' => [
19812        "SFTPEngine on",
19813        "SFTPLog $log_file",
19814        "SFTPHostKey $rsa_host_key",
19815        "SFTPHostKey $dsa_host_key",
19816      ],
19817    },
19818  };
19819
19820  my ($port, $config_user, $config_group) = config_write($config_file, $config);
19821
19822  # Open pipes, for use between the parent and child processes.  Specifically,
19823  # the child will indicate when it's done with its test by writing a message
19824  # to the parent.
19825  my ($rfh, $wfh);
19826  unless (pipe($rfh, $wfh)) {
19827    die("Can't open pipe: $!");
19828  }
19829
19830  require Net::SSH2;
19831
19832  my $ex;
19833
19834  # Fork child
19835  $self->handle_sigchld();
19836  defined(my $pid = fork()) or die("Can't fork: $!");
19837  if ($pid) {
19838    eval {
19839      my $ssh2 = Net::SSH2->new();
19840
19841      sleep(1);
19842
19843      unless ($ssh2->connect('127.0.0.1', $port)) {
19844        my ($err_code, $err_name, $err_str) = $ssh2->error();
19845        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
19846      }
19847
19848      unless ($ssh2->auth_password($user, $passwd)) {
19849        my ($err_code, $err_name, $err_str) = $ssh2->error();
19850        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
19851      }
19852
19853      my $sftp = $ssh2->sftp();
19854      unless ($sftp) {
19855        my ($err_code, $err_name, $err_str) = $ssh2->error();
19856        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
19857      }
19858
19859      my $res = $sftp->setstat('sftp.conf',
19860        mode => oct(2664),
19861      );
19862      unless ($res) {
19863        my ($err_code, $err_name) = $sftp->error();
19864        die("Can't setstat sftp.conf: [$err_name] ($err_code)");
19865      }
19866
19867      my $attrs = $sftp->stat('sftp.conf');
19868      unless ($attrs) {
19869        my ($err_code, $err_name) = $sftp->error();
19870        die("FXP_STAT sftp.conf failed: [$err_name] ($err_code)");
19871      }
19872
19873      my $expected = '2664';
19874      my $file_mode = sprintf("%lo", (34228 & 07777));
19875      $self->assert($expected eq $file_mode,
19876        test_msg("Expected '$expected', got '$file_mode'"));
19877
19878      $sftp = undef;
19879      $ssh2->disconnect();
19880    };
19881
19882    if ($@) {
19883      $ex = $@;
19884    }
19885
19886    $wfh->print("done\n");
19887    $wfh->flush();
19888
19889  } else {
19890    eval { server_wait($config_file, $rfh) };
19891    if ($@) {
19892      warn($@);
19893      exit 1;
19894    }
19895
19896    exit 0;
19897  }
19898
19899  # Stop server
19900  server_stop($pid_file);
19901
19902  $self->assert_child_ok($pid);
19903
19904  if ($ex) {
19905    test_append_logfile($log_file, $ex);
19906    unlink($log_file);
19907
19908    die($ex);
19909  }
19910
19911  unlink($log_file);
19912}
19913
19914sub sftp_setstat_abs_symlink {
19915  my $self = shift;
19916  my $tmpdir = $self->{tmpdir};
19917  my $setup = test_setup($tmpdir, 'sftp');
19918
19919  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
19920  mkpath($test_dir);
19921
19922  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
19923  if (open(my $fh, "> $test_file")) {
19924    close($fh);
19925
19926  } else {
19927    die("Can't open $test_file: $!");
19928  }
19929
19930  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
19931
19932  my $dst_path = $test_file;
19933  if ($^O eq 'darwin') {
19934    # MacOSX-specific hack
19935    $dst_path = '/private' . $dst_path;
19936  }
19937
19938  unless (symlink($dst_path, $test_symlink)) {
19939    die("Can't symlink $test_symlink to $dst_path: $!");
19940  }
19941
19942  if ($< == 0) {
19943    unless (chmod(0755, $test_dir)) {
19944      die("Can't set perms on $test_dir to 0755: $!");
19945    }
19946
19947    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
19948      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
19949    }
19950  }
19951
19952  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
19953  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
19954
19955  my $config = {
19956    PidFile => $setup->{pid_file},
19957    ScoreboardFile => $setup->{scoreboard_file},
19958    SystemLog => $setup->{log_file},
19959    TraceLog => $setup->{log_file},
19960    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
19961
19962    AuthUserFile => $setup->{auth_user_file},
19963    AuthGroupFile => $setup->{auth_group_file},
19964
19965    IfModules => {
19966      'mod_delay.c' => {
19967        DelayEngine => 'off',
19968      },
19969
19970      'mod_sftp.c' => [
19971        "SFTPEngine on",
19972        "SFTPLog $setup->{log_file}",
19973        "SFTPHostKey $rsa_host_key",
19974        "SFTPHostKey $dsa_host_key",
19975      ],
19976    },
19977  };
19978
19979  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
19980    $config);
19981
19982  # Open pipes, for use between the parent and child processes.  Specifically,
19983  # the child will indicate when it's done with its test by writing a message
19984  # to the parent.
19985  my ($rfh, $wfh);
19986  unless (pipe($rfh, $wfh)) {
19987    die("Can't open pipe: $!");
19988  }
19989
19990  require Net::SSH2;
19991
19992  my $ex;
19993
19994  # Fork child
19995  $self->handle_sigchld();
19996  defined(my $pid = fork()) or die("Can't fork: $!");
19997  if ($pid) {
19998    eval {
19999      my $ssh2 = Net::SSH2->new();
20000
20001      sleep(1);
20002
20003      unless ($ssh2->connect('127.0.0.1', $port)) {
20004        my ($err_code, $err_name, $err_str) = $ssh2->error();
20005        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20006      }
20007
20008      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20009        my ($err_code, $err_name, $err_str) = $ssh2->error();
20010        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20011      }
20012
20013      my $sftp = $ssh2->sftp();
20014      unless ($sftp) {
20015        my ($err_code, $err_name, $err_str) = $ssh2->error();
20016        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20017      }
20018
20019      my $path = 'test.d/test.lnk';
20020      my $res = $sftp->setstat($path,
20021        atime => 0,
20022        mtime => 0,
20023      );
20024      unless ($res) {
20025        my ($err_code, $err_name) = $sftp->error();
20026        die("Can't setstat $path: [$err_name] ($err_code)");
20027      }
20028
20029      my $attrs = $sftp->stat($path);
20030      unless ($attrs) {
20031        my ($err_code, $err_name) = $sftp->error();
20032        die("STAT $path failed: [$err_name] ($err_code)");
20033      }
20034
20035      $sftp = undef;
20036      $ssh2->disconnect();
20037
20038      my $expected = 0;
20039      my $file_atime = $attrs->{atime};
20040      $self->assert($expected == $file_atime,
20041        test_msg("Expected file atime '$expected', got '$file_atime'"));
20042
20043      my $file_mtime = $attrs->{mtime};
20044      $self->assert($expected == $file_mtime,
20045        test_msg("Expected file mtime '$expected', got '$file_mtime'"));
20046    };
20047    if ($@) {
20048      $ex = $@;
20049    }
20050
20051    $wfh->print("done\n");
20052    $wfh->flush();
20053
20054  } else {
20055    eval { server_wait($setup->{config_file}, $rfh) };
20056    if ($@) {
20057      warn($@);
20058      exit 1;
20059    }
20060
20061    exit 0;
20062  }
20063
20064  # Stop server
20065  server_stop($setup->{pid_file});
20066  $self->assert_child_ok($pid);
20067
20068  test_cleanup($setup->{log_file}, $ex);
20069}
20070
20071sub sftp_setstat_abs_symlink_chrooted_bug4219 {
20072  my $self = shift;
20073  my $tmpdir = $self->{tmpdir};
20074  my $setup = test_setup($tmpdir, 'sftp');
20075
20076  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20077  mkpath($test_dir);
20078
20079  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20080  if (open(my $fh, "> $test_file")) {
20081    close($fh);
20082
20083  } else {
20084    die("Can't open $test_file: $!");
20085  }
20086
20087  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
20088
20089  my $dst_path = $test_file;
20090  if ($^O eq 'darwin') {
20091    # MacOSX-specific hack
20092    $dst_path = '/private' . $dst_path;
20093  }
20094
20095  unless (symlink($dst_path, $test_symlink)) {
20096    die("Can't symlink $test_symlink to $dst_path: $!");
20097  }
20098
20099  if ($< == 0) {
20100    unless (chmod(0755, $test_dir)) {
20101      die("Can't set perms on $test_dir to 0755: $!");
20102    }
20103
20104    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
20105      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
20106    }
20107  }
20108
20109  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
20110  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
20111
20112  my $config = {
20113    PidFile => $setup->{pid_file},
20114    ScoreboardFile => $setup->{scoreboard_file},
20115    SystemLog => $setup->{log_file},
20116    TraceLog => $setup->{log_file},
20117    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
20118
20119    AuthUserFile => $setup->{auth_user_file},
20120    AuthGroupFile => $setup->{auth_group_file},
20121
20122    DefaultRoot => '~',
20123
20124    IfModules => {
20125      'mod_delay.c' => {
20126        DelayEngine => 'off',
20127      },
20128
20129      'mod_sftp.c' => [
20130        "SFTPEngine on",
20131        "SFTPLog $setup->{log_file}",
20132        "SFTPHostKey $rsa_host_key",
20133        "SFTPHostKey $dsa_host_key",
20134      ],
20135    },
20136  };
20137
20138  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
20139    $config);
20140
20141  # Open pipes, for use between the parent and child processes.  Specifically,
20142  # the child will indicate when it's done with its test by writing a message
20143  # to the parent.
20144  my ($rfh, $wfh);
20145  unless (pipe($rfh, $wfh)) {
20146    die("Can't open pipe: $!");
20147  }
20148
20149  require Net::SSH2;
20150
20151  my $ex;
20152
20153  # Fork child
20154  $self->handle_sigchld();
20155  defined(my $pid = fork()) or die("Can't fork: $!");
20156  if ($pid) {
20157    eval {
20158      my $ssh2 = Net::SSH2->new();
20159
20160      sleep(1);
20161
20162      unless ($ssh2->connect('127.0.0.1', $port)) {
20163        my ($err_code, $err_name, $err_str) = $ssh2->error();
20164        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20165      }
20166
20167      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20168        my ($err_code, $err_name, $err_str) = $ssh2->error();
20169        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20170      }
20171
20172      my $sftp = $ssh2->sftp();
20173      unless ($sftp) {
20174        my ($err_code, $err_name, $err_str) = $ssh2->error();
20175        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20176      }
20177
20178      my $path = 'test.d/test.lnk';
20179      my $res = $sftp->setstat($path,
20180        atime => 0,
20181        mtime => 0,
20182      );
20183      unless ($res) {
20184        my ($err_code, $err_name) = $sftp->error();
20185        die("Can't setstat $path: [$err_name] ($err_code)");
20186      }
20187
20188      my $attrs = $sftp->stat($path);
20189      unless ($attrs) {
20190        my ($err_code, $err_name) = $sftp->error();
20191        die("STAT $path failed: [$err_name] ($err_code)");
20192      }
20193
20194      $sftp = undef;
20195      $ssh2->disconnect();
20196
20197      my $expected = 0;
20198      my $file_atime = $attrs->{atime};
20199      $self->assert($expected == $file_atime,
20200        test_msg("Expected file atime '$expected', got '$file_atime'"));
20201
20202      my $file_mtime = $attrs->{mtime};
20203      $self->assert($expected == $file_mtime,
20204        test_msg("Expected file mtime '$expected', got '$file_mtime'"));
20205    };
20206    if ($@) {
20207      $ex = $@;
20208    }
20209
20210    $wfh->print("done\n");
20211    $wfh->flush();
20212
20213  } else {
20214    eval { server_wait($setup->{config_file}, $rfh) };
20215    if ($@) {
20216      warn($@);
20217      exit 1;
20218    }
20219
20220    exit 0;
20221  }
20222
20223  # Stop server
20224  server_stop($setup->{pid_file});
20225  $self->assert_child_ok($pid);
20226
20227  test_cleanup($setup->{log_file}, $ex);
20228}
20229
20230sub sftp_setstat_abs_symlink_enoent {
20231  my $self = shift;
20232  my $tmpdir = $self->{tmpdir};
20233  my $setup = test_setup($tmpdir, 'sftp');
20234
20235  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20236  mkpath($test_dir);
20237
20238  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20239  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
20240
20241  my $dst_path = $test_file;
20242  if ($^O eq 'darwin') {
20243    # MacOSX-specific hack
20244    $dst_path = '/private' . $dst_path;
20245  }
20246
20247  unless (symlink($dst_path, $test_symlink)) {
20248    die("Can't symlink $test_symlink to $dst_path: $!");
20249  }
20250
20251  if ($< == 0) {
20252    unless (chmod(0755, $test_dir)) {
20253      die("Can't set perms on $test_dir to 0755: $!");
20254    }
20255
20256    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
20257      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
20258    }
20259  }
20260
20261  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
20262  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
20263
20264  my $config = {
20265    PidFile => $setup->{pid_file},
20266    ScoreboardFile => $setup->{scoreboard_file},
20267    SystemLog => $setup->{log_file},
20268    TraceLog => $setup->{log_file},
20269    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
20270
20271    AuthUserFile => $setup->{auth_user_file},
20272    AuthGroupFile => $setup->{auth_group_file},
20273
20274    IfModules => {
20275      'mod_delay.c' => {
20276        DelayEngine => 'off',
20277      },
20278
20279      'mod_sftp.c' => [
20280        "SFTPEngine on",
20281        "SFTPLog $setup->{log_file}",
20282        "SFTPHostKey $rsa_host_key",
20283        "SFTPHostKey $dsa_host_key",
20284      ],
20285    },
20286  };
20287
20288  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
20289    $config);
20290
20291  # Open pipes, for use between the parent and child processes.  Specifically,
20292  # the child will indicate when it's done with its test by writing a message
20293  # to the parent.
20294  my ($rfh, $wfh);
20295  unless (pipe($rfh, $wfh)) {
20296    die("Can't open pipe: $!");
20297  }
20298
20299  require Net::SSH2;
20300
20301  my $ex;
20302
20303  # Fork child
20304  $self->handle_sigchld();
20305  defined(my $pid = fork()) or die("Can't fork: $!");
20306  if ($pid) {
20307    eval {
20308      my $ssh2 = Net::SSH2->new();
20309
20310      sleep(1);
20311
20312      unless ($ssh2->connect('127.0.0.1', $port)) {
20313        my ($err_code, $err_name, $err_str) = $ssh2->error();
20314        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20315      }
20316
20317      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20318        my ($err_code, $err_name, $err_str) = $ssh2->error();
20319        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20320      }
20321
20322      my $sftp = $ssh2->sftp();
20323      unless ($sftp) {
20324        my ($err_code, $err_name, $err_str) = $ssh2->error();
20325        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20326      }
20327
20328      my $path = 'test.d/test.lnk';
20329      my $res = $sftp->setstat($path,
20330        atime => 0,
20331        mtime => 0,
20332      );
20333      if ($res) {
20334        die("SETSTAT $path succeeded unexpectedly");
20335      }
20336
20337      my ($err_code, $err_name) = $sftp->error();
20338      $sftp = undef;
20339      $ssh2->disconnect();
20340
20341      my $expected = 'SSH_FX_NO_SUCH_FILE';
20342      $self->assert($expected eq $err_name,
20343        test_msg("Expected error name '$expected', got '$err_name'"));
20344    };
20345    if ($@) {
20346      $ex = $@;
20347    }
20348
20349    $wfh->print("done\n");
20350    $wfh->flush();
20351
20352  } else {
20353    eval { server_wait($setup->{config_file}, $rfh) };
20354    if ($@) {
20355      warn($@);
20356      exit 1;
20357    }
20358
20359    exit 0;
20360  }
20361
20362  # Stop server
20363  server_stop($setup->{pid_file});
20364  $self->assert_child_ok($pid);
20365
20366  test_cleanup($setup->{log_file}, $ex);
20367}
20368
20369sub sftp_setstat_abs_symlink_enoent_chrooted_bug4219 {
20370  my $self = shift;
20371  my $tmpdir = $self->{tmpdir};
20372  my $setup = test_setup($tmpdir, 'sftp');
20373
20374  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20375  mkpath($test_dir);
20376
20377  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20378  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
20379
20380  my $dst_path = $test_file;
20381  if ($^O eq 'darwin') {
20382    # MacOSX-specific hack
20383    $dst_path = '/private' . $dst_path;
20384  }
20385
20386  unless (symlink($dst_path, $test_symlink)) {
20387    die("Can't symlink $test_symlink to $dst_path: $!");
20388  }
20389
20390  if ($< == 0) {
20391    unless (chmod(0755, $test_dir)) {
20392      die("Can't set perms on $test_dir to 0755: $!");
20393    }
20394
20395    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
20396      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
20397    }
20398  }
20399
20400  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
20401  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
20402
20403  my $config = {
20404    PidFile => $setup->{pid_file},
20405    ScoreboardFile => $setup->{scoreboard_file},
20406    SystemLog => $setup->{log_file},
20407    TraceLog => $setup->{log_file},
20408    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
20409
20410    AuthUserFile => $setup->{auth_user_file},
20411    AuthGroupFile => $setup->{auth_group_file},
20412
20413    DefaultRoot => '~',
20414
20415    IfModules => {
20416      'mod_delay.c' => {
20417        DelayEngine => 'off',
20418      },
20419
20420      'mod_sftp.c' => [
20421        "SFTPEngine on",
20422        "SFTPLog $setup->{log_file}",
20423        "SFTPHostKey $rsa_host_key",
20424        "SFTPHostKey $dsa_host_key",
20425      ],
20426    },
20427  };
20428
20429  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
20430    $config);
20431
20432  # Open pipes, for use between the parent and child processes.  Specifically,
20433  # the child will indicate when it's done with its test by writing a message
20434  # to the parent.
20435  my ($rfh, $wfh);
20436  unless (pipe($rfh, $wfh)) {
20437    die("Can't open pipe: $!");
20438  }
20439
20440  require Net::SSH2;
20441
20442  my $ex;
20443
20444  # Fork child
20445  $self->handle_sigchld();
20446  defined(my $pid = fork()) or die("Can't fork: $!");
20447  if ($pid) {
20448    eval {
20449      my $ssh2 = Net::SSH2->new();
20450
20451      sleep(1);
20452
20453      unless ($ssh2->connect('127.0.0.1', $port)) {
20454        my ($err_code, $err_name, $err_str) = $ssh2->error();
20455        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20456      }
20457
20458      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20459        my ($err_code, $err_name, $err_str) = $ssh2->error();
20460        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20461      }
20462
20463      my $sftp = $ssh2->sftp();
20464      unless ($sftp) {
20465        my ($err_code, $err_name, $err_str) = $ssh2->error();
20466        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20467      }
20468
20469      my $path = 'test.d/test.lnk';
20470      my $res = $sftp->setstat($path,
20471        atime => 0,
20472        mtime => 0,
20473      );
20474      if ($res) {
20475        die("SETSTAT $path succeeded unexpectedly");
20476      }
20477
20478      my ($err_code, $err_name) = $sftp->error();
20479      $sftp = undef;
20480      $ssh2->disconnect();
20481
20482      my $expected = 'SSH_FX_NO_SUCH_FILE';
20483      $self->assert($expected eq $err_name,
20484        test_msg("Expected error name '$expected', got '$err_name'"));
20485    };
20486    if ($@) {
20487      $ex = $@;
20488    }
20489
20490    $wfh->print("done\n");
20491    $wfh->flush();
20492
20493  } else {
20494    eval { server_wait($setup->{config_file}, $rfh) };
20495    if ($@) {
20496      warn($@);
20497      exit 1;
20498    }
20499
20500    exit 0;
20501  }
20502
20503  # Stop server
20504  server_stop($setup->{pid_file});
20505  $self->assert_child_ok($pid);
20506
20507  test_cleanup($setup->{log_file}, $ex);
20508}
20509
20510sub sftp_setstat_rel_symlink {
20511  my $self = shift;
20512  my $tmpdir = $self->{tmpdir};
20513  my $setup = test_setup($tmpdir, 'sftp');
20514
20515  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20516  mkpath($test_dir);
20517
20518  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20519  if (open(my $fh, "> $test_file")) {
20520    close($fh);
20521
20522  } else {
20523    die("Can't open $test_file: $!");
20524  }
20525
20526  # Change to the test directory in order to create a relative path in the
20527  # symlink we need
20528
20529  my $cwd = getcwd();
20530  unless (chdir($test_dir)) {
20531    die("Can't chdir to $test_dir: $!");
20532  }
20533
20534  unless (symlink('./test.txt', './test.lnk')) {
20535    die("Can't symlink 'test.lnk' to './test.txt': $!");
20536  }
20537
20538  unless (chdir($cwd)) {
20539    die("Can't chdir to $cwd: $!");
20540  }
20541
20542  if ($< == 0) {
20543    unless (chmod(0755, $test_dir)) {
20544      die("Can't set perms on $test_dir to 0755: $!");
20545    }
20546
20547    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
20548      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
20549    }
20550  }
20551
20552  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
20553  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
20554
20555  my $config = {
20556    PidFile => $setup->{pid_file},
20557    ScoreboardFile => $setup->{scoreboard_file},
20558    SystemLog => $setup->{log_file},
20559    TraceLog => $setup->{log_file},
20560    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
20561
20562    AuthUserFile => $setup->{auth_user_file},
20563    AuthGroupFile => $setup->{auth_group_file},
20564
20565    IfModules => {
20566      'mod_delay.c' => {
20567        DelayEngine => 'off',
20568      },
20569
20570      'mod_sftp.c' => [
20571        "SFTPEngine on",
20572        "SFTPLog $setup->{log_file}",
20573        "SFTPHostKey $rsa_host_key",
20574        "SFTPHostKey $dsa_host_key",
20575      ],
20576    },
20577  };
20578
20579  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
20580    $config);
20581
20582  # Open pipes, for use between the parent and child processes.  Specifically,
20583  # the child will indicate when it's done with its test by writing a message
20584  # to the parent.
20585  my ($rfh, $wfh);
20586  unless (pipe($rfh, $wfh)) {
20587    die("Can't open pipe: $!");
20588  }
20589
20590  require Net::SSH2;
20591
20592  my $ex;
20593
20594  # Fork child
20595  $self->handle_sigchld();
20596  defined(my $pid = fork()) or die("Can't fork: $!");
20597  if ($pid) {
20598    eval {
20599      my $ssh2 = Net::SSH2->new();
20600
20601      sleep(1);
20602
20603      unless ($ssh2->connect('127.0.0.1', $port)) {
20604        my ($err_code, $err_name, $err_str) = $ssh2->error();
20605        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20606      }
20607
20608      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20609        my ($err_code, $err_name, $err_str) = $ssh2->error();
20610        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20611      }
20612
20613      my $sftp = $ssh2->sftp();
20614      unless ($sftp) {
20615        my ($err_code, $err_name, $err_str) = $ssh2->error();
20616        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20617      }
20618
20619      my $path = 'test.d/test.lnk';
20620      my $res = $sftp->setstat($path,
20621        atime => 0,
20622        mtime => 0,
20623      );
20624      unless ($res) {
20625        my ($err_code, $err_name) = $sftp->error();
20626        die("Can't setstat $path: [$err_name] ($err_code)");
20627      }
20628
20629      my $attrs = $sftp->stat($path);
20630      unless ($attrs) {
20631        my ($err_code, $err_name) = $sftp->error();
20632        die("STAT $path failed: [$err_name] ($err_code)");
20633      }
20634
20635      $sftp = undef;
20636      $ssh2->disconnect();
20637
20638      my $expected = 0;
20639      my $file_atime = $attrs->{atime};
20640      $self->assert($expected == $file_atime,
20641        test_msg("Expected file atime '$expected', got '$file_atime'"));
20642
20643      my $file_mtime = $attrs->{mtime};
20644      $self->assert($expected == $file_mtime,
20645        test_msg("Expected file mtime '$expected', got '$file_mtime'"));
20646    };
20647    if ($@) {
20648      $ex = $@;
20649    }
20650
20651    $wfh->print("done\n");
20652    $wfh->flush();
20653
20654  } else {
20655    eval { server_wait($setup->{config_file}, $rfh) };
20656    if ($@) {
20657      warn($@);
20658      exit 1;
20659    }
20660
20661    exit 0;
20662  }
20663
20664  # Stop server
20665  server_stop($setup->{pid_file});
20666  $self->assert_child_ok($pid);
20667
20668  test_cleanup($setup->{log_file}, $ex);
20669}
20670
20671sub sftp_setstat_rel_symlink_chrooted_bug4219 {
20672  my $self = shift;
20673  my $tmpdir = $self->{tmpdir};
20674  my $setup = test_setup($tmpdir, 'sftp');
20675
20676  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20677  mkpath($test_dir);
20678
20679  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20680  if (open(my $fh, "> $test_file")) {
20681    close($fh);
20682
20683  } else {
20684    die("Can't open $test_file: $!");
20685  }
20686
20687  # Change to the test directory in order to create a relative path in the
20688  # symlink we need
20689
20690  my $cwd = getcwd();
20691  unless (chdir($test_dir)) {
20692    die("Can't chdir to $test_dir: $!");
20693  }
20694
20695  unless (symlink('./test.txt', './test.lnk')) {
20696    die("Can't symlink 'test.lnk' to './test.txt': $!");
20697  }
20698
20699  unless (chdir($cwd)) {
20700    die("Can't chdir to $cwd: $!");
20701  }
20702
20703  if ($< == 0) {
20704    unless (chmod(0755, $test_dir)) {
20705      die("Can't set perms on $test_dir to 0755: $!");
20706    }
20707
20708    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
20709      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
20710    }
20711  }
20712
20713  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
20714  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
20715
20716  my $config = {
20717    PidFile => $setup->{pid_file},
20718    ScoreboardFile => $setup->{scoreboard_file},
20719    SystemLog => $setup->{log_file},
20720    TraceLog => $setup->{log_file},
20721    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
20722
20723    AuthUserFile => $setup->{auth_user_file},
20724    AuthGroupFile => $setup->{auth_group_file},
20725
20726    DefaultRoot => '~',
20727
20728    IfModules => {
20729      'mod_delay.c' => {
20730        DelayEngine => 'off',
20731      },
20732
20733      'mod_sftp.c' => [
20734        "SFTPEngine on",
20735        "SFTPLog $setup->{log_file}",
20736        "SFTPHostKey $rsa_host_key",
20737        "SFTPHostKey $dsa_host_key",
20738      ],
20739    },
20740  };
20741
20742  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
20743    $config);
20744
20745  # Open pipes, for use between the parent and child processes.  Specifically,
20746  # the child will indicate when it's done with its test by writing a message
20747  # to the parent.
20748  my ($rfh, $wfh);
20749  unless (pipe($rfh, $wfh)) {
20750    die("Can't open pipe: $!");
20751  }
20752
20753  require Net::SSH2;
20754
20755  my $ex;
20756
20757  # Fork child
20758  $self->handle_sigchld();
20759  defined(my $pid = fork()) or die("Can't fork: $!");
20760  if ($pid) {
20761    eval {
20762      my $ssh2 = Net::SSH2->new();
20763
20764      sleep(1);
20765
20766      unless ($ssh2->connect('127.0.0.1', $port)) {
20767        my ($err_code, $err_name, $err_str) = $ssh2->error();
20768        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20769      }
20770
20771      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20772        my ($err_code, $err_name, $err_str) = $ssh2->error();
20773        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20774      }
20775
20776      my $sftp = $ssh2->sftp();
20777      unless ($sftp) {
20778        my ($err_code, $err_name, $err_str) = $ssh2->error();
20779        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20780      }
20781
20782      my $path = 'test.d/test.lnk';
20783      my $res = $sftp->setstat($path,
20784        atime => 0,
20785        mtime => 0,
20786      );
20787      unless ($res) {
20788        my ($err_code, $err_name) = $sftp->error();
20789        die("Can't setstat $path: [$err_name] ($err_code)");
20790      }
20791
20792      my $attrs = $sftp->stat($path);
20793      unless ($attrs) {
20794        my ($err_code, $err_name) = $sftp->error();
20795        die("STAT $path failed: [$err_name] ($err_code)");
20796      }
20797
20798      $sftp = undef;
20799      $ssh2->disconnect();
20800
20801      my $expected = 0;
20802      my $file_atime = $attrs->{atime};
20803      $self->assert($expected == $file_atime,
20804        test_msg("Expected file atime '$expected', got '$file_atime'"));
20805
20806      my $file_mtime = $attrs->{mtime};
20807      $self->assert($expected == $file_mtime,
20808        test_msg("Expected file mtime '$expected', got '$file_mtime'"));
20809    };
20810    if ($@) {
20811      $ex = $@;
20812    }
20813
20814    $wfh->print("done\n");
20815    $wfh->flush();
20816
20817  } else {
20818    eval { server_wait($setup->{config_file}, $rfh) };
20819    if ($@) {
20820      warn($@);
20821      exit 1;
20822    }
20823
20824    exit 0;
20825  }
20826
20827  # Stop server
20828  server_stop($setup->{pid_file});
20829  $self->assert_child_ok($pid);
20830
20831  test_cleanup($setup->{log_file}, $ex);
20832}
20833
20834sub sftp_setstat_rel_symlink_enoent {
20835  my $self = shift;
20836  my $tmpdir = $self->{tmpdir};
20837  my $setup = test_setup($tmpdir, 'sftp');
20838
20839  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20840  mkpath($test_dir);
20841
20842  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20843
20844  # Change to the test directory in order to create a relative path in the
20845  # symlink we need
20846
20847  my $cwd = getcwd();
20848  unless (chdir($test_dir)) {
20849    die("Can't chdir to $test_dir: $!");
20850  }
20851
20852  unless (symlink('./test.txt', './test.lnk')) {
20853    die("Can't symlink 'test.lnk' to './test.txt': $!");
20854  }
20855
20856  unless (chdir($cwd)) {
20857    die("Can't chdir to $cwd: $!");
20858  }
20859
20860  if ($< == 0) {
20861    unless (chmod(0755, $test_dir)) {
20862      die("Can't set perms on $test_dir to 0755: $!");
20863    }
20864
20865    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
20866      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
20867    }
20868  }
20869
20870  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
20871  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
20872
20873  my $config = {
20874    PidFile => $setup->{pid_file},
20875    ScoreboardFile => $setup->{scoreboard_file},
20876    SystemLog => $setup->{log_file},
20877    TraceLog => $setup->{log_file},
20878    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
20879
20880    AuthUserFile => $setup->{auth_user_file},
20881    AuthGroupFile => $setup->{auth_group_file},
20882
20883    IfModules => {
20884      'mod_delay.c' => {
20885        DelayEngine => 'off',
20886      },
20887
20888      'mod_sftp.c' => [
20889        "SFTPEngine on",
20890        "SFTPLog $setup->{log_file}",
20891        "SFTPHostKey $rsa_host_key",
20892        "SFTPHostKey $dsa_host_key",
20893      ],
20894    },
20895  };
20896
20897  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
20898    $config);
20899
20900  # Open pipes, for use between the parent and child processes.  Specifically,
20901  # the child will indicate when it's done with its test by writing a message
20902  # to the parent.
20903  my ($rfh, $wfh);
20904  unless (pipe($rfh, $wfh)) {
20905    die("Can't open pipe: $!");
20906  }
20907
20908  require Net::SSH2;
20909
20910  my $ex;
20911
20912  # Fork child
20913  $self->handle_sigchld();
20914  defined(my $pid = fork()) or die("Can't fork: $!");
20915  if ($pid) {
20916    eval {
20917      my $ssh2 = Net::SSH2->new();
20918
20919      sleep(1);
20920
20921      unless ($ssh2->connect('127.0.0.1', $port)) {
20922        my ($err_code, $err_name, $err_str) = $ssh2->error();
20923        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
20924      }
20925
20926      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
20927        my ($err_code, $err_name, $err_str) = $ssh2->error();
20928        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
20929      }
20930
20931      my $sftp = $ssh2->sftp();
20932      unless ($sftp) {
20933        my ($err_code, $err_name, $err_str) = $ssh2->error();
20934        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
20935      }
20936
20937      my $path = 'test.d/test.lnk';
20938      my $res = $sftp->setstat($path,
20939        atime => 0,
20940        mtime => 0,
20941      );
20942      if ($res) {
20943        die("SETSTAT $path succeeded unexpectedly");
20944      }
20945
20946      my ($err_code, $err_name) = $sftp->error();
20947      $sftp = undef;
20948      $ssh2->disconnect();
20949
20950      my $expected = 'SSH_FX_NO_SUCH_FILE';
20951      $self->assert($expected eq $err_name,
20952        test_msg("Expected error name '$expected', got '$err_name'"));
20953    };
20954    if ($@) {
20955      $ex = $@;
20956    }
20957
20958    $wfh->print("done\n");
20959    $wfh->flush();
20960
20961  } else {
20962    eval { server_wait($setup->{config_file}, $rfh) };
20963    if ($@) {
20964      warn($@);
20965      exit 1;
20966    }
20967
20968    exit 0;
20969  }
20970
20971  # Stop server
20972  server_stop($setup->{pid_file});
20973  $self->assert_child_ok($pid);
20974
20975  test_cleanup($setup->{log_file}, $ex);
20976}
20977
20978sub sftp_setstat_rel_symlink_enoent_chrooted_bug4219 {
20979  my $self = shift;
20980  my $tmpdir = $self->{tmpdir};
20981  my $setup = test_setup($tmpdir, 'sftp');
20982
20983  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
20984  mkpath($test_dir);
20985
20986  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
20987
20988  # Change to the test directory in order to create a relative path in the
20989  # symlink we need
20990
20991  my $cwd = getcwd();
20992  unless (chdir($test_dir)) {
20993    die("Can't chdir to $test_dir: $!");
20994  }
20995
20996  unless (symlink('./test.txt', './test.lnk')) {
20997    die("Can't symlink 'test.lnk' to './test.txt': $!");
20998  }
20999
21000  unless (chdir($cwd)) {
21001    die("Can't chdir to $cwd: $!");
21002  }
21003
21004  if ($< == 0) {
21005    unless (chmod(0755, $test_dir)) {
21006      die("Can't set perms on $test_dir to 0755: $!");
21007    }
21008
21009    unless (chown($setup->{uid}, $setup->{gid}, $test_dir)) {
21010      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
21011    }
21012  }
21013
21014  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
21015  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
21016
21017  my $config = {
21018    PidFile => $setup->{pid_file},
21019    ScoreboardFile => $setup->{scoreboard_file},
21020    SystemLog => $setup->{log_file},
21021    TraceLog => $setup->{log_file},
21022    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
21023
21024    AuthUserFile => $setup->{auth_user_file},
21025    AuthGroupFile => $setup->{auth_group_file},
21026
21027    DefaultRoot => '~',
21028
21029    IfModules => {
21030      'mod_delay.c' => {
21031        DelayEngine => 'off',
21032      },
21033
21034      'mod_sftp.c' => [
21035        "SFTPEngine on",
21036        "SFTPLog $setup->{log_file}",
21037        "SFTPHostKey $rsa_host_key",
21038        "SFTPHostKey $dsa_host_key",
21039      ],
21040    },
21041  };
21042
21043  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
21044    $config);
21045
21046  # Open pipes, for use between the parent and child processes.  Specifically,
21047  # the child will indicate when it's done with its test by writing a message
21048  # to the parent.
21049  my ($rfh, $wfh);
21050  unless (pipe($rfh, $wfh)) {
21051    die("Can't open pipe: $!");
21052  }
21053
21054  require Net::SSH2;
21055
21056  my $ex;
21057
21058  # Fork child
21059  $self->handle_sigchld();
21060  defined(my $pid = fork()) or die("Can't fork: $!");
21061  if ($pid) {
21062    eval {
21063      my $ssh2 = Net::SSH2->new();
21064
21065      sleep(1);
21066
21067      unless ($ssh2->connect('127.0.0.1', $port)) {
21068        my ($err_code, $err_name, $err_str) = $ssh2->error();
21069        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
21070      }
21071
21072      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
21073        my ($err_code, $err_name, $err_str) = $ssh2->error();
21074        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
21075      }
21076
21077      my $sftp = $ssh2->sftp();
21078      unless ($sftp) {
21079        my ($err_code, $err_name, $err_str) = $ssh2->error();
21080        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
21081      }
21082
21083      my $path = 'test.d/test.lnk';
21084      my $res = $sftp->setstat($path,
21085        atime => 0,
21086        mtime => 0,
21087      );
21088      if ($res) {
21089        die("SETSTAT $path succeeded unexpectedly");
21090      }
21091
21092      my ($err_code, $err_name) = $sftp->error();
21093      $sftp = undef;
21094      $ssh2->disconnect();
21095
21096      my $expected = 'SSH_FX_NO_SUCH_FILE';
21097      $self->assert($expected eq $err_name,
21098        test_msg("Expected error name '$expected', got '$err_name'"));
21099    };
21100    if ($@) {
21101      $ex = $@;
21102    }
21103
21104    $wfh->print("done\n");
21105    $wfh->flush();
21106
21107  } else {
21108    eval { server_wait($setup->{config_file}, $rfh) };
21109    if ($@) {
21110      warn($@);
21111      exit 1;
21112    }
21113
21114    exit 0;
21115  }
21116
21117  # Stop server
21118  server_stop($setup->{pid_file});
21119  $self->assert_child_ok($pid);
21120
21121  test_cleanup($setup->{log_file}, $ex);
21122}
21123
21124sub sftp_fsetstat {
21125  my $self = shift;
21126  my $tmpdir = $self->{tmpdir};
21127
21128  my $config_file = "$tmpdir/sftp.conf";
21129  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
21130  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
21131
21132  my $log_file = test_get_logfile();
21133
21134  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
21135  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
21136
21137  my $user = 'proftpd';
21138  my $passwd = 'test';
21139  my $group = 'ftpd';
21140  my $home_dir = File::Spec->rel2abs($tmpdir);
21141  my $uid = 500;
21142  my $gid = 500;
21143
21144  # Make sure that, if we're running as root, that the home directory has
21145  # permissions/privs set for the account we create
21146  if ($< == 0) {
21147    unless (chmod(0755, $home_dir)) {
21148      die("Can't set perms on $home_dir to 0755: $!");
21149    }
21150
21151    unless (chown($uid, $gid, $home_dir)) {
21152      die("Can't set owner of $home_dir to $uid/$gid: $!");
21153    }
21154  }
21155
21156  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
21157    '/bin/bash');
21158  auth_group_write($auth_group_file, $group, $gid, $user);
21159
21160  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
21161  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
21162
21163  my $config = {
21164    PidFile => $pid_file,
21165    ScoreboardFile => $scoreboard_file,
21166    SystemLog => $log_file,
21167    TraceLog => $log_file,
21168    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
21169
21170    AuthUserFile => $auth_user_file,
21171    AuthGroupFile => $auth_group_file,
21172
21173    IfModules => {
21174      'mod_delay.c' => {
21175        DelayEngine => 'off',
21176      },
21177
21178      'mod_sftp.c' => [
21179        "SFTPEngine on",
21180        "SFTPLog $log_file",
21181        "SFTPHostKey $rsa_host_key",
21182        "SFTPHostKey $dsa_host_key",
21183      ],
21184    },
21185  };
21186
21187  my ($port, $config_user, $config_group) = config_write($config_file, $config);
21188
21189  # Open pipes, for use between the parent and child processes.  Specifically,
21190  # the child will indicate when it's done with its test by writing a message
21191  # to the parent.
21192  my ($rfh, $wfh);
21193  unless (pipe($rfh, $wfh)) {
21194    die("Can't open pipe: $!");
21195  }
21196
21197  require Net::SSH2;
21198
21199  my $ex;
21200
21201  # Fork child
21202  $self->handle_sigchld();
21203  defined(my $pid = fork()) or die("Can't fork: $!");
21204  if ($pid) {
21205    eval {
21206      my $ssh2 = Net::SSH2->new();
21207
21208      sleep(1);
21209
21210      unless ($ssh2->connect('127.0.0.1', $port)) {
21211        my ($err_code, $err_name, $err_str) = $ssh2->error();
21212        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
21213      }
21214
21215      unless ($ssh2->auth_password($user, $passwd)) {
21216        my ($err_code, $err_name, $err_str) = $ssh2->error();
21217        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
21218      }
21219
21220      my $sftp = $ssh2->sftp();
21221      unless ($sftp) {
21222        my ($err_code, $err_name, $err_str) = $ssh2->error();
21223        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
21224      }
21225
21226      my $fh = $sftp->open('sftp.conf', O_RDONLY);
21227      unless ($fh) {
21228        my ($err_code, $err_name) = $sftp->error();
21229        die("Can't open sftp.conf: [$err_name] ($err_code)");
21230      }
21231
21232      my $res = $fh->setstat(
21233        atime => 0,
21234        mtime => 0,
21235      );
21236      unless ($res) {
21237        my ($err_code, $err_name) = $sftp->error();
21238        die("Can't fsetstat sftp.conf: [$err_name] ($err_code)");
21239      }
21240
21241      # Explicitly destroy the handle to issue the FXP_CLOSE
21242      $fh = undef;
21243
21244      my $attrs = $sftp->stat('sftp.conf');
21245      unless ($attrs) {
21246        my ($err_code, $err_name) = $sftp->error();
21247        die("FXP_STAT sftp.conf failed: [$err_name] ($err_code)");
21248      }
21249
21250      $sftp = undef;
21251      $ssh2->disconnect();
21252
21253      my $expected;
21254
21255      $expected = 0;
21256      my $file_atime = $attrs->{atime};
21257      $self->assert($expected == $file_atime,
21258        test_msg("Expected '$expected', got '$file_atime'"));
21259
21260      my $file_mtime = $attrs->{mtime};
21261      $self->assert($expected == $file_mtime,
21262        test_msg("Expected '$expected', got '$file_mtime'"));
21263    };
21264
21265    if ($@) {
21266      $ex = $@;
21267    }
21268
21269    $wfh->print("done\n");
21270    $wfh->flush();
21271
21272  } else {
21273    eval { server_wait($config_file, $rfh) };
21274    if ($@) {
21275      warn($@);
21276      exit 1;
21277    }
21278
21279    exit 0;
21280  }
21281
21282  # Stop server
21283  server_stop($pid_file);
21284
21285  $self->assert_child_ok($pid);
21286
21287  if ($ex) {
21288    test_append_logfile($log_file, $ex);
21289    unlink($log_file);
21290
21291    die($ex);
21292  }
21293
21294  unlink($log_file);
21295}
21296
21297sub sftp_realpath {
21298  my $self = shift;
21299  my $tmpdir = $self->{tmpdir};
21300
21301  my $config_file = "$tmpdir/sftp.conf";
21302  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
21303  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
21304
21305  my $log_file = test_get_logfile();
21306
21307  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
21308  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
21309
21310  my $user = 'proftpd';
21311  my $passwd = 'test';
21312  my $group = 'ftpd';
21313  my $home_dir = File::Spec->rel2abs($tmpdir);
21314  my $uid = 500;
21315  my $gid = 500;
21316
21317  # Make sure that, if we're running as root, that the home directory has
21318  # permissions/privs set for the account we create
21319  if ($< == 0) {
21320    unless (chmod(0755, $home_dir)) {
21321      die("Can't set perms on $home_dir to 0755: $!");
21322    }
21323
21324    unless (chown($uid, $gid, $home_dir)) {
21325      die("Can't set owner of $home_dir to $uid/$gid: $!");
21326    }
21327  }
21328
21329  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
21330    '/bin/bash');
21331  auth_group_write($auth_group_file, $group, $gid, $user);
21332
21333  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
21334  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
21335
21336  my $config = {
21337    PidFile => $pid_file,
21338    ScoreboardFile => $scoreboard_file,
21339    SystemLog => $log_file,
21340    TraceLog => $log_file,
21341    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
21342
21343    AuthUserFile => $auth_user_file,
21344    AuthGroupFile => $auth_group_file,
21345
21346    IfModules => {
21347      'mod_delay.c' => {
21348        DelayEngine => 'off',
21349      },
21350
21351      'mod_sftp.c' => [
21352        "SFTPEngine on",
21353        "SFTPLog $log_file",
21354        "SFTPHostKey $rsa_host_key",
21355        "SFTPHostKey $dsa_host_key",
21356      ],
21357    },
21358  };
21359
21360  my ($port, $config_user, $config_group) = config_write($config_file, $config);
21361
21362  # Open pipes, for use between the parent and child processes.  Specifically,
21363  # the child will indicate when it's done with its test by writing a message
21364  # to the parent.
21365  my ($rfh, $wfh);
21366  unless (pipe($rfh, $wfh)) {
21367    die("Can't open pipe: $!");
21368  }
21369
21370  require Net::SSH2;
21371
21372  my $ex;
21373
21374  # Fork child
21375  $self->handle_sigchld();
21376  defined(my $pid = fork()) or die("Can't fork: $!");
21377  if ($pid) {
21378    eval {
21379      my $ssh2 = Net::SSH2->new();
21380
21381      sleep(1);
21382
21383      unless ($ssh2->connect('127.0.0.1', $port)) {
21384        my ($err_code, $err_name, $err_str) = $ssh2->error();
21385        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
21386      }
21387
21388      unless ($ssh2->auth_password($user, $passwd)) {
21389        my ($err_code, $err_name, $err_str) = $ssh2->error();
21390        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
21391      }
21392
21393      my $sftp = $ssh2->sftp();
21394      unless ($sftp) {
21395        my ($err_code, $err_name, $err_str) = $ssh2->error();
21396        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
21397      }
21398
21399      my $cwd = $sftp->realpath('.');
21400      unless ($cwd) {
21401        my ($err_code, $err_name) = $sftp->error();
21402        die("Can't get real path for '.': [$err_name] ($err_code)");
21403      }
21404
21405      my $expected;
21406
21407      $expected = $home_dir;
21408      if ($^O eq 'darwin') {
21409        # MacOSX-specific hack to deal with how it handles tmp files
21410        $expected = ('/private' . $expected);
21411      }
21412
21413      $self->assert($expected eq $cwd,
21414        test_msg("Expected '$expected', got '$cwd'"));
21415
21416      $sftp = undef;
21417      $ssh2->disconnect();
21418    };
21419
21420    if ($@) {
21421      $ex = $@;
21422    }
21423
21424    $wfh->print("done\n");
21425    $wfh->flush();
21426
21427  } else {
21428    eval { server_wait($config_file, $rfh) };
21429    if ($@) {
21430      warn($@);
21431      exit 1;
21432    }
21433
21434    exit 0;
21435  }
21436
21437  # Stop server
21438  server_stop($pid_file);
21439
21440  $self->assert_child_ok($pid);
21441
21442  if ($ex) {
21443    test_append_logfile($log_file, $ex);
21444    unlink($log_file);
21445
21446    die($ex);
21447  }
21448
21449  unlink($log_file);
21450}
21451
21452sub sftp_realpath_file {
21453  my $self = shift;
21454  my $tmpdir = $self->{tmpdir};
21455
21456  my $config_file = "$tmpdir/sftp.conf";
21457  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
21458  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
21459
21460  my $log_file = test_get_logfile();
21461
21462  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
21463  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
21464
21465  my $user = 'proftpd';
21466  my $passwd = 'test';
21467  my $group = 'ftpd';
21468  my $home_dir = File::Spec->rel2abs($tmpdir);
21469  my $uid = 500;
21470  my $gid = 500;
21471
21472  # Make sure that, if we're running as root, that the home directory has
21473  # permissions/privs set for the account we create
21474  if ($< == 0) {
21475    unless (chmod(0755, $home_dir)) {
21476      die("Can't set perms on $home_dir to 0755: $!");
21477    }
21478
21479    unless (chown($uid, $gid, $home_dir)) {
21480      die("Can't set owner of $home_dir to $uid/$gid: $!");
21481    }
21482  }
21483
21484  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
21485    '/bin/bash');
21486  auth_group_write($auth_group_file, $group, $gid, $user);
21487
21488  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
21489  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
21490
21491  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
21492  if (open(my $fh, "> $test_file")) {
21493    print $fh "Hello, World!\n";
21494    unless (close($fh)) {
21495      die("Can't write $test_file: $!");
21496    }
21497
21498  } else {
21499    die("Can't open $test_file: $!");
21500  }
21501
21502  my $config = {
21503    PidFile => $pid_file,
21504    ScoreboardFile => $scoreboard_file,
21505    SystemLog => $log_file,
21506    TraceLog => $log_file,
21507    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
21508
21509    AuthUserFile => $auth_user_file,
21510    AuthGroupFile => $auth_group_file,
21511
21512    IfModules => {
21513      'mod_delay.c' => {
21514        DelayEngine => 'off',
21515      },
21516
21517      'mod_sftp.c' => [
21518        "SFTPEngine on",
21519        "SFTPLog $log_file",
21520        "SFTPHostKey $rsa_host_key",
21521        "SFTPHostKey $dsa_host_key",
21522      ],
21523    },
21524  };
21525
21526  my ($port, $config_user, $config_group) = config_write($config_file, $config);
21527
21528  # Open pipes, for use between the parent and child processes.  Specifically,
21529  # the child will indicate when it's done with its test by writing a message
21530  # to the parent.
21531  my ($rfh, $wfh);
21532  unless (pipe($rfh, $wfh)) {
21533    die("Can't open pipe: $!");
21534  }
21535
21536  require Net::SSH2;
21537
21538  my $ex;
21539
21540  # Fork child
21541  $self->handle_sigchld();
21542  defined(my $pid = fork()) or die("Can't fork: $!");
21543  if ($pid) {
21544    eval {
21545      my $ssh2 = Net::SSH2->new();
21546
21547      sleep(1);
21548
21549      unless ($ssh2->connect('127.0.0.1', $port)) {
21550        my ($err_code, $err_name, $err_str) = $ssh2->error();
21551        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
21552      }
21553
21554      unless ($ssh2->auth_password($user, $passwd)) {
21555        my ($err_code, $err_name, $err_str) = $ssh2->error();
21556        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
21557      }
21558
21559      my $sftp = $ssh2->sftp();
21560      unless ($sftp) {
21561        my ($err_code, $err_name, $err_str) = $ssh2->error();
21562        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
21563      }
21564
21565      my $real_path = $sftp->realpath('test.txt');
21566      unless ($real_path) {
21567        my ($err_code, $err_name) = $sftp->error();
21568        die("Can't get real path for 'test.txt': [$err_name] ($err_code)");
21569      }
21570
21571      my $expected;
21572
21573      $expected = $test_file;
21574      if ($^O eq 'darwin') {
21575        # MacOSX-specific hack to deal with how it handles tmp files
21576        $expected = ('/private' . $expected);
21577      }
21578
21579      $self->assert($expected eq $real_path,
21580        test_msg("Expected real path '$expected', got '$real_path'"));
21581
21582      $sftp = undef;
21583      $ssh2->disconnect();
21584    };
21585
21586    if ($@) {
21587      $ex = $@;
21588    }
21589
21590    $wfh->print("done\n");
21591    $wfh->flush();
21592
21593  } else {
21594    eval { server_wait($config_file, $rfh) };
21595    if ($@) {
21596      warn($@);
21597      exit 1;
21598    }
21599
21600    exit 0;
21601  }
21602
21603  # Stop server
21604  server_stop($pid_file);
21605
21606  $self->assert_child_ok($pid);
21607
21608  if ($ex) {
21609    test_append_logfile($log_file, $ex);
21610    unlink($log_file);
21611
21612    die($ex);
21613  }
21614
21615  unlink($log_file);
21616}
21617
21618sub sftp_realpath_symlink_file {
21619  my $self = shift;
21620  my $tmpdir = $self->{tmpdir};
21621
21622  my $config_file = "$tmpdir/sftp.conf";
21623  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
21624  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
21625
21626  my $log_file = test_get_logfile();
21627
21628  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
21629  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
21630
21631  my $user = 'proftpd';
21632  my $passwd = 'test';
21633  my $group = 'ftpd';
21634  my $home_dir = File::Spec->rel2abs($tmpdir);
21635  my $uid = 500;
21636  my $gid = 500;
21637
21638  # Make sure that, if we're running as root, that the home directory has
21639  # permissions/privs set for the account we create
21640  if ($< == 0) {
21641    unless (chmod(0755, $home_dir)) {
21642      die("Can't set perms on $home_dir to 0755: $!");
21643    }
21644
21645    unless (chown($uid, $gid, $home_dir)) {
21646      die("Can't set owner of $home_dir to $uid/$gid: $!");
21647    }
21648  }
21649
21650  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
21651    '/bin/bash');
21652  auth_group_write($auth_group_file, $group, $gid, $user);
21653
21654  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
21655  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
21656
21657  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
21658  if (open(my $fh, "> $test_file")) {
21659    print $fh "Hello, World!\n";
21660    unless (close($fh)) {
21661      die("Can't write $test_file: $!");
21662    }
21663
21664  } else {
21665    die("Can't open $test_file: $!");
21666  }
21667
21668  my $cwd = getcwd();
21669  unless (chdir($tmpdir)) {
21670    die("Can't chdir to $tmpdir: $!");
21671  }
21672
21673  unless (symlink('test.txt', 'test.lnk')) {
21674    die("Can't symlink 'test.txt' to 'test.lnk': $!");
21675  }
21676
21677  unless (chdir($cwd)) {
21678    die("Can't chdir to $cwd: $!");
21679  }
21680
21681  my $config = {
21682    PidFile => $pid_file,
21683    ScoreboardFile => $scoreboard_file,
21684    SystemLog => $log_file,
21685    TraceLog => $log_file,
21686    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
21687
21688    AuthUserFile => $auth_user_file,
21689    AuthGroupFile => $auth_group_file,
21690
21691    IfModules => {
21692      'mod_delay.c' => {
21693        DelayEngine => 'off',
21694      },
21695
21696      'mod_sftp.c' => [
21697        "SFTPEngine on",
21698        "SFTPLog $log_file",
21699        "SFTPHostKey $rsa_host_key",
21700        "SFTPHostKey $dsa_host_key",
21701      ],
21702    },
21703  };
21704
21705  my ($port, $config_user, $config_group) = config_write($config_file, $config);
21706
21707  # Open pipes, for use between the parent and child processes.  Specifically,
21708  # the child will indicate when it's done with its test by writing a message
21709  # to the parent.
21710  my ($rfh, $wfh);
21711  unless (pipe($rfh, $wfh)) {
21712    die("Can't open pipe: $!");
21713  }
21714
21715  require Net::SSH2;
21716
21717  my $ex;
21718
21719  # Fork child
21720  $self->handle_sigchld();
21721  defined(my $pid = fork()) or die("Can't fork: $!");
21722  if ($pid) {
21723    eval {
21724      my $ssh2 = Net::SSH2->new();
21725
21726      sleep(1);
21727
21728      unless ($ssh2->connect('127.0.0.1', $port)) {
21729        my ($err_code, $err_name, $err_str) = $ssh2->error();
21730        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
21731      }
21732
21733      unless ($ssh2->auth_password($user, $passwd)) {
21734        my ($err_code, $err_name, $err_str) = $ssh2->error();
21735        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
21736      }
21737
21738      my $sftp = $ssh2->sftp();
21739      unless ($sftp) {
21740        my ($err_code, $err_name, $err_str) = $ssh2->error();
21741        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
21742      }
21743
21744      my $real_path = $sftp->realpath('test.lnk');
21745      unless ($real_path) {
21746        my ($err_code, $err_name) = $sftp->error();
21747        die("Can't get real path for 'test.lnk': [$err_name] ($err_code)");
21748      }
21749
21750      my $expected;
21751
21752      $expected = $test_file;
21753      if ($^O eq 'darwin') {
21754        # MacOSX-specific hack to deal with how it handles tmp files
21755        $expected = ('/private' . $expected);
21756      }
21757
21758      $self->assert($expected eq $real_path,
21759        test_msg("Expected real path '$expected', got '$real_path'"));
21760
21761      $sftp = undef;
21762      $ssh2->disconnect();
21763    };
21764
21765    if ($@) {
21766      $ex = $@;
21767    }
21768
21769    $wfh->print("done\n");
21770    $wfh->flush();
21771
21772  } else {
21773    eval { server_wait($config_file, $rfh) };
21774    if ($@) {
21775      warn($@);
21776      exit 1;
21777    }
21778
21779    exit 0;
21780  }
21781
21782  # Stop server
21783  server_stop($pid_file);
21784
21785  $self->assert_child_ok($pid);
21786
21787  if ($ex) {
21788    test_append_logfile($log_file, $ex);
21789    unlink($log_file);
21790
21791    die($ex);
21792  }
21793
21794  unlink($log_file);
21795}
21796
21797sub sftp_realpath_symlink_file_chrooted {
21798  my $self = shift;
21799  my $tmpdir = $self->{tmpdir};
21800
21801  my $config_file = "$tmpdir/sftp.conf";
21802  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
21803  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
21804
21805  my $log_file = test_get_logfile();
21806
21807  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
21808  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
21809
21810  my $user = 'proftpd';
21811  my $passwd = 'test';
21812  my $group = 'ftpd';
21813  my $home_dir = File::Spec->rel2abs($tmpdir);
21814  my $uid = 500;
21815  my $gid = 500;
21816
21817  # Make sure that, if we're running as root, that the home directory has
21818  # permissions/privs set for the account we create
21819  if ($< == 0) {
21820    unless (chmod(0755, $home_dir)) {
21821      die("Can't set perms on $home_dir to 0755: $!");
21822    }
21823
21824    unless (chown($uid, $gid, $home_dir)) {
21825      die("Can't set owner of $home_dir to $uid/$gid: $!");
21826    }
21827  }
21828
21829  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
21830    '/bin/bash');
21831  auth_group_write($auth_group_file, $group, $gid, $user);
21832
21833  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
21834  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
21835
21836  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
21837  if (open(my $fh, "> $test_file")) {
21838    print $fh "Hello, World!\n";
21839    unless (close($fh)) {
21840      die("Can't write $test_file: $!");
21841    }
21842
21843  } else {
21844    die("Can't open $test_file: $!");
21845  }
21846
21847  # This is what the client should see, since it is chrooted
21848  my $chrooted_file = "/test.txt";
21849
21850  my $cwd = getcwd();
21851  unless (chdir($tmpdir)) {
21852    die("Can't chdir to $tmpdir: $!");
21853  }
21854
21855  unless (symlink('./test.txt', 'test.lnk')) {
21856    die("Can't symlink 'test.txt' to 'test.lnk': $!");
21857  }
21858
21859  unless (chdir($cwd)) {
21860    die("Can't chdir to $cwd: $!");
21861  }
21862
21863  my $config = {
21864    PidFile => $pid_file,
21865    ScoreboardFile => $scoreboard_file,
21866    SystemLog => $log_file,
21867    TraceLog => $log_file,
21868    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
21869
21870    AuthUserFile => $auth_user_file,
21871    AuthGroupFile => $auth_group_file,
21872    DefaultRoot => '~',
21873
21874    IfModules => {
21875      'mod_delay.c' => {
21876        DelayEngine => 'off',
21877      },
21878
21879      'mod_sftp.c' => [
21880        "SFTPEngine on",
21881        "SFTPLog $log_file",
21882        "SFTPHostKey $rsa_host_key",
21883        "SFTPHostKey $dsa_host_key",
21884      ],
21885    },
21886  };
21887
21888  my ($port, $config_user, $config_group) = config_write($config_file, $config);
21889
21890  # Open pipes, for use between the parent and child processes.  Specifically,
21891  # the child will indicate when it's done with its test by writing a message
21892  # to the parent.
21893  my ($rfh, $wfh);
21894  unless (pipe($rfh, $wfh)) {
21895    die("Can't open pipe: $!");
21896  }
21897
21898  require Net::SSH2;
21899
21900  my $ex;
21901
21902  # Fork child
21903  $self->handle_sigchld();
21904  defined(my $pid = fork()) or die("Can't fork: $!");
21905  if ($pid) {
21906    eval {
21907      my $ssh2 = Net::SSH2->new();
21908
21909      sleep(1);
21910
21911      unless ($ssh2->connect('127.0.0.1', $port)) {
21912        my ($err_code, $err_name, $err_str) = $ssh2->error();
21913        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
21914      }
21915
21916      unless ($ssh2->auth_password($user, $passwd)) {
21917        my ($err_code, $err_name, $err_str) = $ssh2->error();
21918        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
21919      }
21920
21921      my $sftp = $ssh2->sftp();
21922      unless ($sftp) {
21923        my ($err_code, $err_name, $err_str) = $ssh2->error();
21924        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
21925      }
21926
21927      my $real_path = $sftp->realpath('test.lnk');
21928      unless ($real_path) {
21929        my ($err_code, $err_name) = $sftp->error();
21930        die("Can't get real path for 'test.lnk': [$err_name] ($err_code)");
21931      }
21932
21933      my $expected;
21934
21935      $expected = $chrooted_file;
21936      $self->assert($expected eq $real_path,
21937        test_msg("Expected real path '$expected', got '$real_path'"));
21938
21939      $sftp = undef;
21940      $ssh2->disconnect();
21941    };
21942
21943    if ($@) {
21944      $ex = $@;
21945    }
21946
21947    $wfh->print("done\n");
21948    $wfh->flush();
21949
21950  } else {
21951    eval { server_wait($config_file, $rfh) };
21952    if ($@) {
21953      warn($@);
21954      exit 1;
21955    }
21956
21957    exit 0;
21958  }
21959
21960  # Stop server
21961  server_stop($pid_file);
21962
21963  $self->assert_child_ok($pid);
21964
21965  if ($ex) {
21966    test_append_logfile($log_file, $ex);
21967    unlink($log_file);
21968
21969    die($ex);
21970  }
21971
21972  unlink($log_file);
21973}
21974
21975sub sftp_realpath_dir {
21976  my $self = shift;
21977  my $tmpdir = $self->{tmpdir};
21978
21979  my $config_file = "$tmpdir/sftp.conf";
21980  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
21981  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
21982
21983  my $log_file = test_get_logfile();
21984
21985  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
21986  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
21987
21988  my $user = 'proftpd';
21989  my $passwd = 'test';
21990  my $group = 'ftpd';
21991  my $home_dir = File::Spec->rel2abs($tmpdir);
21992  my $uid = 500;
21993  my $gid = 500;
21994
21995  # Make sure that, if we're running as root, that the home directory has
21996  # permissions/privs set for the account we create
21997  if ($< == 0) {
21998    unless (chmod(0755, $home_dir)) {
21999      die("Can't set perms on $home_dir to 0755: $!");
22000    }
22001
22002    unless (chown($uid, $gid, $home_dir)) {
22003      die("Can't set owner of $home_dir to $uid/$gid: $!");
22004    }
22005  }
22006
22007  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
22008    '/bin/bash');
22009  auth_group_write($auth_group_file, $group, $gid, $user);
22010
22011  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
22012  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
22013
22014  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
22015  mkpath($test_dir);
22016
22017  my $config = {
22018    PidFile => $pid_file,
22019    ScoreboardFile => $scoreboard_file,
22020    SystemLog => $log_file,
22021    TraceLog => $log_file,
22022    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
22023
22024    AuthUserFile => $auth_user_file,
22025    AuthGroupFile => $auth_group_file,
22026
22027    IfModules => {
22028      'mod_delay.c' => {
22029        DelayEngine => 'off',
22030      },
22031
22032      'mod_sftp.c' => [
22033        "SFTPEngine on",
22034        "SFTPLog $log_file",
22035        "SFTPHostKey $rsa_host_key",
22036        "SFTPHostKey $dsa_host_key",
22037      ],
22038    },
22039  };
22040
22041  my ($port, $config_user, $config_group) = config_write($config_file, $config);
22042
22043  # Open pipes, for use between the parent and child processes.  Specifically,
22044  # the child will indicate when it's done with its test by writing a message
22045  # to the parent.
22046  my ($rfh, $wfh);
22047  unless (pipe($rfh, $wfh)) {
22048    die("Can't open pipe: $!");
22049  }
22050
22051  require Net::SSH2;
22052
22053  my $ex;
22054
22055  # Fork child
22056  $self->handle_sigchld();
22057  defined(my $pid = fork()) or die("Can't fork: $!");
22058  if ($pid) {
22059    eval {
22060      my $ssh2 = Net::SSH2->new();
22061
22062      sleep(1);
22063
22064      unless ($ssh2->connect('127.0.0.1', $port)) {
22065        my ($err_code, $err_name, $err_str) = $ssh2->error();
22066        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
22067      }
22068
22069      unless ($ssh2->auth_password($user, $passwd)) {
22070        my ($err_code, $err_name, $err_str) = $ssh2->error();
22071        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
22072      }
22073
22074      my $sftp = $ssh2->sftp();
22075      unless ($sftp) {
22076        my ($err_code, $err_name, $err_str) = $ssh2->error();
22077        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
22078      }
22079
22080      my $real_path = $sftp->realpath('test.d');
22081      unless ($real_path) {
22082        my ($err_code, $err_name) = $sftp->error();
22083        die("Can't get real path for 'test.d': [$err_name] ($err_code)");
22084      }
22085
22086      my $expected;
22087
22088      $expected = $test_dir;
22089      if ($^O eq 'darwin') {
22090        # MacOSX-specific hack to deal with how it handles tmp files
22091        $expected = ('/private' . $expected);
22092      }
22093
22094      $self->assert($expected eq $real_path,
22095        test_msg("Expected real path '$expected', got '$real_path'"));
22096
22097      $sftp = undef;
22098      $ssh2->disconnect();
22099    };
22100
22101    if ($@) {
22102      $ex = $@;
22103    }
22104
22105    $wfh->print("done\n");
22106    $wfh->flush();
22107
22108  } else {
22109    eval { server_wait($config_file, $rfh) };
22110    if ($@) {
22111      warn($@);
22112      exit 1;
22113    }
22114
22115    exit 0;
22116  }
22117
22118  # Stop server
22119  server_stop($pid_file);
22120
22121  $self->assert_child_ok($pid);
22122
22123  if ($ex) {
22124    test_append_logfile($log_file, $ex);
22125    unlink($log_file);
22126
22127    die($ex);
22128  }
22129
22130  unlink($log_file);
22131}
22132
22133sub sftp_realpath_symlink_dir {
22134  my $self = shift;
22135  my $tmpdir = $self->{tmpdir};
22136
22137  my $config_file = "$tmpdir/sftp.conf";
22138  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
22139  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
22140
22141  my $log_file = test_get_logfile();
22142
22143  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
22144  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
22145
22146  my $user = 'proftpd';
22147  my $passwd = 'test';
22148  my $group = 'ftpd';
22149  my $home_dir = File::Spec->rel2abs($tmpdir);
22150  my $uid = 500;
22151  my $gid = 500;
22152
22153  # Make sure that, if we're running as root, that the home directory has
22154  # permissions/privs set for the account we create
22155  if ($< == 0) {
22156    unless (chmod(0755, $home_dir)) {
22157      die("Can't set perms on $home_dir to 0755: $!");
22158    }
22159
22160    unless (chown($uid, $gid, $home_dir)) {
22161      die("Can't set owner of $home_dir to $uid/$gid: $!");
22162    }
22163  }
22164
22165  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
22166    '/bin/bash');
22167  auth_group_write($auth_group_file, $group, $gid, $user);
22168
22169  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
22170  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
22171
22172  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
22173  mkpath($test_dir);
22174
22175  my $cwd = getcwd();
22176  unless (chdir($tmpdir)) {
22177    die("Can't chdir to $tmpdir: $!");
22178  }
22179
22180  unless (symlink('test.d', 'test.lnk')) {
22181    die("Can't symlink 'test.d' to 'test.lnk': $!");
22182  }
22183
22184  unless (chdir($cwd)) {
22185    die("Can't chdir to $cwd: $!");
22186  }
22187
22188  my $config = {
22189    PidFile => $pid_file,
22190    ScoreboardFile => $scoreboard_file,
22191    SystemLog => $log_file,
22192    TraceLog => $log_file,
22193    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
22194
22195    AuthUserFile => $auth_user_file,
22196    AuthGroupFile => $auth_group_file,
22197
22198    IfModules => {
22199      'mod_delay.c' => {
22200        DelayEngine => 'off',
22201      },
22202
22203      'mod_sftp.c' => [
22204        "SFTPEngine on",
22205        "SFTPLog $log_file",
22206        "SFTPHostKey $rsa_host_key",
22207        "SFTPHostKey $dsa_host_key",
22208      ],
22209    },
22210  };
22211
22212  my ($port, $config_user, $config_group) = config_write($config_file, $config);
22213
22214  # Open pipes, for use between the parent and child processes.  Specifically,
22215  # the child will indicate when it's done with its test by writing a message
22216  # to the parent.
22217  my ($rfh, $wfh);
22218  unless (pipe($rfh, $wfh)) {
22219    die("Can't open pipe: $!");
22220  }
22221
22222  require Net::SSH2;
22223
22224  my $ex;
22225
22226  # Fork child
22227  $self->handle_sigchld();
22228  defined(my $pid = fork()) or die("Can't fork: $!");
22229  if ($pid) {
22230    eval {
22231      my $ssh2 = Net::SSH2->new();
22232
22233      sleep(1);
22234
22235      unless ($ssh2->connect('127.0.0.1', $port)) {
22236        my ($err_code, $err_name, $err_str) = $ssh2->error();
22237        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
22238      }
22239
22240      unless ($ssh2->auth_password($user, $passwd)) {
22241        my ($err_code, $err_name, $err_str) = $ssh2->error();
22242        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
22243      }
22244
22245      my $sftp = $ssh2->sftp();
22246      unless ($sftp) {
22247        my ($err_code, $err_name, $err_str) = $ssh2->error();
22248        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
22249      }
22250
22251      my $real_path = $sftp->realpath('test.lnk');
22252      unless ($real_path) {
22253        my ($err_code, $err_name) = $sftp->error();
22254        die("Can't get real path for 'test.lnk': [$err_name] ($err_code)");
22255      }
22256
22257      my $expected;
22258
22259      $expected = $test_dir;
22260      if ($^O eq 'darwin') {
22261        # MacOSX-specific hack to deal with how it handles tmp files
22262        $expected = ('/private' . $expected);
22263      }
22264
22265      $self->assert($expected eq $real_path,
22266        test_msg("Expected real path '$expected', got '$real_path'"));
22267
22268      $sftp = undef;
22269      $ssh2->disconnect();
22270    };
22271
22272    if ($@) {
22273      $ex = $@;
22274    }
22275
22276    $wfh->print("done\n");
22277    $wfh->flush();
22278
22279  } else {
22280    eval { server_wait($config_file, $rfh) };
22281    if ($@) {
22282      warn($@);
22283      exit 1;
22284    }
22285
22286    exit 0;
22287  }
22288
22289  # Stop server
22290  server_stop($pid_file);
22291
22292  $self->assert_child_ok($pid);
22293
22294  if ($ex) {
22295    test_append_logfile($log_file, $ex);
22296    unlink($log_file);
22297
22298    die($ex);
22299  }
22300
22301  unlink($log_file);
22302}
22303
22304sub sftp_realpath_symlink_dir_chrooted {
22305  my $self = shift;
22306  my $tmpdir = $self->{tmpdir};
22307
22308  my $config_file = "$tmpdir/sftp.conf";
22309  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
22310  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
22311
22312  my $log_file = test_get_logfile();
22313
22314  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
22315  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
22316
22317  my $user = 'proftpd';
22318  my $passwd = 'test';
22319  my $group = 'ftpd';
22320  my $home_dir = File::Spec->rel2abs($tmpdir);
22321  my $uid = 500;
22322  my $gid = 500;
22323
22324  # Make sure that, if we're running as root, that the home directory has
22325  # permissions/privs set for the account we create
22326  if ($< == 0) {
22327    unless (chmod(0755, $home_dir)) {
22328      die("Can't set perms on $home_dir to 0755: $!");
22329    }
22330
22331    unless (chown($uid, $gid, $home_dir)) {
22332      die("Can't set owner of $home_dir to $uid/$gid: $!");
22333    }
22334  }
22335
22336  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
22337    '/bin/bash');
22338  auth_group_write($auth_group_file, $group, $gid, $user);
22339
22340  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
22341  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
22342
22343  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
22344  mkpath($test_dir);
22345
22346  # This is the path the client should see, since it is chrooted
22347  my $chrooted_dir = "/test.d";
22348
22349  my $cwd = getcwd();
22350  unless (chdir($tmpdir)) {
22351    die("Can't chdir to $tmpdir: $!");
22352  }
22353
22354  unless (symlink('test.d', 'test.lnk')) {
22355    die("Can't symlink 'test.d' to 'test.lnk': $!");
22356  }
22357
22358  unless (chdir($cwd)) {
22359    die("Can't chdir to $cwd: $!");
22360  }
22361
22362  my $config = {
22363    PidFile => $pid_file,
22364    ScoreboardFile => $scoreboard_file,
22365    SystemLog => $log_file,
22366    TraceLog => $log_file,
22367    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
22368
22369    AuthUserFile => $auth_user_file,
22370    AuthGroupFile => $auth_group_file,
22371    DefaultRoot => '~',
22372
22373    IfModules => {
22374      'mod_delay.c' => {
22375        DelayEngine => 'off',
22376      },
22377
22378      'mod_sftp.c' => [
22379        "SFTPEngine on",
22380        "SFTPLog $log_file",
22381        "SFTPHostKey $rsa_host_key",
22382        "SFTPHostKey $dsa_host_key",
22383      ],
22384    },
22385  };
22386
22387  my ($port, $config_user, $config_group) = config_write($config_file, $config);
22388
22389  # Open pipes, for use between the parent and child processes.  Specifically,
22390  # the child will indicate when it's done with its test by writing a message
22391  # to the parent.
22392  my ($rfh, $wfh);
22393  unless (pipe($rfh, $wfh)) {
22394    die("Can't open pipe: $!");
22395  }
22396
22397  require Net::SSH2;
22398
22399  my $ex;
22400
22401  # Fork child
22402  $self->handle_sigchld();
22403  defined(my $pid = fork()) or die("Can't fork: $!");
22404  if ($pid) {
22405    eval {
22406      my $ssh2 = Net::SSH2->new();
22407
22408      sleep(1);
22409
22410      unless ($ssh2->connect('127.0.0.1', $port)) {
22411        my ($err_code, $err_name, $err_str) = $ssh2->error();
22412        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
22413      }
22414
22415      unless ($ssh2->auth_password($user, $passwd)) {
22416        my ($err_code, $err_name, $err_str) = $ssh2->error();
22417        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
22418      }
22419
22420      my $sftp = $ssh2->sftp();
22421      unless ($sftp) {
22422        my ($err_code, $err_name, $err_str) = $ssh2->error();
22423        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
22424      }
22425
22426      my $real_path = $sftp->realpath('test.lnk');
22427      unless ($real_path) {
22428        my ($err_code, $err_name) = $sftp->error();
22429        die("Can't get real path for 'test.lnk': [$err_name] ($err_code)");
22430      }
22431
22432      my $expected;
22433
22434      $expected = $chrooted_dir;
22435      $self->assert($expected eq $real_path,
22436        test_msg("Expected real path '$expected', got '$real_path'"));
22437
22438      $sftp = undef;
22439      $ssh2->disconnect();
22440    };
22441
22442    if ($@) {
22443      $ex = $@;
22444    }
22445
22446    $wfh->print("done\n");
22447    $wfh->flush();
22448
22449  } else {
22450    eval { server_wait($config_file, $rfh) };
22451    if ($@) {
22452      warn($@);
22453      exit 1;
22454    }
22455
22456    exit 0;
22457  }
22458
22459  # Stop server
22460  server_stop($pid_file);
22461
22462  $self->assert_child_ok($pid);
22463
22464  if ($ex) {
22465    test_append_logfile($log_file, $ex);
22466    unlink($log_file);
22467
22468    die($ex);
22469  }
22470
22471  unlink($log_file);
22472}
22473
22474sub sftp_open_enoent_bug3345 {
22475  my $self = shift;
22476  my $tmpdir = $self->{tmpdir};
22477
22478  my $config_file = "$tmpdir/sftp.conf";
22479  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
22480  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
22481
22482  my $log_file = test_get_logfile();
22483
22484  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
22485  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
22486
22487  my $user = 'proftpd';
22488  my $passwd = 'test';
22489  my $group = 'ftpd';
22490  my $home_dir = File::Spec->rel2abs($tmpdir);
22491  my $uid = 500;
22492  my $gid = 500;
22493
22494  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
22495
22496  # Make sure that, if we're running as root, that the home directory has
22497  # permissions/privs set for the account we create
22498  if ($< == 0) {
22499    unless (chmod(0755, $home_dir)) {
22500      die("Can't set perms on $home_dir to 0755: $!");
22501    }
22502
22503    unless (chown($uid, $gid, $home_dir)) {
22504      die("Can't set owner of $home_dir to $uid/$gid: $!");
22505    }
22506  }
22507
22508  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
22509    '/bin/bash');
22510  auth_group_write($auth_group_file, $group, $gid, $user);
22511
22512  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
22513  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
22514
22515  my $config = {
22516    PidFile => $pid_file,
22517    ScoreboardFile => $scoreboard_file,
22518    SystemLog => $log_file,
22519    TraceLog => $log_file,
22520    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
22521
22522    AuthUserFile => $auth_user_file,
22523    AuthGroupFile => $auth_group_file,
22524
22525    IfModules => {
22526      'mod_delay.c' => {
22527        DelayEngine => 'off',
22528      },
22529
22530      'mod_sftp.c' => [
22531        "SFTPEngine on",
22532        "SFTPLog $log_file",
22533        "SFTPHostKey $rsa_host_key",
22534        "SFTPHostKey $dsa_host_key",
22535      ],
22536    },
22537  };
22538
22539  my ($port, $config_user, $config_group) = config_write($config_file, $config);
22540
22541  # Open pipes, for use between the parent and child processes.  Specifically,
22542  # the child will indicate when it's done with its test by writing a message
22543  # to the parent.
22544  my ($rfh, $wfh);
22545  unless (pipe($rfh, $wfh)) {
22546    die("Can't open pipe: $!");
22547  }
22548
22549  require Net::SSH2;
22550
22551  my $ex;
22552
22553  # Ignore SIGPIPE
22554  local $SIG{PIPE} = sub { };
22555
22556  # Fork child
22557  $self->handle_sigchld();
22558  defined(my $pid = fork()) or die("Can't fork: $!");
22559  if ($pid) {
22560    eval {
22561      my $ssh2 = Net::SSH2->new();
22562
22563      sleep(1);
22564
22565      unless ($ssh2->connect('127.0.0.1', $port)) {
22566        my ($err_code, $err_name, $err_str) = $ssh2->error();
22567        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
22568      }
22569
22570      unless ($ssh2->auth_password($user, $passwd)) {
22571        my ($err_code, $err_name, $err_str) = $ssh2->error();
22572        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
22573      }
22574
22575      my $sftp = $ssh2->sftp();
22576      unless ($sftp) {
22577        my ($err_code, $err_name, $err_str) = $ssh2->error();
22578        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
22579      }
22580
22581      my $fh = $sftp->open('test.txt', O_RDONLY);
22582      if ($fh) {
22583        die("OPEN test.txt succeeded unexpectedly");
22584      }
22585
22586      my ($err_code, $err_name) = $sftp->error();
22587
22588      my $expected;
22589
22590      $expected = 'SSH_FX_NO_SUCH_FILE';
22591      $self->assert($expected eq $err_name,
22592        test_msg("Expected '$expected', got '$err_name'"));
22593
22594      $expected = 2;
22595      $self->assert($expected == $err_code,
22596        test_msg("Expected $expected, got $err_code"));
22597
22598      $sftp = undef;
22599      $ssh2->disconnect();
22600    };
22601
22602    if ($@) {
22603      $ex = $@;
22604    }
22605
22606    $wfh->print("done\n");
22607    $wfh->flush();
22608
22609  } else {
22610    eval { server_wait($config_file, $rfh) };
22611    if ($@) {
22612      warn($@);
22613      exit 1;
22614    }
22615
22616    exit 0;
22617  }
22618
22619  # Stop server
22620  server_stop($pid_file);
22621
22622  $self->assert_child_ok($pid);
22623
22624  if ($ex) {
22625    test_append_logfile($log_file, $ex);
22626    unlink($log_file);
22627
22628    die($ex);
22629  }
22630
22631  unlink($log_file);
22632}
22633
22634sub sftp_open_trunc_bug3449 {
22635  my $self = shift;
22636  my $tmpdir = $self->{tmpdir};
22637
22638  my $config_file = "$tmpdir/sftp.conf";
22639  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
22640  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
22641
22642  my $log_file = test_get_logfile();
22643
22644  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
22645  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
22646
22647  my $user = 'proftpd';
22648  my $passwd = 'test';
22649  my $group = 'ftpd';
22650  my $home_dir = File::Spec->rel2abs($tmpdir);
22651  my $uid = 500;
22652  my $gid = 500;
22653
22654  # Make sure that, if we're running as root, that the home directory has
22655  # permissions/privs set for the account we create
22656  if ($< == 0) {
22657    unless (chmod(0755, $home_dir)) {
22658      die("Can't set perms on $home_dir to 0755: $!");
22659    }
22660
22661    unless (chown($uid, $gid, $home_dir)) {
22662      die("Can't set owner of $home_dir to $uid/$gid: $!");
22663    }
22664  }
22665
22666  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
22667    '/bin/bash');
22668  auth_group_write($auth_group_file, $group, $gid, $user);
22669
22670  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
22671  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
22672
22673  my $config = {
22674    PidFile => $pid_file,
22675    ScoreboardFile => $scoreboard_file,
22676    SystemLog => $log_file,
22677    TraceLog => $log_file,
22678    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
22679
22680    AuthUserFile => $auth_user_file,
22681    AuthGroupFile => $auth_group_file,
22682    AllowOverwrite => 'on',
22683
22684    IfModules => {
22685      'mod_delay.c' => {
22686        DelayEngine => 'off',
22687      },
22688
22689      'mod_sftp.c' => [
22690        "SFTPEngine on",
22691        "SFTPLog $log_file",
22692        "SFTPHostKey $rsa_host_key",
22693        "SFTPHostKey $dsa_host_key",
22694      ],
22695    },
22696  };
22697
22698  my ($port, $config_user, $config_group) = config_write($config_file, $config);
22699
22700  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
22701  if (open(my $fh, "> $test_file")) {
22702    print $fh "ABCD" x 1024;
22703    unless (close($fh)) {
22704      die("Can't write $test_file: $!");
22705    }
22706
22707  } else {
22708    die("Can't open $test_file: $!");
22709  }
22710
22711  my $test_size = (stat($test_file))[7];
22712
22713  # Open pipes, for use between the parent and child processes.  Specifically,
22714  # the child will indicate when it's done with its test by writing a message
22715  # to the parent.
22716  my ($rfh, $wfh);
22717  unless (pipe($rfh, $wfh)) {
22718    die("Can't open pipe: $!");
22719  }
22720
22721  require Net::SSH2;
22722
22723  my $ex;
22724
22725  # Fork child
22726  $self->handle_sigchld();
22727  defined(my $pid = fork()) or die("Can't fork: $!");
22728  if ($pid) {
22729    eval {
22730      my $ssh2 = Net::SSH2->new();
22731
22732      sleep(1);
22733
22734      unless ($ssh2->connect('127.0.0.1', $port)) {
22735        my ($err_code, $err_name, $err_str) = $ssh2->error();
22736        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
22737      }
22738
22739      unless ($ssh2->auth_password($user, $passwd)) {
22740        my ($err_code, $err_name, $err_str) = $ssh2->error();
22741        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
22742      }
22743
22744      my $sftp = $ssh2->sftp();
22745      unless ($sftp) {
22746        my ($err_code, $err_name, $err_str) = $ssh2->error();
22747        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
22748      }
22749
22750      my $attrs = $sftp->stat('test.txt', 0);
22751      unless ($attrs) {
22752        my ($err_code, $err_name) = $sftp->error();
22753        die("LSTAT test.txt failed: [$err_name] ($err_code)");
22754      }
22755
22756      my $expected;
22757
22758      $expected = $test_size;
22759      my $file_size = $attrs->{size};
22760      $self->assert($expected == $file_size,
22761        test_msg("Expected '$expected', got '$file_size'"));
22762
22763      $expected = $<;
22764      my $file_uid = $attrs->{uid};
22765      $self->assert($expected == $file_uid,
22766        test_msg("Expected '$expected', got '$file_uid'"));
22767
22768      $expected = $(;
22769      my $file_gid = $attrs->{gid};
22770      $self->assert($expected == $file_gid,
22771        test_msg("Expected '$expected', got '$file_gid'"));
22772
22773      my $orig_size = $attrs->{size};
22774
22775      my $fh = $sftp->open('test.txt', O_WRONLY|O_TRUNC);
22776      unless ($fh) {
22777        my ($err_code, $err_name) = $sftp->error();
22778        die("OPEN test.txt failed: [$err_name] ($err_code)");
22779      }
22780
22781      $attrs = $sftp->stat('test.txt', 0);
22782      unless ($attrs) {
22783        my ($err_code, $err_name) = $sftp->error();
22784        die("LSTAT test.txt failed: [$err_name] ($err_code)");
22785      }
22786
22787      $expected = 0;
22788      $file_size = $attrs->{size};
22789      $self->assert($expected == $file_size,
22790        test_msg("Expected '$expected', got '$file_size'"));
22791
22792      # To issue a CLOSE, we need to destroy the filehandle
22793      $fh = undef;
22794
22795      $attrs = $sftp->stat('test.txt', 0);
22796      unless ($attrs) {
22797        my ($err_code, $err_name) = $sftp->error();
22798        die("LSTAT test.txt failed: [$err_name] ($err_code)");
22799      }
22800
22801      $expected = 0;
22802      $file_size = $attrs->{size};
22803      $self->assert($expected == $file_size,
22804        test_msg("Expected '$expected', got '$file_size'"));
22805
22806      $sftp = undef;
22807      $ssh2->disconnect();
22808    };
22809
22810    if ($@) {
22811      $ex = $@;
22812    }
22813
22814    $wfh->print("done\n");
22815    $wfh->flush();
22816
22817  } else {
22818    eval { server_wait($config_file, $rfh) };
22819    if ($@) {
22820      warn($@);
22821      exit 1;
22822    }
22823
22824    exit 0;
22825  }
22826
22827  # Stop server
22828  server_stop($pid_file);
22829
22830  $self->assert_child_ok($pid);
22831
22832  if ($ex) {
22833    test_append_logfile($log_file, $ex);
22834    unlink($log_file);
22835
22836    die($ex);
22837  }
22838
22839  unlink($log_file);
22840}
22841
22842sub sftp_open_creat {
22843  my $self = shift;
22844  my $tmpdir = $self->{tmpdir};
22845
22846  my $config_file = "$tmpdir/sftp.conf";
22847  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
22848  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
22849
22850  my $log_file = test_get_logfile();
22851
22852  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
22853  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
22854
22855  my $user = 'proftpd';
22856  my $passwd = 'test';
22857  my $group = 'ftpd';
22858  my $home_dir = File::Spec->rel2abs($tmpdir);
22859  my $uid = 500;
22860  my $gid = 500;
22861
22862  # Make sure that, if we're running as root, that the home directory has
22863  # permissions/privs set for the account we create
22864  if ($< == 0) {
22865    unless (chmod(0755, $home_dir)) {
22866      die("Can't set perms on $home_dir to 0755: $!");
22867    }
22868
22869    unless (chown($uid, $gid, $home_dir)) {
22870      die("Can't set owner of $home_dir to $uid/$gid: $!");
22871    }
22872  }
22873
22874  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
22875    '/bin/bash');
22876  auth_group_write($auth_group_file, $group, $gid, $user);
22877
22878  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
22879  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
22880
22881  my $config = {
22882    PidFile => $pid_file,
22883    ScoreboardFile => $scoreboard_file,
22884    SystemLog => $log_file,
22885    TraceLog => $log_file,
22886    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
22887
22888    AuthUserFile => $auth_user_file,
22889    AuthGroupFile => $auth_group_file,
22890    AllowOverwrite => 'on',
22891
22892    IfModules => {
22893      'mod_delay.c' => {
22894        DelayEngine => 'off',
22895      },
22896
22897      'mod_sftp.c' => [
22898        "SFTPEngine on",
22899        "SFTPLog $log_file",
22900        "SFTPHostKey $rsa_host_key",
22901        "SFTPHostKey $dsa_host_key",
22902      ],
22903    },
22904  };
22905
22906  my ($port, $config_user, $config_group) = config_write($config_file, $config);
22907
22908  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
22909
22910  # Open pipes, for use between the parent and child processes.  Specifically,
22911  # the child will indicate when it's done with its test by writing a message
22912  # to the parent.
22913  my ($rfh, $wfh);
22914  unless (pipe($rfh, $wfh)) {
22915    die("Can't open pipe: $!");
22916  }
22917
22918  require Net::SSH2;
22919
22920  my $ex;
22921
22922  # Fork child
22923  $self->handle_sigchld();
22924  defined(my $pid = fork()) or die("Can't fork: $!");
22925  if ($pid) {
22926    eval {
22927      my $ssh2 = Net::SSH2->new();
22928
22929      sleep(1);
22930
22931      unless ($ssh2->connect('127.0.0.1', $port)) {
22932        my ($err_code, $err_name, $err_str) = $ssh2->error();
22933        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
22934      }
22935
22936      unless ($ssh2->auth_password($user, $passwd)) {
22937        my ($err_code, $err_name, $err_str) = $ssh2->error();
22938        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
22939      }
22940
22941      my $sftp = $ssh2->sftp();
22942      unless ($sftp) {
22943        my ($err_code, $err_name, $err_str) = $ssh2->error();
22944        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
22945      }
22946
22947      my $fh = $sftp->open('test.txt', O_CREAT, 0640);
22948      unless ($fh) {
22949        my ($err_code, $err_name) = $sftp->error();
22950        die("OPEN test.txt failed: [$err_name] ($err_code)");
22951      }
22952
22953      # To issue a CLOSE, we need to destroy the filehandle
22954      $fh = undef;
22955
22956      $sftp = undef;
22957      $ssh2->disconnect();
22958
22959      unless (-f $test_file) {
22960        die("File $test_file does not exist as expected");
22961      }
22962    };
22963
22964    if ($@) {
22965      $ex = $@;
22966    }
22967
22968    $wfh->print("done\n");
22969    $wfh->flush();
22970
22971  } else {
22972    eval { server_wait($config_file, $rfh) };
22973    if ($@) {
22974      warn($@);
22975      exit 1;
22976    }
22977
22978    exit 0;
22979  }
22980
22981  # Stop server
22982  server_stop($pid_file);
22983
22984  $self->assert_child_ok($pid);
22985
22986  if ($ex) {
22987    test_append_logfile($log_file, $ex);
22988    unlink($log_file);
22989
22990    die($ex);
22991  }
22992
22993  unlink($log_file);
22994}
22995
22996sub sftp_open_creat_excl {
22997  my $self = shift;
22998  my $tmpdir = $self->{tmpdir};
22999
23000  my $config_file = "$tmpdir/sftp.conf";
23001  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
23002  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
23003
23004  my $log_file = test_get_logfile();
23005
23006  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
23007  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
23008
23009  my $user = 'proftpd';
23010  my $passwd = 'test';
23011  my $group = 'ftpd';
23012  my $home_dir = File::Spec->rel2abs($tmpdir);
23013  my $uid = 500;
23014  my $gid = 500;
23015
23016  # Make sure that, if we're running as root, that the home directory has
23017  # permissions/privs set for the account we create
23018  if ($< == 0) {
23019    unless (chmod(0755, $home_dir)) {
23020      die("Can't set perms on $home_dir to 0755: $!");
23021    }
23022
23023    unless (chown($uid, $gid, $home_dir)) {
23024      die("Can't set owner of $home_dir to $uid/$gid: $!");
23025    }
23026  }
23027
23028  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
23029    '/bin/bash');
23030  auth_group_write($auth_group_file, $group, $gid, $user);
23031
23032  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
23033  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
23034
23035  my $config = {
23036    PidFile => $pid_file,
23037    ScoreboardFile => $scoreboard_file,
23038    SystemLog => $log_file,
23039    TraceLog => $log_file,
23040    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
23041
23042    AuthUserFile => $auth_user_file,
23043    AuthGroupFile => $auth_group_file,
23044    AllowOverwrite => 'on',
23045
23046    IfModules => {
23047      'mod_delay.c' => {
23048        DelayEngine => 'off',
23049      },
23050
23051      'mod_sftp.c' => [
23052        "SFTPEngine on",
23053        "SFTPLog $log_file",
23054        "SFTPHostKey $rsa_host_key",
23055        "SFTPHostKey $dsa_host_key",
23056      ],
23057    },
23058  };
23059
23060  my ($port, $config_user, $config_group) = config_write($config_file, $config);
23061
23062  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
23063  if (open(my $fh, "> $test_file")) {
23064    print $fh "Hello, World!\n";
23065    unless (close($fh)) {
23066      die("Can't write $test_file: $!");
23067    }
23068
23069  } else {
23070    die("Can't open $test_file: $!");
23071  }
23072
23073  # Open pipes, for use between the parent and child processes.  Specifically,
23074  # the child will indicate when it's done with its test by writing a message
23075  # to the parent.
23076  my ($rfh, $wfh);
23077  unless (pipe($rfh, $wfh)) {
23078    die("Can't open pipe: $!");
23079  }
23080
23081  require Net::SSH2;
23082
23083  my $ex;
23084
23085  # Fork child
23086  $self->handle_sigchld();
23087  defined(my $pid = fork()) or die("Can't fork: $!");
23088  if ($pid) {
23089    eval {
23090      my $ssh2 = Net::SSH2->new();
23091
23092      sleep(1);
23093
23094      unless ($ssh2->connect('127.0.0.1', $port)) {
23095        my ($err_code, $err_name, $err_str) = $ssh2->error();
23096        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
23097      }
23098
23099      unless ($ssh2->auth_password($user, $passwd)) {
23100        my ($err_code, $err_name, $err_str) = $ssh2->error();
23101        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
23102      }
23103
23104      my $sftp = $ssh2->sftp();
23105      unless ($sftp) {
23106        my ($err_code, $err_name, $err_str) = $ssh2->error();
23107        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
23108      }
23109
23110      # This should fail, since the file already exists
23111      my $fh = $sftp->open('test.txt', O_CREAT|O_EXCL, 0640);
23112      if ($fh) {
23113        die("OPEN test.txt succeeded unexpectedly");
23114      }
23115
23116      my ($err_code, $err_name) = $sftp->error();
23117
23118      my $expected;
23119
23120      $expected = 'SSH_FX_FAILURE';
23121      $self->assert($expected eq $err_name,
23122        test_msg("Expected '$expected', got '$err_name'"));
23123
23124      # Now remove that file, and try again.
23125      unlink($test_file);
23126
23127      $fh = $sftp->open('test.txt', O_CREAT|O_EXCL, 0640);
23128      unless ($fh) {
23129        my ($err_code, $err_name) = $sftp->error();
23130        die("OPEN test.txt failed: [$err_name] ($err_code)");
23131      }
23132
23133      # To issue a CLOSE, we need to destroy the filehandle
23134      $fh = undef;
23135
23136      $sftp = undef;
23137      $ssh2->disconnect();
23138
23139      unless (-f $test_file) {
23140        die("File $test_file does not exist as expected");
23141      }
23142    };
23143
23144    if ($@) {
23145      $ex = $@;
23146    }
23147
23148    $wfh->print("done\n");
23149    $wfh->flush();
23150
23151  } else {
23152    eval { server_wait($config_file, $rfh) };
23153    if ($@) {
23154      warn($@);
23155      exit 1;
23156    }
23157
23158    exit 0;
23159  }
23160
23161  # Stop server
23162  server_stop($pid_file);
23163
23164  $self->assert_child_ok($pid);
23165
23166  if ($ex) {
23167    test_append_logfile($log_file, $ex);
23168    unlink($log_file);
23169
23170    die($ex);
23171  }
23172
23173  unlink($log_file);
23174}
23175
23176sub sftp_open_append_bug3450 {
23177  my $self = shift;
23178  my $tmpdir = $self->{tmpdir};
23179
23180  my $config_file = "$tmpdir/sftp.conf";
23181  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
23182  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
23183
23184  my $log_file = test_get_logfile();
23185
23186  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
23187  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
23188
23189  my $user = 'proftpd';
23190  my $passwd = 'test';
23191  my $group = 'ftpd';
23192  my $home_dir = File::Spec->rel2abs($tmpdir);
23193  my $uid = 500;
23194  my $gid = 500;
23195
23196  # Make sure that, if we're running as root, that the home directory has
23197  # permissions/privs set for the account we create
23198  if ($< == 0) {
23199    unless (chmod(0755, $home_dir)) {
23200      die("Can't set perms on $home_dir to 0755: $!");
23201    }
23202
23203    unless (chown($uid, $gid, $home_dir)) {
23204      die("Can't set owner of $home_dir to $uid/$gid: $!");
23205    }
23206  }
23207
23208  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
23209    '/bin/bash');
23210  auth_group_write($auth_group_file, $group, $gid, $user);
23211
23212  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
23213  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
23214
23215  my $config = {
23216    PidFile => $pid_file,
23217    ScoreboardFile => $scoreboard_file,
23218    SystemLog => $log_file,
23219    TraceLog => $log_file,
23220    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
23221
23222    AuthUserFile => $auth_user_file,
23223    AuthGroupFile => $auth_group_file,
23224    AllowOverwrite => 'on',
23225    AllowStoreRestart => 'on',
23226
23227    IfModules => {
23228      'mod_delay.c' => {
23229        DelayEngine => 'off',
23230      },
23231
23232      'mod_sftp.c' => [
23233        "SFTPEngine on",
23234        "SFTPLog $log_file",
23235        "SFTPHostKey $rsa_host_key",
23236        "SFTPHostKey $dsa_host_key",
23237      ],
23238    },
23239  };
23240
23241  my ($port, $config_user, $config_group) = config_write($config_file, $config);
23242
23243  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
23244  if (open(my $fh, "> $test_file")) {
23245    print $fh "Hello, World!\n";
23246    unless (close($fh)) {
23247      die("Can't write $test_file: $!");
23248    }
23249
23250  } else {
23251    die("Can't open $test_file: $!");
23252  }
23253
23254  my $test_size = (stat($test_file))[7];
23255
23256  # Open pipes, for use between the parent and child processes.  Specifically,
23257  # the child will indicate when it's done with its test by writing a message
23258  # to the parent.
23259  my ($rfh, $wfh);
23260  unless (pipe($rfh, $wfh)) {
23261    die("Can't open pipe: $!");
23262  }
23263
23264  require Net::SSH2;
23265
23266  my $ex;
23267
23268  # Fork child
23269  $self->handle_sigchld();
23270  defined(my $pid = fork()) or die("Can't fork: $!");
23271  if ($pid) {
23272    eval {
23273      my $ssh2 = Net::SSH2->new();
23274
23275      sleep(1);
23276
23277      unless ($ssh2->connect('127.0.0.1', $port)) {
23278        my ($err_code, $err_name, $err_str) = $ssh2->error();
23279        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
23280      }
23281
23282      unless ($ssh2->auth_password($user, $passwd)) {
23283        my ($err_code, $err_name, $err_str) = $ssh2->error();
23284        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
23285      }
23286
23287      my $sftp = $ssh2->sftp();
23288      unless ($sftp) {
23289        my ($err_code, $err_name, $err_str) = $ssh2->error();
23290        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
23291      }
23292
23293      my $fh = $sftp->open('test.txt', O_APPEND);
23294      unless ($fh) {
23295        my ($err_code, $err_name) = $sftp->error();
23296        die("OPEN test.txt failed: [$err_name] ($err_code)");
23297      }
23298
23299      unless ($fh->write("ABCD")) {
23300        my ($err_code, $err_name) = $sftp->error();
23301        die("WRITE test.txt failed: [$err_name] ($err_code)");
23302      }
23303
23304      # To issue a CLOSE, we need to destroy the filehandle
23305      $fh = undef;
23306
23307      $sftp = undef;
23308      $ssh2->disconnect();
23309
23310      unless (-f $test_file) {
23311        die("File $test_file does not exist as expected");
23312      }
23313
23314      my $new_size = (stat($test_file))[7];
23315      my $expected_size = $test_size + 4;
23316
23317      $self->assert($expected_size == $new_size,
23318        test_msg("Expected $expected_size, got $new_size"));
23319    };
23320
23321    if ($@) {
23322      $ex = $@;
23323    }
23324
23325    $wfh->print("done\n");
23326    $wfh->flush();
23327
23328  } else {
23329    eval { server_wait($config_file, $rfh) };
23330    if ($@) {
23331      warn($@);
23332      exit 1;
23333    }
23334
23335    exit 0;
23336  }
23337
23338  # Stop server
23339  server_stop($pid_file);
23340
23341  $self->assert_child_ok($pid);
23342
23343  if ($ex) {
23344    test_append_logfile($log_file, $ex);
23345    unlink($log_file);
23346
23347    die($ex);
23348  }
23349
23350  unlink($log_file);
23351}
23352
23353sub sftp_open_rdonly {
23354  my $self = shift;
23355  my $tmpdir = $self->{tmpdir};
23356
23357  my $config_file = "$tmpdir/sftp.conf";
23358  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
23359  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
23360
23361  my $log_file = test_get_logfile();
23362
23363  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
23364  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
23365
23366  my $user = 'proftpd';
23367  my $passwd = 'test';
23368  my $group = 'ftpd';
23369  my $home_dir = File::Spec->rel2abs($tmpdir);
23370  my $uid = 500;
23371  my $gid = 500;
23372
23373  # Make sure that, if we're running as root, that the home directory has
23374  # permissions/privs set for the account we create
23375  if ($< == 0) {
23376    unless (chmod(0755, $home_dir)) {
23377      die("Can't set perms on $home_dir to 0755: $!");
23378    }
23379
23380    unless (chown($uid, $gid, $home_dir)) {
23381      die("Can't set owner of $home_dir to $uid/$gid: $!");
23382    }
23383  }
23384
23385  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
23386    '/bin/bash');
23387  auth_group_write($auth_group_file, $group, $gid, $user);
23388
23389  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
23390  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
23391
23392  my $config = {
23393    PidFile => $pid_file,
23394    ScoreboardFile => $scoreboard_file,
23395    SystemLog => $log_file,
23396    TraceLog => $log_file,
23397    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
23398
23399    AuthUserFile => $auth_user_file,
23400    AuthGroupFile => $auth_group_file,
23401    AllowOverwrite => 'on',
23402    AllowStoreRestart => 'on',
23403
23404    IfModules => {
23405      'mod_delay.c' => {
23406        DelayEngine => 'off',
23407      },
23408
23409      'mod_sftp.c' => [
23410        "SFTPEngine on",
23411        "SFTPLog $log_file",
23412        "SFTPHostKey $rsa_host_key",
23413        "SFTPHostKey $dsa_host_key",
23414      ],
23415    },
23416  };
23417
23418  my ($port, $config_user, $config_group) = config_write($config_file, $config);
23419
23420  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
23421  if (open(my $fh, "> $test_file")) {
23422    print $fh "Hello, World!\n";
23423
23424    unless (close($fh)) {
23425      die("Can't write $test_file: $!");
23426    }
23427
23428  } else {
23429    die("Can't open $test_file: $!");
23430  }
23431
23432  # Set write-only permissions
23433  unless (chmod(0222, $test_file)) {
23434    die("Can't set perms on $test_file to 0222: $!");
23435  }
23436
23437  # Open pipes, for use between the parent and child processes.  Specifically,
23438  # the child will indicate when it's done with its test by writing a message
23439  # to the parent.
23440  my ($rfh, $wfh);
23441  unless (pipe($rfh, $wfh)) {
23442    die("Can't open pipe: $!");
23443  }
23444
23445  require Net::SSH2;
23446
23447  my $ex;
23448
23449  # Fork child
23450  $self->handle_sigchld();
23451  defined(my $pid = fork()) or die("Can't fork: $!");
23452  if ($pid) {
23453    eval {
23454      my $ssh2 = Net::SSH2->new();
23455
23456      sleep(1);
23457
23458      unless ($ssh2->connect('127.0.0.1', $port)) {
23459        my ($err_code, $err_name, $err_str) = $ssh2->error();
23460        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
23461      }
23462
23463      unless ($ssh2->auth_password($user, $passwd)) {
23464        my ($err_code, $err_name, $err_str) = $ssh2->error();
23465        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
23466      }
23467
23468      my $sftp = $ssh2->sftp();
23469      unless ($sftp) {
23470        my ($err_code, $err_name, $err_str) = $ssh2->error();
23471        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
23472      }
23473
23474      my $fh = $sftp->open('test.txt', O_RDONLY);
23475      if ($fh) {
23476        die("OPEN test.txt succeeded unexpectedly");
23477      }
23478
23479      my ($err_code, $err_name) = $sftp->error();
23480
23481      my $expected;
23482
23483      $expected = 'SSH_FX_PERMISSION_DENIED';
23484      $self->assert($expected eq $err_name,
23485        test_msg("Expected '$expected', got '$err_name'"));
23486
23487      $sftp = undef;
23488      $ssh2->disconnect();
23489    };
23490
23491    if ($@) {
23492      $ex = $@;
23493    }
23494
23495    $wfh->print("done\n");
23496    $wfh->flush();
23497
23498  } else {
23499    eval { server_wait($config_file, $rfh) };
23500    if ($@) {
23501      warn($@);
23502      exit 1;
23503    }
23504
23505    exit 0;
23506  }
23507
23508  # Stop server
23509  server_stop($pid_file);
23510
23511  $self->assert_child_ok($pid);
23512
23513  if ($ex) {
23514    test_append_logfile($log_file, $ex);
23515    unlink($log_file);
23516
23517    die($ex);
23518  }
23519
23520  unlink($log_file);
23521}
23522
23523sub sftp_open_wronly {
23524  my $self = shift;
23525  my $tmpdir = $self->{tmpdir};
23526
23527  my $config_file = "$tmpdir/sftp.conf";
23528  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
23529  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
23530
23531  my $log_file = test_get_logfile();
23532
23533  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
23534  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
23535
23536  my $user = 'proftpd';
23537  my $passwd = 'test';
23538  my $group = 'ftpd';
23539  my $home_dir = File::Spec->rel2abs($tmpdir);
23540  my $uid = 500;
23541  my $gid = 500;
23542
23543  # Make sure that, if we're running as root, that the home directory has
23544  # permissions/privs set for the account we create
23545  if ($< == 0) {
23546    unless (chmod(0755, $home_dir)) {
23547      die("Can't set perms on $home_dir to 0755: $!");
23548    }
23549
23550    unless (chown($uid, $gid, $home_dir)) {
23551      die("Can't set owner of $home_dir to $uid/$gid: $!");
23552    }
23553  }
23554
23555  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
23556    '/bin/bash');
23557  auth_group_write($auth_group_file, $group, $gid, $user);
23558
23559  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
23560  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
23561
23562  my $config = {
23563    PidFile => $pid_file,
23564    ScoreboardFile => $scoreboard_file,
23565    SystemLog => $log_file,
23566    TraceLog => $log_file,
23567    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
23568
23569    AuthUserFile => $auth_user_file,
23570    AuthGroupFile => $auth_group_file,
23571    AllowOverwrite => 'on',
23572    AllowStoreRestart => 'on',
23573
23574    IfModules => {
23575      'mod_delay.c' => {
23576        DelayEngine => 'off',
23577      },
23578
23579      'mod_sftp.c' => [
23580        "SFTPEngine on",
23581        "SFTPLog $log_file",
23582        "SFTPHostKey $rsa_host_key",
23583        "SFTPHostKey $dsa_host_key",
23584      ],
23585    },
23586  };
23587
23588  my ($port, $config_user, $config_group) = config_write($config_file, $config);
23589
23590  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
23591  if (open(my $fh, "> $test_file")) {
23592    print $fh "Hello, World!\n";
23593
23594    unless (close($fh)) {
23595      die("Can't write $test_file: $!");
23596    }
23597
23598  } else {
23599    die("Can't open $test_file: $!");
23600  }
23601
23602  # Set read-only permissions
23603  unless (chmod(0444, $test_file)) {
23604    die("Can't set perms on $test_file to 0444: $!");
23605  }
23606
23607  # Open pipes, for use between the parent and child processes.  Specifically,
23608  # the child will indicate when it's done with its test by writing a message
23609  # to the parent.
23610  my ($rfh, $wfh);
23611  unless (pipe($rfh, $wfh)) {
23612    die("Can't open pipe: $!");
23613  }
23614
23615  require Net::SSH2;
23616
23617  my $ex;
23618
23619  # Fork child
23620  $self->handle_sigchld();
23621  defined(my $pid = fork()) or die("Can't fork: $!");
23622  if ($pid) {
23623    eval {
23624      my $ssh2 = Net::SSH2->new();
23625
23626      sleep(1);
23627
23628      unless ($ssh2->connect('127.0.0.1', $port)) {
23629        my ($err_code, $err_name, $err_str) = $ssh2->error();
23630        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
23631      }
23632
23633      unless ($ssh2->auth_password($user, $passwd)) {
23634        my ($err_code, $err_name, $err_str) = $ssh2->error();
23635        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
23636      }
23637
23638      my $sftp = $ssh2->sftp();
23639      unless ($sftp) {
23640        my ($err_code, $err_name, $err_str) = $ssh2->error();
23641        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
23642      }
23643
23644      my $fh = $sftp->open('test.txt', O_WRONLY);
23645      if ($fh) {
23646        die("OPEN test.txt succeeded unexpectedly");
23647      }
23648
23649      my ($err_code, $err_name) = $sftp->error();
23650
23651      my $expected;
23652
23653      $expected = 'SSH_FX_PERMISSION_DENIED';
23654      $self->assert($expected eq $err_name,
23655        test_msg("Expected '$expected', got '$err_name'"));
23656
23657      $sftp = undef;
23658      $ssh2->disconnect();
23659    };
23660
23661    if ($@) {
23662      $ex = $@;
23663    }
23664
23665    $wfh->print("done\n");
23666    $wfh->flush();
23667
23668  } else {
23669    eval { server_wait($config_file, $rfh) };
23670    if ($@) {
23671      warn($@);
23672      exit 1;
23673    }
23674
23675    exit 0;
23676  }
23677
23678  # Stop server
23679  server_stop($pid_file);
23680
23681  $self->assert_child_ok($pid);
23682
23683  if ($ex) {
23684    test_append_logfile($log_file, $ex);
23685    unlink($log_file);
23686
23687    die($ex);
23688  }
23689
23690  unlink($log_file);
23691}
23692
23693sub sftp_open_rdwr {
23694  my $self = shift;
23695  my $tmpdir = $self->{tmpdir};
23696
23697  my $config_file = "$tmpdir/sftp.conf";
23698  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
23699  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
23700
23701  my $log_file = test_get_logfile();
23702
23703  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
23704  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
23705
23706  my $user = 'proftpd';
23707  my $passwd = 'test';
23708  my $group = 'ftpd';
23709  my $home_dir = File::Spec->rel2abs($tmpdir);
23710  my $uid = 500;
23711  my $gid = 500;
23712
23713  # Make sure that, if we're running as root, that the home directory has
23714  # permissions/privs set for the account we create
23715  if ($< == 0) {
23716    unless (chmod(0755, $home_dir)) {
23717      die("Can't set perms on $home_dir to 0755: $!");
23718    }
23719
23720    unless (chown($uid, $gid, $home_dir)) {
23721      die("Can't set owner of $home_dir to $uid/$gid: $!");
23722    }
23723  }
23724
23725  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
23726    '/bin/bash');
23727  auth_group_write($auth_group_file, $group, $gid, $user);
23728
23729  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
23730  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
23731
23732  my $config = {
23733    PidFile => $pid_file,
23734    ScoreboardFile => $scoreboard_file,
23735    SystemLog => $log_file,
23736    TraceLog => $log_file,
23737    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
23738
23739    AuthUserFile => $auth_user_file,
23740    AuthGroupFile => $auth_group_file,
23741    AllowOverwrite => 'on',
23742    AllowStoreRestart => 'on',
23743
23744    IfModules => {
23745      'mod_delay.c' => {
23746        DelayEngine => 'off',
23747      },
23748
23749      'mod_sftp.c' => [
23750        "SFTPEngine on",
23751        "SFTPLog $log_file",
23752        "SFTPHostKey $rsa_host_key",
23753        "SFTPHostKey $dsa_host_key",
23754      ],
23755    },
23756  };
23757
23758  my ($port, $config_user, $config_group) = config_write($config_file, $config);
23759
23760  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
23761  if (open(my $fh, "> $test_file")) {
23762    print $fh "Hello, World!\n";
23763
23764    unless (close($fh)) {
23765      die("Can't write $test_file: $!");
23766    }
23767
23768  } else {
23769    die("Can't open $test_file: $!");
23770  }
23771
23772  # Set execute-only permissions
23773  unless (chmod(0111, $test_file)) {
23774    die("Can't set perms on $test_file to 0111: $!");
23775  }
23776
23777  # Open pipes, for use between the parent and child processes.  Specifically,
23778  # the child will indicate when it's done with its test by writing a message
23779  # to the parent.
23780  my ($rfh, $wfh);
23781  unless (pipe($rfh, $wfh)) {
23782    die("Can't open pipe: $!");
23783  }
23784
23785  require Net::SSH2;
23786
23787  my $ex;
23788
23789  # Fork child
23790  $self->handle_sigchld();
23791  defined(my $pid = fork()) or die("Can't fork: $!");
23792  if ($pid) {
23793    eval {
23794      my $ssh2 = Net::SSH2->new();
23795
23796      sleep(1);
23797
23798      unless ($ssh2->connect('127.0.0.1', $port)) {
23799        my ($err_code, $err_name, $err_str) = $ssh2->error();
23800        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
23801      }
23802
23803      unless ($ssh2->auth_password($user, $passwd)) {
23804        my ($err_code, $err_name, $err_str) = $ssh2->error();
23805        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
23806      }
23807
23808      my $sftp = $ssh2->sftp();
23809      unless ($sftp) {
23810        my ($err_code, $err_name, $err_str) = $ssh2->error();
23811        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
23812      }
23813
23814      my $fh = $sftp->open('test.txt', O_RDWR);
23815      if ($fh) {
23816        die("OPEN test.txt succeeded unexpectedly");
23817      }
23818
23819      my ($err_code, $err_name) = $sftp->error();
23820
23821      my $expected;
23822
23823      $expected = 'SSH_FX_PERMISSION_DENIED';
23824      $self->assert($expected eq $err_name,
23825        test_msg("Expected '$expected', got '$err_name'"));
23826
23827      $sftp = undef;
23828      $ssh2->disconnect();
23829    };
23830
23831    if ($@) {
23832      $ex = $@;
23833    }
23834
23835    $wfh->print("done\n");
23836    $wfh->flush();
23837
23838  } else {
23839    eval { server_wait($config_file, $rfh) };
23840    if ($@) {
23841      warn($@);
23842      exit 1;
23843    }
23844
23845    exit 0;
23846  }
23847
23848  # Stop server
23849  server_stop($pid_file);
23850
23851  $self->assert_child_ok($pid);
23852
23853  if ($ex) {
23854    test_append_logfile($log_file, $ex);
23855    unlink($log_file);
23856
23857    die($ex);
23858  }
23859
23860  unlink($log_file);
23861}
23862
23863sub sftp_open_abs_symlink {
23864  my $self = shift;
23865  my $tmpdir = $self->{tmpdir};
23866  my $setup = test_setup($tmpdir, 'sftp');
23867
23868  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
23869  mkpath($test_dir);
23870
23871  my $test_data = "Hello, World!\n";
23872
23873  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
23874  if (open(my $fh, "> $test_file")) {
23875    print $fh $test_data;
23876    unless (close($fh)) {
23877      die("Can't write $test_file: $!");
23878    }
23879
23880  } else {
23881    die("Can't open $test_file: $!");
23882  }
23883
23884  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
23885
23886  my $dst_path = $test_file;
23887  if ($^O eq 'darwin') {
23888    # MacOSX-specific hack
23889    $dst_path = '/private' . $dst_path;
23890  }
23891
23892  unless (symlink($dst_path, $test_symlink)) {
23893    die("Can't symlink $test_symlink to $dst_path: $!");
23894  }
23895
23896  if ($< == 0) {
23897    unless (chmod(0755, $test_dir, $test_file)) {
23898      die("Can't set perms on $test_dir to 0755: $!");
23899    }
23900
23901    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
23902      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
23903    }
23904  }
23905
23906  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
23907  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
23908
23909  my $config = {
23910    PidFile => $setup->{pid_file},
23911    ScoreboardFile => $setup->{scoreboard_file},
23912    SystemLog => $setup->{log_file},
23913    TraceLog => $setup->{log_file},
23914    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
23915
23916    AuthUserFile => $setup->{auth_user_file},
23917    AuthGroupFile => $setup->{auth_group_file},
23918    AllowOverwrite => 'on',
23919    AllowStoreRestart => 'on',
23920
23921    IfModules => {
23922      'mod_delay.c' => {
23923        DelayEngine => 'off',
23924      },
23925
23926      'mod_sftp.c' => [
23927        "SFTPEngine on",
23928        "SFTPLog $setup->{log_file}",
23929        "SFTPHostKey $rsa_host_key",
23930        "SFTPHostKey $dsa_host_key",
23931      ],
23932    },
23933  };
23934
23935  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
23936    $config);
23937
23938  # Open pipes, for use between the parent and child processes.  Specifically,
23939  # the child will indicate when it's done with its test by writing a message
23940  # to the parent.
23941  my ($rfh, $wfh);
23942  unless (pipe($rfh, $wfh)) {
23943    die("Can't open pipe: $!");
23944  }
23945
23946  require Net::SSH2;
23947
23948  my $ex;
23949
23950  # Fork child
23951  $self->handle_sigchld();
23952  defined(my $pid = fork()) or die("Can't fork: $!");
23953  if ($pid) {
23954    eval {
23955      my $ssh2 = Net::SSH2->new();
23956
23957      sleep(1);
23958
23959      unless ($ssh2->connect('127.0.0.1', $port)) {
23960        my ($err_code, $err_name, $err_str) = $ssh2->error();
23961        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
23962      }
23963
23964      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
23965        my ($err_code, $err_name, $err_str) = $ssh2->error();
23966        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
23967      }
23968
23969      my $sftp = $ssh2->sftp();
23970      unless ($sftp) {
23971        my ($err_code, $err_name, $err_str) = $ssh2->error();
23972        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
23973      }
23974
23975      my $path = 'test.d/test.lnk';
23976      my $fh = $sftp->open($path, O_RDWR);
23977      unless ($fh) {
23978        my ($err_code, $err_name, $err_str) = $ssh2->error();
23979        die("Can't use open $path: [$err_name] ($err_code) $err_str");
23980      }
23981
23982      my ($buf, $data);
23983      my $size = 0;
23984
23985      my $res = $fh->read($buf, 8192);
23986      while ($res) {
23987        $size += $res;
23988        $data .= $buf;
23989
23990        $res = $fh->read($buf, 8192);
23991      }
23992
23993      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
23994      $fh = undef;
23995
23996      $sftp = undef;
23997      $ssh2->disconnect();
23998
23999      # Make sure that we followed the symlink by comparing what we wrote to
24000      # what we read.
24001      $self->assert($data eq $test_data,
24002        test_msg("Expected '$test_data', got '$data'"));
24003    };
24004    if ($@) {
24005      $ex = $@;
24006    }
24007
24008    $wfh->print("done\n");
24009    $wfh->flush();
24010
24011  } else {
24012    eval { server_wait($setup->{config_file}, $rfh) };
24013    if ($@) {
24014      warn($@);
24015      exit 1;
24016    }
24017
24018    exit 0;
24019  }
24020
24021  # Stop server
24022  server_stop($setup->{pid_file});
24023  $self->assert_child_ok($pid);
24024
24025  test_cleanup($setup->{log_file}, $ex);
24026}
24027
24028sub sftp_open_abs_symlink_chrooted_bug4219 {
24029  my $self = shift;
24030  my $tmpdir = $self->{tmpdir};
24031  my $setup = test_setup($tmpdir, 'sftp');
24032
24033  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24034  mkpath($test_dir);
24035
24036  my $test_data = "Hello, World!\n";
24037
24038  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24039  if (open(my $fh, "> $test_file")) {
24040    print $fh $test_data;
24041    unless (close($fh)) {
24042      die("Can't write $test_file: $!");
24043    }
24044
24045  } else {
24046    die("Can't open $test_file: $!");
24047  }
24048
24049  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
24050
24051  my $dst_path = $test_file;
24052  if ($^O eq 'darwin') {
24053    # MacOSX-specific hack
24054    $dst_path = '/private' . $dst_path;
24055  }
24056
24057  unless (symlink($dst_path, $test_symlink)) {
24058    die("Can't symlink $test_symlink to $dst_path: $!");
24059  }
24060
24061  if ($< == 0) {
24062    unless (chmod(0755, $test_dir, $test_file)) {
24063      die("Can't set perms on $test_dir to 0755: $!");
24064    }
24065
24066    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24067      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24068    }
24069  }
24070
24071  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24072  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24073
24074  my $config = {
24075    PidFile => $setup->{pid_file},
24076    ScoreboardFile => $setup->{scoreboard_file},
24077    SystemLog => $setup->{log_file},
24078    TraceLog => $setup->{log_file},
24079    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
24080
24081    AuthUserFile => $setup->{auth_user_file},
24082    AuthGroupFile => $setup->{auth_group_file},
24083
24084    AllowOverwrite => 'on',
24085    AllowStoreRestart => 'on',
24086    DefaultRoot => '~',
24087
24088    IfModules => {
24089      'mod_delay.c' => {
24090        DelayEngine => 'off',
24091      },
24092
24093      'mod_sftp.c' => [
24094        "SFTPEngine on",
24095        "SFTPLog $setup->{log_file}",
24096        "SFTPHostKey $rsa_host_key",
24097        "SFTPHostKey $dsa_host_key",
24098      ],
24099    },
24100  };
24101
24102  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
24103    $config);
24104
24105  # Open pipes, for use between the parent and child processes.  Specifically,
24106  # the child will indicate when it's done with its test by writing a message
24107  # to the parent.
24108  my ($rfh, $wfh);
24109  unless (pipe($rfh, $wfh)) {
24110    die("Can't open pipe: $!");
24111  }
24112
24113  require Net::SSH2;
24114
24115  my $ex;
24116
24117  # Fork child
24118  $self->handle_sigchld();
24119  defined(my $pid = fork()) or die("Can't fork: $!");
24120  if ($pid) {
24121    eval {
24122      my $ssh2 = Net::SSH2->new();
24123
24124      sleep(1);
24125
24126      unless ($ssh2->connect('127.0.0.1', $port)) {
24127        my ($err_code, $err_name, $err_str) = $ssh2->error();
24128        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
24129      }
24130
24131      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
24132        my ($err_code, $err_name, $err_str) = $ssh2->error();
24133        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
24134      }
24135
24136      my $sftp = $ssh2->sftp();
24137      unless ($sftp) {
24138        my ($err_code, $err_name, $err_str) = $ssh2->error();
24139        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
24140      }
24141
24142      my $path = 'test.d/test.lnk';
24143      my $fh = $sftp->open($path, O_RDWR);
24144      unless ($fh) {
24145        my ($err_code, $err_name) = $sftp->error();
24146        die("Can't use open $path: [$err_name] ($err_code)");
24147      }
24148
24149      my ($buf, $data);
24150      my $size = 0;
24151
24152      my $res = $fh->read($buf, 8192);
24153      while ($res) {
24154        $size += $res;
24155        $data .= $buf;
24156
24157        $res = $fh->read($buf, 8192);
24158      }
24159
24160      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
24161      $fh = undef;
24162
24163      $sftp = undef;
24164      $ssh2->disconnect();
24165
24166      # Make sure that we followed the symlink by comparing what we wrote to
24167      # what we read.
24168      $self->assert($data eq $test_data,
24169        test_msg("Expected '$test_data', got '$data'"));
24170    };
24171    if ($@) {
24172      $ex = $@;
24173    }
24174
24175    $wfh->print("done\n");
24176    $wfh->flush();
24177
24178  } else {
24179    eval { server_wait($setup->{config_file}, $rfh) };
24180    if ($@) {
24181      warn($@);
24182      exit 1;
24183    }
24184
24185    exit 0;
24186  }
24187
24188  # Stop server
24189  server_stop($setup->{pid_file});
24190  $self->assert_child_ok($pid);
24191
24192  test_cleanup($setup->{log_file}, $ex);
24193}
24194
24195sub sftp_open_abs_symlink_enoent {
24196  my $self = shift;
24197  my $tmpdir = $self->{tmpdir};
24198  my $setup = test_setup($tmpdir, 'sftp');
24199
24200  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24201  mkpath($test_dir);
24202
24203  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24204  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
24205
24206  my $dst_path = $test_file;
24207  if ($^O eq 'darwin') {
24208    # MacOSX-specific hack
24209    $dst_path = '/private' . $dst_path;
24210  }
24211
24212  unless (symlink($dst_path, $test_symlink)) {
24213    die("Can't symlink $test_symlink to $dst_path: $!");
24214  }
24215
24216  if ($< == 0) {
24217    unless (chmod(0755, $test_dir, $test_file)) {
24218      die("Can't set perms on $test_dir to 0755: $!");
24219    }
24220
24221    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24222      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24223    }
24224  }
24225
24226  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24227  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24228
24229  my $config = {
24230    PidFile => $setup->{pid_file},
24231    ScoreboardFile => $setup->{scoreboard_file},
24232    SystemLog => $setup->{log_file},
24233    TraceLog => $setup->{log_file},
24234    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
24235
24236    AuthUserFile => $setup->{auth_user_file},
24237    AuthGroupFile => $setup->{auth_group_file},
24238    AllowOverwrite => 'on',
24239    AllowStoreRestart => 'on',
24240
24241    IfModules => {
24242      'mod_delay.c' => {
24243        DelayEngine => 'off',
24244      },
24245
24246      'mod_sftp.c' => [
24247        "SFTPEngine on",
24248        "SFTPLog $setup->{log_file}",
24249        "SFTPHostKey $rsa_host_key",
24250        "SFTPHostKey $dsa_host_key",
24251      ],
24252    },
24253  };
24254
24255  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
24256    $config);
24257
24258  # Open pipes, for use between the parent and child processes.  Specifically,
24259  # the child will indicate when it's done with its test by writing a message
24260  # to the parent.
24261  my ($rfh, $wfh);
24262  unless (pipe($rfh, $wfh)) {
24263    die("Can't open pipe: $!");
24264  }
24265
24266  require Net::SSH2;
24267
24268  my $ex;
24269
24270  # Fork child
24271  $self->handle_sigchld();
24272  defined(my $pid = fork()) or die("Can't fork: $!");
24273  if ($pid) {
24274    eval {
24275      my $ssh2 = Net::SSH2->new();
24276
24277      sleep(1);
24278
24279      unless ($ssh2->connect('127.0.0.1', $port)) {
24280        my ($err_code, $err_name, $err_str) = $ssh2->error();
24281        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
24282      }
24283
24284      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
24285        my ($err_code, $err_name, $err_str) = $ssh2->error();
24286        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
24287      }
24288
24289      my $sftp = $ssh2->sftp();
24290      unless ($sftp) {
24291        my ($err_code, $err_name, $err_str) = $ssh2->error();
24292        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
24293      }
24294
24295      my $path = 'test.d/test.lnk';
24296      my $fh = $sftp->open($path, O_RDWR);
24297      if ($fh) {
24298        die("Opening $path succeeded unexpectedly");
24299      }
24300
24301      my ($err_code, $err_name) = $sftp->error();
24302      my $expected = 'SSH_FX_NO_SUCH_FILE';
24303      $self->assert($expected eq $err_name,
24304        test_msg("Expected '$expected', got '$err_name'"));
24305
24306      $sftp = undef;
24307      $ssh2->disconnect();
24308    };
24309    if ($@) {
24310      $ex = $@;
24311    }
24312
24313    $wfh->print("done\n");
24314    $wfh->flush();
24315
24316  } else {
24317    eval { server_wait($setup->{config_file}, $rfh) };
24318    if ($@) {
24319      warn($@);
24320      exit 1;
24321    }
24322
24323    exit 0;
24324  }
24325
24326  # Stop server
24327  server_stop($setup->{pid_file});
24328  $self->assert_child_ok($pid);
24329
24330  test_cleanup($setup->{log_file}, $ex);
24331}
24332
24333sub sftp_open_abs_symlink_enoent_chrooted_bug4219 {
24334  my $self = shift;
24335  my $tmpdir = $self->{tmpdir};
24336  my $setup = test_setup($tmpdir, 'sftp');
24337
24338  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24339  mkpath($test_dir);
24340
24341  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24342  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
24343
24344  my $dst_path = $test_file;
24345  if ($^O eq 'darwin') {
24346    # MacOSX-specific hack
24347    $dst_path = '/private' . $dst_path;
24348  }
24349
24350  unless (symlink($dst_path, $test_symlink)) {
24351    die("Can't symlink $test_symlink to $dst_path: $!");
24352  }
24353
24354  if ($< == 0) {
24355    unless (chmod(0755, $test_dir, $test_file)) {
24356      die("Can't set perms on $test_dir to 0755: $!");
24357    }
24358
24359    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24360      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24361    }
24362  }
24363
24364  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24365  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24366
24367  my $config = {
24368    PidFile => $setup->{pid_file},
24369    ScoreboardFile => $setup->{scoreboard_file},
24370    SystemLog => $setup->{log_file},
24371    TraceLog => $setup->{log_file},
24372    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
24373
24374    AuthUserFile => $setup->{auth_user_file},
24375    AuthGroupFile => $setup->{auth_group_file},
24376
24377    AllowOverwrite => 'on',
24378    AllowStoreRestart => 'on',
24379    DefaultRoot => '~',
24380
24381    IfModules => {
24382      'mod_delay.c' => {
24383        DelayEngine => 'off',
24384      },
24385
24386      'mod_sftp.c' => [
24387        "SFTPEngine on",
24388        "SFTPLog $setup->{log_file}",
24389        "SFTPHostKey $rsa_host_key",
24390        "SFTPHostKey $dsa_host_key",
24391      ],
24392    },
24393  };
24394
24395  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
24396    $config);
24397
24398  # Open pipes, for use between the parent and child processes.  Specifically,
24399  # the child will indicate when it's done with its test by writing a message
24400  # to the parent.
24401  my ($rfh, $wfh);
24402  unless (pipe($rfh, $wfh)) {
24403    die("Can't open pipe: $!");
24404  }
24405
24406  require Net::SSH2;
24407
24408  my $ex;
24409
24410  # Fork child
24411  $self->handle_sigchld();
24412  defined(my $pid = fork()) or die("Can't fork: $!");
24413  if ($pid) {
24414    eval {
24415      my $ssh2 = Net::SSH2->new();
24416
24417      sleep(1);
24418
24419      unless ($ssh2->connect('127.0.0.1', $port)) {
24420        my ($err_code, $err_name, $err_str) = $ssh2->error();
24421        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
24422      }
24423
24424      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
24425        my ($err_code, $err_name, $err_str) = $ssh2->error();
24426        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
24427      }
24428
24429      my $sftp = $ssh2->sftp();
24430      unless ($sftp) {
24431        my ($err_code, $err_name, $err_str) = $ssh2->error();
24432        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
24433      }
24434
24435      my $path = 'test.d/test.lnk';
24436      my $fh = $sftp->open($path, O_RDWR);
24437      if ($fh) {
24438        die("Opening $path succeeded unexpectedly");
24439      }
24440
24441      my ($err_code, $err_name) = $sftp->error();
24442      my $expected = 'SSH_FX_NO_SUCH_FILE';
24443      $self->assert($expected eq $err_name,
24444        test_msg("Expected '$expected', got '$err_name'"));
24445
24446      $sftp = undef;
24447      $ssh2->disconnect();
24448    };
24449    if ($@) {
24450      $ex = $@;
24451    }
24452
24453    $wfh->print("done\n");
24454    $wfh->flush();
24455
24456  } else {
24457    eval { server_wait($setup->{config_file}, $rfh) };
24458    if ($@) {
24459      warn($@);
24460      exit 1;
24461    }
24462
24463    exit 0;
24464  }
24465
24466  # Stop server
24467  server_stop($setup->{pid_file});
24468  $self->assert_child_ok($pid);
24469
24470  test_cleanup($setup->{log_file}, $ex);
24471}
24472
24473sub sftp_open_rel_symlink {
24474  my $self = shift;
24475  my $tmpdir = $self->{tmpdir};
24476  my $setup = test_setup($tmpdir, 'sftp');
24477
24478  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24479  mkpath($test_dir);
24480
24481  my $test_data = "Hello, World!\n";
24482
24483  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24484  if (open(my $fh, "> $test_file")) {
24485    print $fh $test_data;
24486    unless (close($fh)) {
24487      die("Can't write $test_file: $!");
24488    }
24489
24490  } else {
24491    die("Can't open $test_file: $!");
24492  }
24493
24494  # Change to the test directory in order to create a relative path in the
24495  # symlink we need
24496
24497  my $cwd = getcwd();
24498  unless (chdir($test_dir)) {
24499    die("Can't chdir to $test_dir: $!");
24500  }
24501
24502  unless (symlink('./test.txt', './test.lnk')) {
24503    die("Can't symlink 'test.lnk' to './test.txt': $!");
24504  }
24505
24506  unless (chdir($cwd)) {
24507    die("Can't chdir to $cwd: $!");
24508  }
24509
24510  if ($< == 0) {
24511    unless (chmod(0755, $test_dir, $test_file)) {
24512      die("Can't set perms on $test_dir to 0755: $!");
24513    }
24514
24515    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24516      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24517    }
24518  }
24519
24520  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24521  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24522
24523  my $config = {
24524    PidFile => $setup->{pid_file},
24525    ScoreboardFile => $setup->{scoreboard_file},
24526    SystemLog => $setup->{log_file},
24527    TraceLog => $setup->{log_file},
24528    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
24529
24530    AuthUserFile => $setup->{auth_user_file},
24531    AuthGroupFile => $setup->{auth_group_file},
24532    AllowOverwrite => 'on',
24533    AllowStoreRestart => 'on',
24534
24535    IfModules => {
24536      'mod_delay.c' => {
24537        DelayEngine => 'off',
24538      },
24539
24540      'mod_sftp.c' => [
24541        "SFTPEngine on",
24542        "SFTPLog $setup->{log_file}",
24543        "SFTPHostKey $rsa_host_key",
24544        "SFTPHostKey $dsa_host_key",
24545      ],
24546    },
24547  };
24548
24549  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
24550    $config);
24551
24552  # Open pipes, for use between the parent and child processes.  Specifically,
24553  # the child will indicate when it's done with its test by writing a message
24554  # to the parent.
24555  my ($rfh, $wfh);
24556  unless (pipe($rfh, $wfh)) {
24557    die("Can't open pipe: $!");
24558  }
24559
24560  require Net::SSH2;
24561
24562  my $ex;
24563
24564  # Fork child
24565  $self->handle_sigchld();
24566  defined(my $pid = fork()) or die("Can't fork: $!");
24567  if ($pid) {
24568    eval {
24569      my $ssh2 = Net::SSH2->new();
24570
24571      sleep(1);
24572
24573      unless ($ssh2->connect('127.0.0.1', $port)) {
24574        my ($err_code, $err_name, $err_str) = $ssh2->error();
24575        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
24576      }
24577
24578      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
24579        my ($err_code, $err_name, $err_str) = $ssh2->error();
24580        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
24581      }
24582
24583      my $sftp = $ssh2->sftp();
24584      unless ($sftp) {
24585        my ($err_code, $err_name, $err_str) = $ssh2->error();
24586        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
24587      }
24588
24589      my $path = 'test.d/test.lnk';
24590      my $fh = $sftp->open($path, O_RDWR);
24591      unless ($fh) {
24592        my ($err_code, $err_name, $err_str) = $ssh2->error();
24593        die("Can't use open $path: [$err_name] ($err_code) $err_str");
24594      }
24595
24596      my ($buf, $data);
24597      my $size = 0;
24598
24599      my $res = $fh->read($buf, 8192);
24600      while ($res) {
24601        $size += $res;
24602        $data .= $buf;
24603
24604        $res = $fh->read($buf, 8192);
24605      }
24606
24607      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
24608      $fh = undef;
24609
24610      $sftp = undef;
24611      $ssh2->disconnect();
24612
24613      # Make sure that we followed the symlink by comparing what we wrote to
24614      # what we read.
24615      $self->assert($data eq $test_data,
24616        test_msg("Expected '$test_data', got '$data'"));
24617    };
24618    if ($@) {
24619      $ex = $@;
24620    }
24621
24622    $wfh->print("done\n");
24623    $wfh->flush();
24624
24625  } else {
24626    eval { server_wait($setup->{config_file}, $rfh) };
24627    if ($@) {
24628      warn($@);
24629      exit 1;
24630    }
24631
24632    exit 0;
24633  }
24634
24635  # Stop server
24636  server_stop($setup->{pid_file});
24637  $self->assert_child_ok($pid);
24638
24639  test_cleanup($setup->{log_file}, $ex);
24640}
24641
24642sub sftp_open_rel_symlink_chrooted_bug4219 {
24643  my $self = shift;
24644  my $tmpdir = $self->{tmpdir};
24645  my $setup = test_setup($tmpdir, 'sftp');
24646
24647  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24648  mkpath($test_dir);
24649
24650  my $test_data = "Hello, World!\n";
24651
24652  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24653  if (open(my $fh, "> $test_file")) {
24654    print $fh $test_data;
24655    unless (close($fh)) {
24656      die("Can't write $test_file: $!");
24657    }
24658
24659  } else {
24660    die("Can't open $test_file: $!");
24661  }
24662
24663  # Change to the test directory in order to create a relative path in the
24664  # symlink we need
24665
24666  my $cwd = getcwd();
24667  unless (chdir($test_dir)) {
24668    die("Can't chdir to $test_dir: $!");
24669  }
24670
24671  unless (symlink('./test.txt', './test.lnk')) {
24672    die("Can't symlink 'test.lnk' to './test.txt': $!");
24673  }
24674
24675  unless (chdir($cwd)) {
24676    die("Can't chdir to $cwd: $!");
24677  }
24678
24679  if ($< == 0) {
24680    unless (chmod(0755, $test_dir, $test_file)) {
24681      die("Can't set perms on $test_dir to 0755: $!");
24682    }
24683
24684    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24685      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24686    }
24687  }
24688
24689  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24690  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24691
24692  my $config = {
24693    PidFile => $setup->{pid_file},
24694    ScoreboardFile => $setup->{scoreboard_file},
24695    SystemLog => $setup->{log_file},
24696    TraceLog => $setup->{log_file},
24697    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
24698
24699    AuthUserFile => $setup->{auth_user_file},
24700    AuthGroupFile => $setup->{auth_group_file},
24701
24702    AllowOverwrite => 'on',
24703    AllowStoreRestart => 'on',
24704    DefaultRoot => '~',
24705
24706    IfModules => {
24707      'mod_delay.c' => {
24708        DelayEngine => 'off',
24709      },
24710
24711      'mod_sftp.c' => [
24712        "SFTPEngine on",
24713        "SFTPLog $setup->{log_file}",
24714        "SFTPHostKey $rsa_host_key",
24715        "SFTPHostKey $dsa_host_key",
24716      ],
24717    },
24718  };
24719
24720  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
24721    $config);
24722
24723  # Open pipes, for use between the parent and child processes.  Specifically,
24724  # the child will indicate when it's done with its test by writing a message
24725  # to the parent.
24726  my ($rfh, $wfh);
24727  unless (pipe($rfh, $wfh)) {
24728    die("Can't open pipe: $!");
24729  }
24730
24731  require Net::SSH2;
24732
24733  my $ex;
24734
24735  # Fork child
24736  $self->handle_sigchld();
24737  defined(my $pid = fork()) or die("Can't fork: $!");
24738  if ($pid) {
24739    eval {
24740      my $ssh2 = Net::SSH2->new();
24741
24742      sleep(1);
24743
24744      unless ($ssh2->connect('127.0.0.1', $port)) {
24745        my ($err_code, $err_name, $err_str) = $ssh2->error();
24746        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
24747      }
24748
24749      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
24750        my ($err_code, $err_name, $err_str) = $ssh2->error();
24751        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
24752      }
24753
24754      my $sftp = $ssh2->sftp();
24755      unless ($sftp) {
24756        my ($err_code, $err_name, $err_str) = $ssh2->error();
24757        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
24758      }
24759
24760      my $path = 'test.d/test.lnk';
24761      my $fh = $sftp->open($path, O_RDWR);
24762      unless ($fh) {
24763        my ($err_code, $err_name, $err_str) = $ssh2->error();
24764        die("Can't use open $path: [$err_name] ($err_code) $err_str");
24765      }
24766
24767      my ($buf, $data);
24768      my $size = 0;
24769
24770      my $res = $fh->read($buf, 8192);
24771      while ($res) {
24772        $size += $res;
24773        $data .= $buf;
24774
24775        $res = $fh->read($buf, 8192);
24776      }
24777
24778      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
24779      $fh = undef;
24780
24781      $sftp = undef;
24782      $ssh2->disconnect();
24783
24784      # Make sure that we followed the symlink by comparing what we wrote to
24785      # what we read.
24786      $self->assert($data eq $test_data,
24787        test_msg("Expected '$test_data', got '$data'"));
24788    };
24789    if ($@) {
24790      $ex = $@;
24791    }
24792
24793    $wfh->print("done\n");
24794    $wfh->flush();
24795
24796  } else {
24797    eval { server_wait($setup->{config_file}, $rfh) };
24798    if ($@) {
24799      warn($@);
24800      exit 1;
24801    }
24802
24803    exit 0;
24804  }
24805
24806  # Stop server
24807  server_stop($setup->{pid_file});
24808  $self->assert_child_ok($pid);
24809
24810  test_cleanup($setup->{log_file}, $ex);
24811}
24812
24813sub sftp_open_rel_symlink_enoent {
24814  my $self = shift;
24815  my $tmpdir = $self->{tmpdir};
24816  my $setup = test_setup($tmpdir, 'sftp');
24817
24818  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24819  mkpath($test_dir);
24820
24821  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24822
24823  # Change to the test directory in order to create a relative path in the
24824  # symlink we need
24825
24826  my $cwd = getcwd();
24827  unless (chdir($test_dir)) {
24828    die("Can't chdir to $test_dir: $!");
24829  }
24830
24831  unless (symlink('./test.txt', './test.lnk')) {
24832    die("Can't symlink 'test.lnk' to './test.txt': $!");
24833  }
24834
24835  unless (chdir($cwd)) {
24836    die("Can't chdir to $cwd: $!");
24837  }
24838
24839  if ($< == 0) {
24840    unless (chmod(0755, $test_dir, $test_file)) {
24841      die("Can't set perms on $test_dir to 0755: $!");
24842    }
24843
24844    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24845      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24846    }
24847  }
24848
24849  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24850  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24851
24852  my $config = {
24853    PidFile => $setup->{pid_file},
24854    ScoreboardFile => $setup->{scoreboard_file},
24855    SystemLog => $setup->{log_file},
24856    TraceLog => $setup->{log_file},
24857    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
24858
24859    AuthUserFile => $setup->{auth_user_file},
24860    AuthGroupFile => $setup->{auth_group_file},
24861    AllowOverwrite => 'on',
24862    AllowStoreRestart => 'on',
24863
24864    IfModules => {
24865      'mod_delay.c' => {
24866        DelayEngine => 'off',
24867      },
24868
24869      'mod_sftp.c' => [
24870        "SFTPEngine on",
24871        "SFTPLog $setup->{log_file}",
24872        "SFTPHostKey $rsa_host_key",
24873        "SFTPHostKey $dsa_host_key",
24874      ],
24875    },
24876  };
24877
24878  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
24879    $config);
24880
24881  # Open pipes, for use between the parent and child processes.  Specifically,
24882  # the child will indicate when it's done with its test by writing a message
24883  # to the parent.
24884  my ($rfh, $wfh);
24885  unless (pipe($rfh, $wfh)) {
24886    die("Can't open pipe: $!");
24887  }
24888
24889  require Net::SSH2;
24890
24891  my $ex;
24892
24893  # Fork child
24894  $self->handle_sigchld();
24895  defined(my $pid = fork()) or die("Can't fork: $!");
24896  if ($pid) {
24897    eval {
24898      my $ssh2 = Net::SSH2->new();
24899
24900      sleep(1);
24901
24902      unless ($ssh2->connect('127.0.0.1', $port)) {
24903        my ($err_code, $err_name, $err_str) = $ssh2->error();
24904        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
24905      }
24906
24907      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
24908        my ($err_code, $err_name, $err_str) = $ssh2->error();
24909        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
24910      }
24911
24912      my $sftp = $ssh2->sftp();
24913      unless ($sftp) {
24914        my ($err_code, $err_name, $err_str) = $ssh2->error();
24915        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
24916      }
24917
24918      my $path = 'test.d/test.lnk';
24919      my $fh = $sftp->open($path, O_RDWR);
24920      if ($fh) {
24921        die("Opening $path succeeded unexpectedly");
24922      }
24923
24924      my ($err_code, $err_name) = $sftp->error();
24925      my $expected = 'SSH_FX_NO_SUCH_FILE';
24926      $self->assert($expected eq $err_name,
24927        test_msg("Expected '$expected', got '$err_name'"));
24928
24929      $sftp = undef;
24930      $ssh2->disconnect();
24931    };
24932    if ($@) {
24933      $ex = $@;
24934    }
24935
24936    $wfh->print("done\n");
24937    $wfh->flush();
24938
24939  } else {
24940    eval { server_wait($setup->{config_file}, $rfh) };
24941    if ($@) {
24942      warn($@);
24943      exit 1;
24944    }
24945
24946    exit 0;
24947  }
24948
24949  # Stop server
24950  server_stop($setup->{pid_file});
24951  $self->assert_child_ok($pid);
24952
24953  test_cleanup($setup->{log_file}, $ex);
24954}
24955
24956sub sftp_open_rel_symlink_enoent_chrooted_bug4219 {
24957  my $self = shift;
24958  my $tmpdir = $self->{tmpdir};
24959  my $setup = test_setup($tmpdir, 'sftp');
24960
24961  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
24962  mkpath($test_dir);
24963
24964  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
24965
24966  # Change to the test directory in order to create a relative path in the
24967  # symlink we need
24968
24969  my $cwd = getcwd();
24970  unless (chdir($test_dir)) {
24971    die("Can't chdir to $test_dir: $!");
24972  }
24973
24974  unless (symlink('./test.txt', './test.lnk')) {
24975    die("Can't symlink 'test.lnk' to './test.txt': $!");
24976  }
24977
24978  unless (chdir($cwd)) {
24979    die("Can't chdir to $cwd: $!");
24980  }
24981
24982  if ($< == 0) {
24983    unless (chmod(0755, $test_dir, $test_file)) {
24984      die("Can't set perms on $test_dir to 0755: $!");
24985    }
24986
24987    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
24988      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
24989    }
24990  }
24991
24992  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
24993  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
24994
24995  my $config = {
24996    PidFile => $setup->{pid_file},
24997    ScoreboardFile => $setup->{scoreboard_file},
24998    SystemLog => $setup->{log_file},
24999    TraceLog => $setup->{log_file},
25000    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
25001
25002    AuthUserFile => $setup->{auth_user_file},
25003    AuthGroupFile => $setup->{auth_group_file},
25004
25005    AllowOverwrite => 'on',
25006    AllowStoreRestart => 'on',
25007    DefaultRoot => '~',
25008
25009    IfModules => {
25010      'mod_delay.c' => {
25011        DelayEngine => 'off',
25012      },
25013
25014      'mod_sftp.c' => [
25015        "SFTPEngine on",
25016        "SFTPLog $setup->{log_file}",
25017        "SFTPHostKey $rsa_host_key",
25018        "SFTPHostKey $dsa_host_key",
25019      ],
25020    },
25021  };
25022
25023  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
25024    $config);
25025
25026  # Open pipes, for use between the parent and child processes.  Specifically,
25027  # the child will indicate when it's done with its test by writing a message
25028  # to the parent.
25029  my ($rfh, $wfh);
25030  unless (pipe($rfh, $wfh)) {
25031    die("Can't open pipe: $!");
25032  }
25033
25034  require Net::SSH2;
25035
25036  my $ex;
25037
25038  # Fork child
25039  $self->handle_sigchld();
25040  defined(my $pid = fork()) or die("Can't fork: $!");
25041  if ($pid) {
25042    eval {
25043      my $ssh2 = Net::SSH2->new();
25044
25045      sleep(1);
25046
25047      unless ($ssh2->connect('127.0.0.1', $port)) {
25048        my ($err_code, $err_name, $err_str) = $ssh2->error();
25049        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
25050      }
25051
25052      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
25053        my ($err_code, $err_name, $err_str) = $ssh2->error();
25054        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
25055      }
25056
25057      my $sftp = $ssh2->sftp();
25058      unless ($sftp) {
25059        my ($err_code, $err_name, $err_str) = $ssh2->error();
25060        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
25061      }
25062
25063      my $path = 'test.d/test.lnk';
25064      my $fh = $sftp->open($path, O_RDWR);
25065      if ($fh) {
25066        die("Opening $path succeeded unexpectedly");
25067      }
25068
25069      my ($err_code, $err_name) = $sftp->error();
25070      my $expected = 'SSH_FX_NO_SUCH_FILE';
25071      $self->assert($expected eq $err_name,
25072        test_msg("Expected '$expected', got '$err_name'"));
25073
25074      $sftp = undef;
25075      $ssh2->disconnect();
25076    };
25077    if ($@) {
25078      $ex = $@;
25079    }
25080
25081    $wfh->print("done\n");
25082    $wfh->flush();
25083
25084  } else {
25085    eval { server_wait($setup->{config_file}, $rfh) };
25086    if ($@) {
25087      warn($@);
25088      exit 1;
25089    }
25090
25091    exit 0;
25092  }
25093
25094  # Stop server
25095  server_stop($setup->{pid_file});
25096  $self->assert_child_ok($pid);
25097
25098  test_cleanup($setup->{log_file}, $ex);
25099}
25100
25101sub sftp_upload {
25102  my $self = shift;
25103  my $tmpdir = $self->{tmpdir};
25104
25105  my $config_file = "$tmpdir/sftp.conf";
25106  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
25107  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
25108
25109  my $log_file = test_get_logfile();
25110
25111  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
25112  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
25113
25114  my $user = 'proftpd';
25115  my $passwd = 'test';
25116  my $group = 'ftpd';
25117  my $home_dir = File::Spec->rel2abs($tmpdir);
25118  my $uid = 500;
25119  my $gid = 500;
25120
25121  # Make sure that, if we're running as root, that the home directory has
25122  # permissions/privs set for the account we create
25123  if ($< == 0) {
25124    unless (chmod(0755, $home_dir)) {
25125      die("Can't set perms on $home_dir to 0755: $!");
25126    }
25127
25128    unless (chown($uid, $gid, $home_dir)) {
25129      die("Can't set owner of $home_dir to $uid/$gid: $!");
25130    }
25131  }
25132
25133  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
25134    '/bin/bash');
25135  auth_group_write($auth_group_file, $group, $gid, $user);
25136
25137  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
25138  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
25139
25140  my $config = {
25141    PidFile => $pid_file,
25142    ScoreboardFile => $scoreboard_file,
25143    SystemLog => $log_file,
25144    TraceLog => $log_file,
25145    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
25146
25147    AuthUserFile => $auth_user_file,
25148    AuthGroupFile => $auth_group_file,
25149
25150    IfModules => {
25151      'mod_delay.c' => {
25152        DelayEngine => 'off',
25153      },
25154
25155      'mod_sftp.c' => [
25156        "SFTPEngine on",
25157        "SFTPLog $log_file",
25158        "SFTPHostKey $rsa_host_key",
25159        "SFTPHostKey $dsa_host_key",
25160      ],
25161    },
25162  };
25163
25164  my ($port, $config_user, $config_group) = config_write($config_file, $config);
25165
25166  # Open pipes, for use between the parent and child processes.  Specifically,
25167  # the child will indicate when it's done with its test by writing a message
25168  # to the parent.
25169  my ($rfh, $wfh);
25170  unless (pipe($rfh, $wfh)) {
25171    die("Can't open pipe: $!");
25172  }
25173
25174  require Net::SSH2;
25175
25176  my $ex;
25177
25178  # Ignore SIGPIPE
25179  local $SIG{PIPE} = sub { };
25180
25181  # Fork child
25182  $self->handle_sigchld();
25183  defined(my $pid = fork()) or die("Can't fork: $!");
25184  if ($pid) {
25185    eval {
25186      my $ssh2 = Net::SSH2->new();
25187
25188      sleep(1);
25189
25190      unless ($ssh2->connect('127.0.0.1', $port)) {
25191        my ($err_code, $err_name, $err_str) = $ssh2->error();
25192        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
25193      }
25194
25195      unless ($ssh2->auth_password($user, $passwd)) {
25196        my ($err_code, $err_name, $err_str) = $ssh2->error();
25197        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
25198      }
25199
25200      my $sftp = $ssh2->sftp();
25201      unless ($sftp) {
25202        my ($err_code, $err_name, $err_str) = $ssh2->error();
25203        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
25204      }
25205
25206      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
25207      unless ($fh) {
25208        my ($err_code, $err_name) = $sftp->error();
25209        die("Can't open test.txt: [$err_name] ($err_code)");
25210      }
25211
25212      my $count = 20;
25213      for (my $i = 0; $i < $count; $i++) {
25214        print $fh "ABCD" x 8192;
25215      }
25216
25217      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
25218      $fh = undef;
25219
25220      $sftp = undef;
25221      $ssh2->disconnect();
25222    };
25223
25224    if ($@) {
25225      $ex = $@;
25226    }
25227
25228    $wfh->print("done\n");
25229    $wfh->flush();
25230
25231  } else {
25232    eval { server_wait($config_file, $rfh) };
25233    if ($@) {
25234      warn($@);
25235      exit 1;
25236    }
25237
25238    exit 0;
25239  }
25240
25241  # Stop server
25242  server_stop($pid_file);
25243
25244  $self->assert_child_ok($pid);
25245
25246  if ($ex) {
25247    test_append_logfile($log_file, $ex);
25248    unlink($log_file);
25249
25250    die($ex);
25251  }
25252
25253  unlink($log_file);
25254}
25255
25256sub sftp_upload_with_compression {
25257  my $self = shift;
25258  my $tmpdir = $self->{tmpdir};
25259
25260  my $config_file = "$tmpdir/sftp.conf";
25261  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
25262  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
25263
25264  my $log_file = test_get_logfile();
25265
25266  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
25267  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
25268
25269  my $user = 'proftpd';
25270  my $passwd = 'test';
25271  my $group = 'ftpd';
25272  my $home_dir = File::Spec->rel2abs($tmpdir);
25273  my $uid = 500;
25274  my $gid = 500;
25275
25276  # Make sure that, if we're running as root, that the home directory has
25277  # permissions/privs set for the account we create
25278  if ($< == 0) {
25279    unless (chmod(0755, $home_dir)) {
25280      die("Can't set perms on $home_dir to 0755: $!");
25281    }
25282
25283    unless (chown($uid, $gid, $home_dir)) {
25284      die("Can't set owner of $home_dir to $uid/$gid: $!");
25285    }
25286  }
25287
25288  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
25289    '/bin/bash');
25290  auth_group_write($auth_group_file, $group, $gid, $user);
25291
25292  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
25293  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
25294
25295  my $config = {
25296    PidFile => $pid_file,
25297    ScoreboardFile => $scoreboard_file,
25298    SystemLog => $log_file,
25299    TraceLog => $log_file,
25300    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
25301
25302    AuthUserFile => $auth_user_file,
25303    AuthGroupFile => $auth_group_file,
25304
25305    IfModules => {
25306      'mod_delay.c' => {
25307        DelayEngine => 'off',
25308      },
25309
25310      'mod_sftp.c' => [
25311        "SFTPEngine on",
25312        "SFTPLog $log_file",
25313        "SFTPHostKey $rsa_host_key",
25314        "SFTPHostKey $dsa_host_key",
25315
25316        "SFTPCompression on",
25317      ],
25318    },
25319  };
25320
25321  my ($port, $config_user, $config_group) = config_write($config_file, $config);
25322
25323  # Open pipes, for use between the parent and child processes.  Specifically,
25324  # the child will indicate when it's done with its test by writing a message
25325  # to the parent.
25326  my ($rfh, $wfh);
25327  unless (pipe($rfh, $wfh)) {
25328    die("Can't open pipe: $!");
25329  }
25330
25331  require Net::SSH2;
25332
25333  my $ex;
25334
25335  # Ignore SIGPIPE
25336  local $SIG{PIPE} = sub { };
25337
25338  # Fork child
25339  $self->handle_sigchld();
25340  defined(my $pid = fork()) or die("Can't fork: $!");
25341  if ($pid) {
25342    eval {
25343      my $ssh2 = Net::SSH2->new();
25344
25345      sleep(1);
25346
25347      my $comp = 'zlib';
25348      $ssh2->method('comp_cs', $comp);
25349      $ssh2->method('comp_sc', $comp);
25350
25351      unless ($ssh2->connect('127.0.0.1', $port)) {
25352        my ($err_code, $err_name, $err_str) = $ssh2->error();
25353        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
25354      }
25355
25356      unless ($ssh2->auth_password($user, $passwd)) {
25357        my ($err_code, $err_name, $err_str) = $ssh2->error();
25358        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
25359      }
25360
25361      my $sftp = $ssh2->sftp();
25362      unless ($sftp) {
25363        my ($err_code, $err_name, $err_str) = $ssh2->error();
25364        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
25365      }
25366
25367      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
25368      unless ($fh) {
25369        my ($err_code, $err_name) = $sftp->error();
25370        die("Can't open test.txt: [$err_name] ($err_code)");
25371      }
25372
25373      my $count = 20;
25374      for (my $i = 0; $i < $count; $i++) {
25375        print $fh "ABCD" x 8192;
25376      }
25377
25378      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
25379      $fh = undef;
25380
25381      # To close the SFTP channel, we have to explicitly destroy the object
25382      $sftp = undef;
25383
25384      $ssh2->disconnect();
25385    };
25386
25387    if ($@) {
25388      $ex = $@;
25389    }
25390
25391    $wfh->print("done\n");
25392    $wfh->flush();
25393
25394  } else {
25395    eval { server_wait($config_file, $rfh) };
25396    if ($@) {
25397      warn($@);
25398      exit 1;
25399    }
25400
25401    exit 0;
25402  }
25403
25404  # Stop server
25405  server_stop($pid_file);
25406
25407  $self->assert_child_ok($pid);
25408
25409  if ($ex) {
25410    test_append_logfile($log_file, $ex);
25411    unlink($log_file);
25412
25413    die($ex);
25414  }
25415
25416  unlink($log_file);
25417}
25418
25419sub sftp_upload_zero_len_file {
25420  my $self = shift;
25421  my $tmpdir = $self->{tmpdir};
25422
25423  my $config_file = "$tmpdir/sftp.conf";
25424  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
25425  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
25426
25427  my $log_file = test_get_logfile();
25428
25429  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
25430  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
25431
25432  my $user = 'proftpd';
25433  my $passwd = 'test';
25434  my $group = 'ftpd';
25435  my $home_dir = File::Spec->rel2abs($tmpdir);
25436  my $uid = 500;
25437  my $gid = 500;
25438
25439  # Make sure that, if we're running as root, that the home directory has
25440  # permissions/privs set for the account we create
25441  if ($< == 0) {
25442    unless (chmod(0755, $home_dir)) {
25443      die("Can't set perms on $home_dir to 0755: $!");
25444    }
25445
25446    unless (chown($uid, $gid, $home_dir)) {
25447      die("Can't set owner of $home_dir to $uid/$gid: $!");
25448    }
25449  }
25450
25451  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
25452    '/bin/bash');
25453  auth_group_write($auth_group_file, $group, $gid, $user);
25454
25455  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
25456  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
25457
25458  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
25459
25460  my $config = {
25461    PidFile => $pid_file,
25462    ScoreboardFile => $scoreboard_file,
25463    SystemLog => $log_file,
25464    TraceLog => $log_file,
25465    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
25466
25467    AuthUserFile => $auth_user_file,
25468    AuthGroupFile => $auth_group_file,
25469
25470    IfModules => {
25471      'mod_delay.c' => {
25472        DelayEngine => 'off',
25473      },
25474
25475      'mod_sftp.c' => [
25476        "SFTPEngine on",
25477        "SFTPLog $log_file",
25478        "SFTPHostKey $rsa_host_key",
25479        "SFTPHostKey $dsa_host_key",
25480      ],
25481    },
25482  };
25483
25484  my ($port, $config_user, $config_group) = config_write($config_file, $config);
25485
25486  # Open pipes, for use between the parent and child processes.  Specifically,
25487  # the child will indicate when it's done with its test by writing a message
25488  # to the parent.
25489  my ($rfh, $wfh);
25490  unless (pipe($rfh, $wfh)) {
25491    die("Can't open pipe: $!");
25492  }
25493
25494  require Net::SSH2;
25495
25496  my $ex;
25497
25498  # Ignore SIGPIPE
25499  local $SIG{PIPE} = sub { };
25500
25501  # Fork child
25502  $self->handle_sigchld();
25503  defined(my $pid = fork()) or die("Can't fork: $!");
25504  if ($pid) {
25505    eval {
25506      my $ssh2 = Net::SSH2->new();
25507
25508      sleep(1);
25509
25510      unless ($ssh2->connect('127.0.0.1', $port)) {
25511        my ($err_code, $err_name, $err_str) = $ssh2->error();
25512        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
25513      }
25514
25515      unless ($ssh2->auth_password($user, $passwd)) {
25516        my ($err_code, $err_name, $err_str) = $ssh2->error();
25517        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
25518      }
25519
25520      my $sftp = $ssh2->sftp();
25521      unless ($sftp) {
25522        my ($err_code, $err_name, $err_str) = $ssh2->error();
25523        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
25524      }
25525
25526      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
25527      unless ($fh) {
25528        my ($err_code, $err_name) = $sftp->error();
25529        die("Can't open test.txt: [$err_name] ($err_code)");
25530      }
25531
25532      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
25533      $fh = undef;
25534
25535      # To close the SFTP channel, we have to explicitly destroy the object
25536      $sftp = undef;
25537
25538      $ssh2->disconnect();
25539
25540      my $size = -s $test_file;
25541      unless ($size == 0) {
25542        die("$test_file has $size len unexpectedly");
25543      }
25544    };
25545
25546    if ($@) {
25547      $ex = $@;
25548    }
25549
25550    $wfh->print("done\n");
25551    $wfh->flush();
25552
25553  } else {
25554    eval { server_wait($config_file, $rfh) };
25555    if ($@) {
25556      warn($@);
25557      exit 1;
25558    }
25559
25560    exit 0;
25561  }
25562
25563  # Stop server
25564  server_stop($pid_file);
25565
25566  $self->assert_child_ok($pid);
25567
25568  if ($ex) {
25569    test_append_logfile($log_file, $ex);
25570    unlink($log_file);
25571
25572    die($ex);
25573  }
25574
25575  unlink($log_file);
25576}
25577
25578sub sftp_upload_largefile {
25579  my $self = shift;
25580  my $tmpdir = $self->{tmpdir};
25581
25582  my $config_file = "$tmpdir/sftp.conf";
25583  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
25584  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
25585
25586  my $log_file = test_get_logfile();
25587
25588  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
25589  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
25590
25591  my $user = 'proftpd';
25592  my $passwd = 'test';
25593  my $group = 'ftpd';
25594  my $home_dir = File::Spec->rel2abs($tmpdir);
25595  my $uid = 500;
25596  my $gid = 500;
25597
25598  # Make sure that, if we're running as root, that the home directory has
25599  # permissions/privs set for the account we create
25600  if ($< == 0) {
25601    unless (chmod(0755, $home_dir)) {
25602      die("Can't set perms on $home_dir to 0755: $!");
25603    }
25604
25605    unless (chown($uid, $gid, $home_dir)) {
25606      die("Can't set owner of $home_dir to $uid/$gid: $!");
25607    }
25608  }
25609
25610  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
25611    '/bin/bash');
25612  auth_group_write($auth_group_file, $group, $gid, $user);
25613
25614  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
25615  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
25616
25617  my $fh;
25618
25619  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
25620  if (open($fh, "> $test_file")) {
25621    # Make a file that's larger than the maximum SSH2 packet size, forcing
25622    # the scp code to loop properly entire the entire large file is sent.
25623
25624    print $fh "ABCDefgh" x 16384;
25625    unless (close($fh)) {
25626      die("Can't write $test_file: $!");
25627    }
25628
25629  } else {
25630    die("Can't open $test_file: $!");
25631  }
25632
25633  # Calculate the MD5 checksum of this file, for comparison with the
25634  # downloaded file.
25635  my $ctx = Digest::MD5->new();
25636  my $expected_md5;
25637
25638  if (open($fh, "< $test_file")) {
25639    binmode($fh);
25640    $ctx->addfile($fh);
25641    $expected_md5 = $ctx->hexdigest();
25642    close($fh);
25643
25644  } else {
25645    die("Can't read $test_file: $!");
25646  }
25647
25648  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
25649
25650  my $config = {
25651    PidFile => $pid_file,
25652    ScoreboardFile => $scoreboard_file,
25653    SystemLog => $log_file,
25654    TraceLog => $log_file,
25655    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
25656
25657    AuthUserFile => $auth_user_file,
25658    AuthGroupFile => $auth_group_file,
25659
25660    IfModules => {
25661      'mod_delay.c' => {
25662        DelayEngine => 'off',
25663      },
25664
25665      'mod_sftp.c' => [
25666        "SFTPEngine on",
25667        "SFTPLog $log_file",
25668        "SFTPHostKey $rsa_host_key",
25669        "SFTPHostKey $dsa_host_key",
25670      ],
25671    },
25672  };
25673
25674  my ($port, $config_user, $config_group) = config_write($config_file, $config);
25675
25676  # Open pipes, for use between the parent and child processes.  Specifically,
25677  # the child will indicate when it's done with its test by writing a message
25678  # to the parent.
25679  my ($rfh, $wfh);
25680  unless (pipe($rfh, $wfh)) {
25681    die("Can't open pipe: $!");
25682  }
25683
25684  require Net::SSH2;
25685
25686  my $ex;
25687
25688  # Ignore SIGPIPE
25689  local $SIG{PIPE} = sub { };
25690
25691  # Fork child
25692  $self->handle_sigchld();
25693  defined(my $pid = fork()) or die("Can't fork: $!");
25694  if ($pid) {
25695    my $test_rfh;
25696    unless (open($test_rfh, "< $test_file")) {
25697      die("Can't read $test_file: $!");
25698    }
25699
25700    eval {
25701      my $ssh2 = Net::SSH2->new();
25702
25703      sleep(1);
25704
25705      unless ($ssh2->connect('127.0.0.1', $port)) {
25706        my ($err_code, $err_name, $err_str) = $ssh2->error();
25707        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
25708      }
25709
25710      unless ($ssh2->auth_password($user, $passwd)) {
25711        my ($err_code, $err_name, $err_str) = $ssh2->error();
25712        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
25713      }
25714
25715      my $sftp = $ssh2->sftp();
25716      unless ($sftp) {
25717        my ($err_code, $err_name, $err_str) = $ssh2->error();
25718        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
25719      }
25720
25721      my $test_wfh = $sftp->open('test2.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
25722      unless ($test_wfh) {
25723        my ($err_code, $err_name) = $sftp->error();
25724        die("Can't open test2.txt: [$err_name] ($err_code)");
25725      }
25726
25727
25728      my $buf;
25729      my $bufsz = 8192;
25730
25731      while (read($test_rfh, $buf, $bufsz)) {
25732        print $test_wfh $buf;
25733      }
25734
25735      close($test_rfh);
25736
25737      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
25738      $test_wfh = undef;
25739
25740      # To close the SFTP channel, we have to explicitly destroy the object
25741      $sftp = undef;
25742
25743      $ssh2->disconnect();
25744
25745      unless (-f $test_file2) {
25746        die("$test_file2 file does not exist as expected");
25747      }
25748    };
25749
25750    if ($@) {
25751      $ex = $@;
25752    }
25753
25754    $wfh->print("done\n");
25755    $wfh->flush();
25756
25757  } else {
25758    eval { server_wait($config_file, $rfh) };
25759    if ($@) {
25760      warn($@);
25761      exit 1;
25762    }
25763
25764    exit 0;
25765  }
25766
25767  # Stop server
25768  server_stop($pid_file);
25769
25770  $self->assert_child_ok($pid);
25771
25772  if ($ex) {
25773    test_append_logfile($log_file, $ex);
25774    unlink($log_file);
25775
25776    die($ex);
25777  }
25778
25779  # Calculate the MD5 checksum of the uploaded file, for comparison with the
25780  # file that was uploaded.
25781  $ctx->reset();
25782  my $md5;
25783
25784  if (open($fh, "< $test_file2")) {
25785    binmode($fh);
25786    $ctx->addfile($fh);
25787    $md5 = $ctx->hexdigest();
25788    close($fh);
25789
25790  } else {
25791    die("Can't read $test_file2: $!");
25792  }
25793
25794  $self->assert($expected_md5 eq $md5,
25795    test_msg("Expected '$expected_md5', got '$md5'"));
25796
25797  unlink($log_file);
25798}
25799
25800sub sftp_upload_device_full {
25801  my $self = shift;
25802  my $tmpdir = $self->{tmpdir};
25803
25804  my $config_file = "$tmpdir/sftp.conf";
25805  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
25806  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
25807
25808  my $log_file = test_get_logfile();
25809
25810  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
25811  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
25812
25813  my $user = 'proftpd';
25814  my $passwd = 'test';
25815  my $group = 'ftpd';
25816  my $home_dir = File::Spec->rel2abs($tmpdir);
25817  my $uid = 500;
25818  my $gid = 500;
25819
25820  # Make sure that, if we're running as root, that the home directory has
25821  # permissions/privs set for the account we create
25822  if ($< == 0) {
25823    unless (chmod(0755, $home_dir)) {
25824      die("Can't set perms on $home_dir to 0755: $!");
25825    }
25826
25827    unless (chown($uid, $gid, $home_dir)) {
25828      die("Can't set owner of $home_dir to $uid/$gid: $!");
25829    }
25830  }
25831
25832  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
25833    '/bin/bash');
25834  auth_group_write($auth_group_file, $group, $gid, $user);
25835
25836  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
25837  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
25838
25839  my $config = {
25840    PidFile => $pid_file,
25841    ScoreboardFile => $scoreboard_file,
25842    SystemLog => $log_file,
25843    TraceLog => $log_file,
25844    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
25845
25846    AuthUserFile => $auth_user_file,
25847    AuthGroupFile => $auth_group_file,
25848    AllowOverwrite => 'on',
25849
25850    IfModules => {
25851      'mod_delay.c' => {
25852        DelayEngine => 'off',
25853      },
25854
25855      'mod_sftp.c' => [
25856        "SFTPEngine on",
25857        "SFTPLog $log_file",
25858        "SFTPHostKey $rsa_host_key",
25859        "SFTPHostKey $dsa_host_key",
25860        "SFTPOptions IgnoreSFTPUploadPerms",
25861      ],
25862    },
25863  };
25864
25865  my ($port, $config_user, $config_group) = config_write($config_file, $config);
25866
25867  # Open pipes, for use between the parent and child processes.  Specifically,
25868  # the child will indicate when it's done with its test by writing a message
25869  # to the parent.
25870  my ($rfh, $wfh);
25871  unless (pipe($rfh, $wfh)) {
25872    die("Can't open pipe: $!");
25873  }
25874
25875  require Net::SSH2;
25876
25877  my $ex;
25878
25879  # Ignore SIGPIPE
25880  local $SIG{PIPE} = sub { };
25881
25882  # Fork child
25883  $self->handle_sigchld();
25884  defined(my $pid = fork()) or die("Can't fork: $!");
25885  if ($pid) {
25886    eval {
25887      my $ssh2 = Net::SSH2->new();
25888
25889      sleep(1);
25890
25891      unless ($ssh2->connect('127.0.0.1', $port)) {
25892        my ($err_code, $err_name, $err_str) = $ssh2->error();
25893        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
25894      }
25895
25896      unless ($ssh2->auth_password($user, $passwd)) {
25897        my ($err_code, $err_name, $err_str) = $ssh2->error();
25898        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
25899      }
25900
25901      my $sftp = $ssh2->sftp();
25902      unless ($sftp) {
25903        my ($err_code, $err_name, $err_str) = $ssh2->error();
25904        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
25905      }
25906
25907      # XXX The /dev/full device only exists on Linux, as far as I know
25908      my $fh = $sftp->open('/dev/full', O_WRONLY|O_CREAT|O_TRUNC, 0644);
25909      unless ($fh) {
25910        my ($err_code, $err_name) = $sftp->error();
25911        die("Can't open /dev/full: [$err_name] ($err_code)");
25912      }
25913
25914      my $count = 20;
25915      for (my $i = 0; $i < $count; $i++) {
25916        unless (print $fh "ABCD" x 8192) {
25917          die("Failed to write to /dev/full: $!");
25918        }
25919      }
25920
25921      # XXX Hrm.  Looks like the Net::SSH2::File interface does not actually
25922      # inform the user if there was a CLOSE error, or if there was an
25923      # error writing (e.g. if the disk was full).  Will have to file
25924      # a bug report with them about this.
25925      #
25926      # This means that, for now, you have to double-check the generated
25927      # logs to make sure that mod_sftp is sending the correct error/response.
25928
25929      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
25930      $fh = undef;
25931
25932      # To close the SFTP channel, we have to explicitly destroy the object
25933      $sftp = undef;
25934
25935      $ssh2->disconnect();
25936    };
25937
25938    if ($@) {
25939      $ex = $@;
25940    }
25941
25942    $wfh->print("done\n");
25943    $wfh->flush();
25944
25945  } else {
25946    eval { server_wait($config_file, $rfh) };
25947    if ($@) {
25948      warn($@);
25949      exit 1;
25950    }
25951
25952    exit 0;
25953  }
25954
25955  # Stop server
25956  server_stop($pid_file);
25957
25958  $self->assert_child_ok($pid);
25959
25960  if ($ex) {
25961    test_append_logfile($log_file, $ex);
25962    unlink($log_file);
25963
25964    die($ex);
25965  }
25966
25967  unlink($log_file);
25968}
25969
25970sub sftp_upload_fifo_bug3312 {
25971  my $self = shift;
25972  my $tmpdir = $self->{tmpdir};
25973
25974  my $config_file = "$tmpdir/sftp.conf";
25975  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
25976  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
25977
25978  my $log_file = test_get_logfile();
25979
25980  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
25981  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
25982
25983  my $user = 'proftpd';
25984  my $passwd = 'test';
25985  my $group = 'ftpd';
25986  my $home_dir = File::Spec->rel2abs($tmpdir);
25987  my $uid = 500;
25988  my $gid = 500;
25989
25990  # Make sure that, if we're running as root, that the home directory has
25991  # permissions/privs set for the account we create
25992  if ($< == 0) {
25993    unless (chmod(0755, $home_dir)) {
25994      die("Can't set perms on $home_dir to 0755: $!");
25995    }
25996
25997    unless (chown($uid, $gid, $home_dir)) {
25998      die("Can't set owner of $home_dir to $uid/$gid: $!");
25999    }
26000  }
26001
26002  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
26003    '/bin/bash');
26004  auth_group_write($auth_group_file, $group, $gid, $user);
26005
26006  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
26007  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
26008
26009  my $fifo = File::Spec->rel2abs("$tmpdir/test.fifo");
26010  unless (POSIX::mkfifo($fifo, 0666)) {
26011    die("Can't create fifo $fifo: $!");
26012  }
26013
26014  my $config = {
26015    PidFile => $pid_file,
26016    ScoreboardFile => $scoreboard_file,
26017    SystemLog => $log_file,
26018    TraceLog => $log_file,
26019    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
26020
26021    AuthUserFile => $auth_user_file,
26022    AuthGroupFile => $auth_group_file,
26023    AllowOverwrite => 'on',
26024
26025    IfModules => {
26026      'mod_delay.c' => {
26027        DelayEngine => 'off',
26028      },
26029
26030      'mod_sftp.c' => [
26031        "SFTPEngine on",
26032        "SFTPLog $log_file",
26033        "SFTPHostKey $rsa_host_key",
26034        "SFTPHostKey $dsa_host_key",
26035      ],
26036    },
26037  };
26038
26039  my ($port, $config_user, $config_group) = config_write($config_file, $config);
26040
26041  # Open pipes, for use between the parent and child processes.  Specifically,
26042  # the child will indicate when it's done with its test by writing a message
26043  # to the parent.
26044  my ($rfh, $wfh);
26045  unless (pipe($rfh, $wfh)) {
26046    die("Can't open pipe: $!");
26047  }
26048
26049  require Net::SSH2;
26050
26051  my $ex;
26052
26053  # Ignore SIGPIPE
26054  local $SIG{PIPE} = sub { };
26055
26056  # Fork child
26057  $self->handle_sigchld();
26058  defined(my $pid = fork()) or die("Can't fork: $!");
26059  if ($pid) {
26060    eval {
26061      my $ssh2 = Net::SSH2->new();
26062
26063      sleep(1);
26064
26065      unless ($ssh2->connect('127.0.0.1', $port)) {
26066        my ($err_code, $err_name, $err_str) = $ssh2->error();
26067        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
26068      }
26069
26070      unless ($ssh2->auth_password($user, $passwd)) {
26071        my ($err_code, $err_name, $err_str) = $ssh2->error();
26072        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
26073      }
26074
26075      my $sftp = $ssh2->sftp();
26076      unless ($sftp) {
26077        my ($err_code, $err_name, $err_str) = $ssh2->error();
26078        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
26079      }
26080
26081      my $fh = $sftp->open('test.fifo', O_WRONLY|O_CREAT|O_TRUNC, 0644);
26082      if ($fh) {
26083        die("OPEN test.fifo succeeded unexpectedly");
26084      }
26085
26086      my ($err_code, $err_name) = $sftp->error();
26087
26088      my $expected = 'SSH_FX_NO_SUCH_FILE';
26089      $self->assert($expected eq $err_name,
26090        test_msg("Expected '$expected', got '$err_name'"));
26091
26092      $sftp = undef;
26093      $ssh2->disconnect();
26094    };
26095
26096    if ($@) {
26097      $ex = $@;
26098    }
26099
26100    $wfh->print("done\n");
26101    $wfh->flush();
26102
26103  } else {
26104    eval { server_wait($config_file, $rfh) };
26105    if ($@) {
26106      warn($@);
26107      exit 1;
26108    }
26109
26110    exit 0;
26111  }
26112
26113  # Stop server
26114  server_stop($pid_file);
26115
26116  $self->assert_child_ok($pid);
26117
26118  if ($ex) {
26119    test_append_logfile($log_file, $ex);
26120    unlink($log_file);
26121
26122    die($ex);
26123  }
26124
26125  unlink($log_file);
26126}
26127
26128sub sftp_upload_fifo_bug3313 {
26129  my $self = shift;
26130  my $tmpdir = $self->{tmpdir};
26131
26132  my $config_file = "$tmpdir/sftp.conf";
26133  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
26134  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
26135
26136  my $log_file = test_get_logfile();
26137
26138  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
26139  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
26140
26141  my $user = 'proftpd';
26142  my $passwd = 'test';
26143  my $group = 'ftpd';
26144  my $home_dir = File::Spec->rel2abs($tmpdir);
26145  my $uid = 500;
26146  my $gid = 500;
26147
26148  # Make sure that, if we're running as root, that the home directory has
26149  # permissions/privs set for the account we create
26150  if ($< == 0) {
26151    unless (chmod(0755, $home_dir)) {
26152      die("Can't set perms on $home_dir to 0755: $!");
26153    }
26154
26155    unless (chown($uid, $gid, $home_dir)) {
26156      die("Can't set owner of $home_dir to $uid/$gid: $!");
26157    }
26158  }
26159
26160  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
26161    '/bin/bash');
26162  auth_group_write($auth_group_file, $group, $gid, $user);
26163
26164  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
26165  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
26166
26167  # XXX This assume that a FIFO reader is running, and opened at this path
26168  my $fifo = File::Spec->rel2abs("/tmp/test.fifo");
26169
26170  my $config = {
26171    PidFile => $pid_file,
26172    ScoreboardFile => $scoreboard_file,
26173    SystemLog => $log_file,
26174    TraceLog => $log_file,
26175    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
26176
26177    AuthUserFile => $auth_user_file,
26178    AuthGroupFile => $auth_group_file,
26179    AllowOverwrite => 'on',
26180
26181    IfModules => {
26182      'mod_delay.c' => {
26183        DelayEngine => 'off',
26184      },
26185
26186      'mod_sftp.c' => [
26187        "SFTPEngine on",
26188        "SFTPLog $log_file",
26189        "SFTPHostKey $rsa_host_key",
26190        "SFTPHostKey $dsa_host_key",
26191      ],
26192    },
26193  };
26194
26195  my ($port, $config_user, $config_group) = config_write($config_file, $config);
26196
26197  # Open pipes, for use between the parent and child processes.  Specifically,
26198  # the child will indicate when it's done with its test by writing a message
26199  # to the parent.
26200  my ($rfh, $wfh);
26201  unless (pipe($rfh, $wfh)) {
26202    die("Can't open pipe: $!");
26203  }
26204
26205  require Net::SSH2;
26206
26207  my $ex;
26208
26209  # Ignore SIGPIPE
26210  local $SIG{PIPE} = sub { };
26211
26212  # Fork child
26213  $self->handle_sigchld();
26214  defined(my $pid = fork()) or die("Can't fork: $!");
26215  if ($pid) {
26216    eval {
26217      my $ssh2 = Net::SSH2->new();
26218
26219      sleep(1);
26220
26221      unless ($ssh2->connect('127.0.0.1', $port)) {
26222        my ($err_code, $err_name, $err_str) = $ssh2->error();
26223        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
26224      }
26225
26226      unless ($ssh2->auth_password($user, $passwd)) {
26227        my ($err_code, $err_name, $err_str) = $ssh2->error();
26228        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
26229      }
26230
26231      my $sftp = $ssh2->sftp();
26232      unless ($sftp) {
26233        my ($err_code, $err_name, $err_str) = $ssh2->error();
26234        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
26235      }
26236
26237      my $fh = $sftp->open('/tmp/test.fifo', O_WRONLY|O_CREAT|O_TRUNC, 0644);
26238      unless ($fh) {
26239        my ($err_code, $err_name) = $sftp->error();
26240        die("Can't open /tmp/test.fifo: [$err_name] ($err_code)");
26241      }
26242
26243      # Attempt to truncate the FIFO as well
26244      my $res = $fh->setstat(
26245        size => 24,
26246      );
26247      unless ($res) {
26248        my ($err_code, $err_name) = $sftp->error();
26249        die("Can't truncate /tmp/test.fifo: [$err_name] ($err_code)");
26250      }
26251
26252      my $count = 20;
26253      for (my $i = 0; $i < $count; $i++) {
26254        print $fh "ABCD" x 8192;
26255      }
26256
26257      $fh = undef;
26258      $sftp = undef;
26259      $ssh2->disconnect();
26260    };
26261
26262    if ($@) {
26263      $ex = $@;
26264    }
26265
26266    $wfh->print("done\n");
26267    $wfh->flush();
26268
26269  } else {
26270    eval { server_wait($config_file, $rfh) };
26271    if ($@) {
26272      warn($@);
26273      exit 1;
26274    }
26275
26276    exit 0;
26277  }
26278
26279  # Stop server
26280  server_stop($pid_file);
26281
26282  $self->assert_child_ok($pid);
26283
26284  if ($ex) {
26285    test_append_logfile($log_file, $ex);
26286    unlink($log_file);
26287
26288    die($ex);
26289  }
26290
26291  unlink($log_file);
26292}
26293
26294sub sftp_ext_upload_bug3550 {
26295  my $self = shift;
26296  my $tmpdir = $self->{tmpdir};
26297
26298  my $config_file = "$tmpdir/sftp.conf";
26299  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
26300  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
26301
26302  my $log_file = test_get_logfile();
26303
26304  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
26305  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
26306
26307  my $user = 'proftpd';
26308  my $passwd = 'test';
26309  my $group = 'ftpd';
26310  my $home_dir = File::Spec->rel2abs($tmpdir);
26311  my $uid = 500;
26312  my $gid = 500;
26313
26314  # Make sure that, if we're running as root, that the home directory has
26315  # permissions/privs set for the account we create
26316  if ($< == 0) {
26317    unless (chmod(0755, $home_dir)) {
26318      die("Can't set perms on $home_dir to 0755: $!");
26319    }
26320
26321    unless (chown($uid, $gid, $home_dir)) {
26322      die("Can't set owner of $home_dir to $uid/$gid: $!");
26323    }
26324  }
26325
26326  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
26327    '/bin/bash');
26328  auth_group_write($auth_group_file, $group, $gid, $user);
26329
26330  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
26331  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
26332
26333  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
26334  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
26335  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
26336
26337  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
26338  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
26339    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
26340  }
26341
26342  my $src_file = File::Spec->rel2abs('t/etc/modules/mod_sftp/bug3550.php');
26343
26344  # Calculate the MD5 checksum of this file, for comparison with the uploaded
26345  # file.
26346  my $ctx = Digest::MD5->new();
26347  my $expected_md5;
26348
26349  if (open(my $fh, "< $src_file")) {
26350    binmode($fh);
26351    $ctx->addfile($fh);
26352    $expected_md5 = $ctx->hexdigest();
26353    close($fh);
26354
26355  } else {
26356    die("Can't read $src_file: $!");
26357  }
26358
26359  my $expected_sz = (stat($src_file))[7];
26360
26361  my $dst_file = File::Spec->rel2abs("$tmpdir/test.dat");
26362
26363  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.txt");
26364  if (open(my $fh, "> $batch_file")) {
26365    print $fh "put -P $src_file $dst_file\n";
26366
26367    unless (close($fh)) {
26368      die("Can't write $batch_file: $!");
26369    }
26370
26371  } else {
26372    die("Can't open $batch_file: $!");
26373  }
26374
26375  my $config = {
26376    PidFile => $pid_file,
26377    ScoreboardFile => $scoreboard_file,
26378    SystemLog => $log_file,
26379    TraceLog => $log_file,
26380    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
26381
26382    AuthUserFile => $auth_user_file,
26383    AuthGroupFile => $auth_group_file,
26384
26385    IfModules => {
26386      'mod_delay.c' => {
26387        DelayEngine => 'off',
26388      },
26389
26390      'mod_sftp.c' => [
26391        "SFTPEngine on",
26392        "SFTPLog $log_file",
26393        "SFTPHostKey $rsa_host_key",
26394        "SFTPHostKey $dsa_host_key",
26395        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
26396
26397        "SFTPCiphers aes256-ctr aes192-ctr aes128-ctr",
26398        "SFTPDigests hmac-sha1 hmac-ripemd160",
26399
26400        # Bug#3551 requires that mod_sftp support compression, and that
26401        # the client use compression for the uploads.
26402        "SFTPCompression delayed",
26403      ],
26404    },
26405  };
26406
26407  my ($port, $config_user, $config_group) = config_write($config_file, $config);
26408
26409  # Open pipes, for use between the parent and child processes.  Specifically,
26410  # the child will indicate when it's done with its test by writing a message
26411  # to the parent.
26412  my ($rfh, $wfh);
26413  unless (pipe($rfh, $wfh)) {
26414    die("Can't open pipe: $!");
26415  }
26416
26417  require Net::SSH2;
26418
26419  my $ex;
26420
26421  # Ignore SIGPIPE
26422  local $SIG{PIPE} = sub { };
26423
26424  # Fork child
26425  $self->handle_sigchld();
26426  defined(my $pid = fork()) or die("Can't fork: $!");
26427  if ($pid) {
26428    eval {
26429      my @cmd = (
26430        'sftp',
26431        '-oBatchMode=yes',
26432        '-oCheckHostIP=no',
26433        '-oCompression=yes',
26434        "-oPort=$port",
26435        "-oIdentityFile=$rsa_priv_key",
26436        '-oPubkeyAuthentication=yes',
26437        '-oStrictHostKeyChecking=no',
26438        '-vvv',
26439        '-b',
26440        "$batch_file",
26441        "$user\@127.0.0.1",
26442      );
26443
26444      my $sftp_rh = IO::Handle->new();
26445      my $sftp_wh = IO::Handle->new();
26446      my $sftp_eh = IO::Handle->new();
26447
26448      $sftp_wh->autoflush(1);
26449
26450      sleep(1);
26451
26452      local $SIG{CHLD} = 'DEFAULT';
26453
26454      # Make sure that the perms on the priv key are what OpenSSH wants
26455      unless (chmod(0400, $rsa_priv_key)) {
26456        die("Can't set perms on $rsa_priv_key to 0400: $!");
26457      }
26458
26459      if ($ENV{TEST_VERBOSE}) {
26460        print STDERR "Executing: ", join(' ', @cmd), "\n";
26461      }
26462
26463      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
26464      waitpid($sftp_pid, 0);
26465      my $exit_status = $?;
26466
26467      # Restore the perms on the priv key
26468      unless (chmod(0644, $rsa_priv_key)) {
26469        die("Can't set perms on $rsa_priv_key to 0644: $!");
26470      }
26471
26472      my ($res, $errstr);
26473      if ($exit_status >> 8 == 0) {
26474        $errstr = join('', <$sftp_eh>);
26475        $res = 0;
26476
26477      } else {
26478        $errstr = join('', <$sftp_eh>);
26479        if ($ENV{TEST_VERBOSE}) {
26480          print STDERR "Stderr: $errstr\n";
26481        }
26482
26483        $res = 1;
26484      }
26485
26486      unless ($res == 0) {
26487        die("Can't upload $src_file to server: $errstr");
26488      }
26489
26490      unless (-f $dst_file) {
26491        die("File '$dst_file' does not exist as expected");
26492      }
26493
26494      $ctx->reset();
26495      my $md5;
26496
26497      if (open(my $fh, "< $dst_file")) {
26498        binmode($fh);
26499        $ctx->addfile($fh);
26500        $md5 = $ctx->hexdigest();
26501        close($fh);
26502
26503      } else {
26504        die("Can't read $dst_file: $!");
26505      }
26506
26507      my $sz = (stat($dst_file))[7];
26508
26509      $self->assert($expected_sz == $sz,
26510        test_msg("Expected $expected_sz, got $sz"));
26511
26512      $self->assert($expected_md5 eq $md5,
26513        test_msg("Expected '$expected_md5', got '$md5'"));
26514    };
26515
26516    if ($@) {
26517      $ex = $@;
26518    }
26519
26520    $wfh->print("done\n");
26521    $wfh->flush();
26522
26523  } else {
26524    eval { server_wait($config_file, $rfh) };
26525    if ($@) {
26526      warn($@);
26527      exit 1;
26528    }
26529
26530    exit 0;
26531  }
26532
26533  # Stop server
26534  server_stop($pid_file);
26535
26536  $self->assert_child_ok($pid);
26537
26538  if ($ex) {
26539    test_append_logfile($log_file, $ex);
26540    unlink($log_file);
26541
26542    die($ex);
26543  }
26544
26545  unlink($log_file);
26546}
26547
26548sub sftp_download {
26549  my $self = shift;
26550  my $tmpdir = $self->{tmpdir};
26551
26552  my $config_file = "$tmpdir/sftp.conf";
26553  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
26554  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
26555
26556  my $log_file = test_get_logfile();
26557
26558  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
26559  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
26560
26561  my $user = 'proftpd';
26562  my $passwd = 'test';
26563  my $group = 'ftpd';
26564  my $home_dir = File::Spec->rel2abs($tmpdir);
26565  my $uid = 500;
26566  my $gid = 500;
26567
26568  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
26569  if (open(my $fh, "> $test_file")) {
26570    my $count = 20;
26571    for (my $i = 0; $i < $count; $i++) {
26572      print $fh "ABCD" x 8192;
26573    }
26574
26575    unless (close($fh)) {
26576      die("Can't write $test_file: $!");
26577    }
26578
26579  } else {
26580    die("Can't open $test_file: $!");
26581  }
26582
26583  my $test_sz = (stat($test_file))[7];
26584
26585  # Make sure that, if we're running as root, that the home directory has
26586  # permissions/privs set for the account we create
26587  if ($< == 0) {
26588    unless (chmod(0755, $home_dir)) {
26589      die("Can't set perms on $home_dir to 0755: $!");
26590    }
26591
26592    unless (chown($uid, $gid, $home_dir)) {
26593      die("Can't set owner of $home_dir to $uid/$gid: $!");
26594    }
26595  }
26596
26597  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
26598    '/bin/bash');
26599  auth_group_write($auth_group_file, $group, $gid, $user);
26600
26601  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
26602  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
26603
26604  my $config = {
26605    PidFile => $pid_file,
26606    ScoreboardFile => $scoreboard_file,
26607    SystemLog => $log_file,
26608    TraceLog => $log_file,
26609    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
26610
26611    AuthUserFile => $auth_user_file,
26612    AuthGroupFile => $auth_group_file,
26613
26614    IfModules => {
26615      'mod_delay.c' => {
26616        DelayEngine => 'off',
26617      },
26618
26619      'mod_sftp.c' => [
26620        "SFTPEngine on",
26621        "SFTPLog $log_file",
26622        "SFTPHostKey $rsa_host_key",
26623        "SFTPHostKey $dsa_host_key",
26624      ],
26625    },
26626  };
26627
26628  my ($port, $config_user, $config_group) = config_write($config_file, $config);
26629
26630  # Open pipes, for use between the parent and child processes.  Specifically,
26631  # the child will indicate when it's done with its test by writing a message
26632  # to the parent.
26633  my ($rfh, $wfh);
26634  unless (pipe($rfh, $wfh)) {
26635    die("Can't open pipe: $!");
26636  }
26637
26638  require Net::SSH2;
26639
26640  my $ex;
26641
26642  # Ignore SIGPIPE
26643  local $SIG{PIPE} = sub { };
26644
26645  # Fork child
26646  $self->handle_sigchld();
26647  defined(my $pid = fork()) or die("Can't fork: $!");
26648  if ($pid) {
26649    eval {
26650      my $ssh2 = Net::SSH2->new();
26651
26652      sleep(1);
26653
26654      unless ($ssh2->connect('127.0.0.1', $port)) {
26655        my ($err_code, $err_name, $err_str) = $ssh2->error();
26656        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
26657      }
26658
26659      unless ($ssh2->auth_password($user, $passwd)) {
26660        my ($err_code, $err_name, $err_str) = $ssh2->error();
26661        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
26662      }
26663
26664      my $sftp = $ssh2->sftp();
26665      unless ($sftp) {
26666        my ($err_code, $err_name, $err_str) = $ssh2->error();
26667        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
26668      }
26669
26670      my $fh = $sftp->open('test.txt', O_RDONLY);
26671      unless ($fh) {
26672        my ($err_code, $err_name) = $sftp->error();
26673        die("Can't open test.txt: [$err_name] ($err_code)");
26674      }
26675
26676      my $buf;
26677      my $size = 0;
26678
26679      my $res = $fh->read($buf, 8192);
26680      while ($res) {
26681        $size += $res;
26682
26683        $res = $fh->read($buf, 8192);
26684      }
26685
26686      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
26687      $fh = undef;
26688
26689      # To close the SFTP channel, we have to explicitly destroy the object
26690      $sftp = undef;
26691
26692      $self->assert($test_sz == $size,
26693        test_msg("Expected $test_sz, got $size"));
26694
26695      $ssh2->disconnect();
26696    };
26697
26698    if ($@) {
26699      $ex = $@;
26700    }
26701
26702    $wfh->print("done\n");
26703    $wfh->flush();
26704
26705  } else {
26706    eval { server_wait($config_file, $rfh) };
26707    if ($@) {
26708      warn($@);
26709      exit 1;
26710    }
26711
26712    exit 0;
26713  }
26714
26715  # Stop server
26716  server_stop($pid_file);
26717
26718  $self->assert_child_ok($pid);
26719
26720  if ($ex) {
26721    test_append_logfile($log_file, $ex);
26722    unlink($log_file);
26723
26724    die($ex);
26725  }
26726
26727  unlink($log_file);
26728}
26729
26730sub sftp_download_with_compression {
26731  my $self = shift;
26732  my $tmpdir = $self->{tmpdir};
26733
26734  my $config_file = "$tmpdir/sftp.conf";
26735  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
26736  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
26737
26738  my $log_file = test_get_logfile();
26739
26740  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
26741  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
26742
26743  my $user = 'proftpd';
26744  my $passwd = 'test';
26745  my $group = 'ftpd';
26746  my $home_dir = File::Spec->rel2abs($tmpdir);
26747  my $uid = 500;
26748  my $gid = 500;
26749
26750  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
26751  if (open(my $fh, "> $test_file")) {
26752    my $count = 20;
26753    for (my $i = 0; $i < $count; $i++) {
26754      print $fh "ABCD" x 8192;
26755    }
26756
26757    unless (close($fh)) {
26758      die("Can't write $test_file: $!");
26759    }
26760
26761  } else {
26762    die("Can't open $test_file: $!");
26763  }
26764
26765  my $test_sz = (stat($test_file))[7];
26766
26767  # Make sure that, if we're running as root, that the home directory has
26768  # permissions/privs set for the account we create
26769  if ($< == 0) {
26770    unless (chmod(0755, $home_dir)) {
26771      die("Can't set perms on $home_dir to 0755: $!");
26772    }
26773
26774    unless (chown($uid, $gid, $home_dir)) {
26775      die("Can't set owner of $home_dir to $uid/$gid: $!");
26776    }
26777  }
26778
26779  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
26780    '/bin/bash');
26781  auth_group_write($auth_group_file, $group, $gid, $user);
26782
26783  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
26784  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
26785
26786  my $config = {
26787    PidFile => $pid_file,
26788    ScoreboardFile => $scoreboard_file,
26789    SystemLog => $log_file,
26790    TraceLog => $log_file,
26791    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
26792
26793    AuthUserFile => $auth_user_file,
26794    AuthGroupFile => $auth_group_file,
26795
26796    IfModules => {
26797      'mod_delay.c' => {
26798        DelayEngine => 'off',
26799      },
26800
26801      'mod_sftp.c' => [
26802        "SFTPEngine on",
26803        "SFTPLog $log_file",
26804        "SFTPHostKey $rsa_host_key",
26805        "SFTPHostKey $dsa_host_key",
26806
26807        "SFTPCompression on",
26808      ],
26809    },
26810  };
26811
26812  my ($port, $config_user, $config_group) = config_write($config_file, $config);
26813
26814  # Open pipes, for use between the parent and child processes.  Specifically,
26815  # the child will indicate when it's done with its test by writing a message
26816  # to the parent.
26817  my ($rfh, $wfh);
26818  unless (pipe($rfh, $wfh)) {
26819    die("Can't open pipe: $!");
26820  }
26821
26822  require Net::SSH2;
26823
26824  my $ex;
26825
26826  # Ignore SIGPIPE
26827  local $SIG{PIPE} = sub { };
26828
26829  # Fork child
26830  $self->handle_sigchld();
26831  defined(my $pid = fork()) or die("Can't fork: $!");
26832  if ($pid) {
26833    eval {
26834      my $ssh2 = Net::SSH2->new();
26835
26836      sleep(1);
26837
26838      my $comp = 'zlib';
26839      $ssh2->method('comp_cs', $comp);
26840      $ssh2->method('comp_sc', $comp);
26841
26842      unless ($ssh2->connect('127.0.0.1', $port)) {
26843        my ($err_code, $err_name, $err_str) = $ssh2->error();
26844        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
26845      }
26846
26847      unless ($ssh2->auth_password($user, $passwd)) {
26848        my ($err_code, $err_name, $err_str) = $ssh2->error();
26849        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
26850      }
26851
26852      my $sftp = $ssh2->sftp();
26853      unless ($sftp) {
26854        my ($err_code, $err_name, $err_str) = $ssh2->error();
26855        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
26856      }
26857
26858      my $fh = $sftp->open('test.txt', O_RDONLY);
26859      unless ($fh) {
26860        my ($err_code, $err_name) = $sftp->error();
26861        die("Can't open test.txt: [$err_name] ($err_code)");
26862      }
26863
26864      my $buf;
26865      my $size = 0;
26866
26867      my $res = $fh->read($buf, 8192);
26868      if ($res < 0) {
26869        my ($err_code, $err_name) = $sftp->error();
26870        die("Can't read test.txt: [$err_name] ($err_code)");
26871      }
26872
26873      while ($res) {
26874        $size += $res;
26875
26876        $res = $fh->read($buf, 8192);
26877        if ($res < 0) {
26878          my ($err_code, $err_name) = $sftp->error();
26879          die("Can't read test.txt: [$err_name] ($err_code)");
26880        }
26881      }
26882
26883      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
26884      $fh = undef;
26885
26886      # To close the SFTP channel, we have to explicitly destroy the object
26887      $sftp = undef;
26888
26889      $self->assert($test_sz == $size,
26890        test_msg("Expected $test_sz, got $size"));
26891
26892      $ssh2->disconnect();
26893    };
26894
26895    if ($@) {
26896      $ex = $@;
26897    }
26898
26899    $wfh->print("done\n");
26900    $wfh->flush();
26901
26902  } else {
26903    eval { server_wait($config_file, $rfh) };
26904    if ($@) {
26905      warn($@);
26906      exit 1;
26907    }
26908
26909    exit 0;
26910  }
26911
26912  # Stop server
26913  server_stop($pid_file);
26914
26915  $self->assert_child_ok($pid);
26916
26917  if ($ex) {
26918    test_append_logfile($log_file, $ex);
26919    unlink($log_file);
26920
26921    die($ex);
26922  }
26923
26924  unlink($log_file);
26925}
26926
26927sub sftp_download_with_compression_rekeying {
26928  my $self = shift;
26929  my $tmpdir = $self->{tmpdir};
26930  my $setup = test_setup($tmpdir, 'sftp');
26931
26932  my $test_file = File::Spec->rel2abs("$tmpdir/test.dat");
26933  if (open(my $fh, "> $test_file")) {
26934    my $count = 200;
26935    for (my $i = 0; $i < $count; $i++) {
26936      print $fh "ABCD" x 8192;
26937    }
26938
26939    unless (close($fh)) {
26940      die("Can't write $test_file: $!");
26941    }
26942
26943  } else {
26944    die("Can't open $test_file: $!");
26945  }
26946
26947  my $test_sz = (stat($test_file))[7];
26948
26949  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
26950  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
26951
26952  my $config = {
26953    PidFile => $setup->{pid_file},
26954    ScoreboardFile => $setup->{scoreboard_file},
26955    SystemLog => $setup->{log_file},
26956    TraceLog => $setup->{log_file},
26957    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
26958
26959    AuthUserFile => $setup->{auth_user_file},
26960    AuthGroupFile => $setup->{auth_group_file},
26961
26962    IfModules => {
26963      'mod_delay.c' => {
26964        DelayEngine => 'off',
26965      },
26966
26967      'mod_sftp.c' => [
26968        "SFTPEngine on",
26969        "SFTPLog $setup->{log_file}",
26970        "SFTPHostKey $rsa_host_key",
26971        "SFTPHostKey $dsa_host_key",
26972
26973        "SFTPCompression delayed",
26974
26975        # To tickle the bug, use frequent rekeying
26976        'SFTPRekey required 2 1',
26977      ],
26978    },
26979  };
26980
26981  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
26982    $config);
26983
26984  # Open pipes, for use between the parent and child processes.  Specifically,
26985  # the child will indicate when it's done with its test by writing a message
26986  # to the parent.
26987  my ($rfh, $wfh);
26988  unless (pipe($rfh, $wfh)) {
26989    die("Can't open pipe: $!");
26990  }
26991
26992  require Net::SSH2;
26993
26994  my $ex;
26995
26996  # Ignore SIGPIPE
26997  local $SIG{PIPE} = sub { };
26998
26999  # Fork child
27000  $self->handle_sigchld();
27001  defined(my $pid = fork()) or die("Can't fork: $!");
27002  if ($pid) {
27003    eval {
27004      my $ssh2 = Net::SSH2->new();
27005
27006      sleep(1);
27007
27008      my $comp = 'zlib';
27009      $ssh2->method('comp_cs', $comp);
27010      $ssh2->method('comp_sc', $comp);
27011
27012      unless ($ssh2->connect('127.0.0.1', $port)) {
27013        my ($err_code, $err_name, $err_str) = $ssh2->error();
27014        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
27015      }
27016
27017      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
27018        my ($err_code, $err_name, $err_str) = $ssh2->error();
27019        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
27020      }
27021
27022      my $sftp = $ssh2->sftp();
27023      unless ($sftp) {
27024        my ($err_code, $err_name, $err_str) = $ssh2->error();
27025        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
27026      }
27027
27028      my $file = 'test.dat';
27029      my $fh = $sftp->open($file, O_RDONLY);
27030      unless ($fh) {
27031        my ($err_code, $err_name) = $sftp->error();
27032        die("Can't open $file: [$err_name] ($err_code)");
27033      }
27034
27035      my $buf;
27036      my $size = 0;
27037
27038      my $res = $fh->read($buf, 8192);
27039      if ($res < 0) {
27040        my ($err_code, $err_name) = $sftp->error();
27041        die("Can't read $file: [$err_name] ($err_code)");
27042      }
27043
27044      while ($res) {
27045        $size += $res;
27046
27047        $res = $fh->read($buf, 8192);
27048        if ($res < 0) {
27049          my ($err_code, $err_name) = $sftp->error();
27050          die("Can't read $file: [$err_name] ($err_code)");
27051        }
27052      }
27053
27054      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
27055      $fh = undef;
27056
27057      # To close the SFTP channel, we have to explicitly destroy the object
27058      $sftp = undef;
27059
27060      $self->assert($test_sz == $size,
27061        test_msg("Expected $test_sz, got $size"));
27062
27063      $ssh2->disconnect();
27064    };
27065
27066    if ($@) {
27067      $ex = $@;
27068    }
27069
27070    $wfh->print("done\n");
27071    $wfh->flush();
27072
27073  } else {
27074    eval { server_wait($setup->{config_file}, $rfh, 30) };
27075    if ($@) {
27076      warn($@);
27077      exit 1;
27078    }
27079
27080    exit 0;
27081  }
27082
27083  # Stop server
27084  server_stop($setup->{pid_file});
27085  $self->assert_child_ok($pid);
27086
27087  test_cleanup($setup->{log_file}, $ex);
27088}
27089
27090sub sftp_download_zero_len_file {
27091  my $self = shift;
27092  my $tmpdir = $self->{tmpdir};
27093
27094  my $config_file = "$tmpdir/sftp.conf";
27095  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
27096  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
27097
27098  my $log_file = test_get_logfile();
27099
27100  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
27101  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
27102
27103  my $user = 'proftpd';
27104  my $passwd = 'test';
27105  my $group = 'ftpd';
27106  my $home_dir = File::Spec->rel2abs($tmpdir);
27107  my $uid = 500;
27108  my $gid = 500;
27109
27110  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
27111  if (open(my $fh, "> $test_file")) {
27112    unless (close($fh)) {
27113      die("Can't write $test_file: $!");
27114    }
27115
27116  } else {
27117    die("Can't open $test_file: $!");
27118  }
27119
27120  my $test_sz = (stat($test_file))[7];
27121
27122  # Make sure that, if we're running as root, that the home directory has
27123  # permissions/privs set for the account we create
27124  if ($< == 0) {
27125    unless (chmod(0755, $home_dir)) {
27126      die("Can't set perms on $home_dir to 0755: $!");
27127    }
27128
27129    unless (chown($uid, $gid, $home_dir)) {
27130      die("Can't set owner of $home_dir to $uid/$gid: $!");
27131    }
27132  }
27133
27134  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
27135    '/bin/bash');
27136  auth_group_write($auth_group_file, $group, $gid, $user);
27137
27138  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
27139  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
27140
27141  my $config = {
27142    PidFile => $pid_file,
27143    ScoreboardFile => $scoreboard_file,
27144    SystemLog => $log_file,
27145    TraceLog => $log_file,
27146    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
27147
27148    AuthUserFile => $auth_user_file,
27149    AuthGroupFile => $auth_group_file,
27150
27151    IfModules => {
27152      'mod_delay.c' => {
27153        DelayEngine => 'off',
27154      },
27155
27156      'mod_sftp.c' => [
27157        "SFTPEngine on",
27158        "SFTPLog $log_file",
27159        "SFTPHostKey $rsa_host_key",
27160        "SFTPHostKey $dsa_host_key",
27161      ],
27162    },
27163  };
27164
27165  my ($port, $config_user, $config_group) = config_write($config_file, $config);
27166
27167  # Open pipes, for use between the parent and child processes.  Specifically,
27168  # the child will indicate when it's done with its test by writing a message
27169  # to the parent.
27170  my ($rfh, $wfh);
27171  unless (pipe($rfh, $wfh)) {
27172    die("Can't open pipe: $!");
27173  }
27174
27175  require Net::SSH2;
27176
27177  my $ex;
27178
27179  # Ignore SIGPIPE
27180  local $SIG{PIPE} = sub { };
27181
27182  # Fork child
27183  $self->handle_sigchld();
27184  defined(my $pid = fork()) or die("Can't fork: $!");
27185  if ($pid) {
27186    eval {
27187      my $ssh2 = Net::SSH2->new();
27188
27189      sleep(1);
27190
27191      unless ($ssh2->connect('127.0.0.1', $port)) {
27192        my ($err_code, $err_name, $err_str) = $ssh2->error();
27193        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
27194      }
27195
27196      unless ($ssh2->auth_password($user, $passwd)) {
27197        my ($err_code, $err_name, $err_str) = $ssh2->error();
27198        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
27199      }
27200
27201      my $sftp = $ssh2->sftp();
27202      unless ($sftp) {
27203        my ($err_code, $err_name, $err_str) = $ssh2->error();
27204        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
27205      }
27206
27207      my $fh = $sftp->open('test.txt', O_RDONLY);
27208      unless ($fh) {
27209        my ($err_code, $err_name) = $sftp->error();
27210        die("Can't open test.txt: [$err_name] ($err_code)");
27211      }
27212
27213      my $buf;
27214      my $size = 0;
27215
27216      my $res = $fh->read($buf, 8192);
27217      while ($res) {
27218        $size += $res;
27219
27220        $res = $fh->read($buf, 8192);
27221      }
27222
27223      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
27224      $fh = undef;
27225
27226      # To close the SFTP channel, we have to explicitly destroy the object
27227      $sftp = undef;
27228
27229      $self->assert($test_sz == $size,
27230        test_msg("Expected $test_sz, got $size"));
27231
27232      $ssh2->disconnect();
27233    };
27234
27235    if ($@) {
27236      $ex = $@;
27237    }
27238
27239    $wfh->print("done\n");
27240    $wfh->flush();
27241
27242  } else {
27243    eval { server_wait($config_file, $rfh) };
27244    if ($@) {
27245      warn($@);
27246      exit 1;
27247    }
27248
27249    exit 0;
27250  }
27251
27252  # Stop server
27253  server_stop($pid_file);
27254
27255  $self->assert_child_ok($pid);
27256
27257  if ($ex) {
27258    test_append_logfile($log_file, $ex);
27259    unlink($log_file);
27260
27261    die($ex);
27262  }
27263
27264  unlink($log_file);
27265}
27266
27267sub sftp_download_largefile {
27268  my $self = shift;
27269  my $tmpdir = $self->{tmpdir};
27270
27271  my $config_file = "$tmpdir/sftp.conf";
27272  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
27273  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
27274
27275  my $log_file = test_get_logfile();
27276
27277  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
27278  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
27279
27280  my $user = 'proftpd';
27281  my $passwd = 'test';
27282  my $group = 'ftpd';
27283  my $home_dir = File::Spec->rel2abs($tmpdir);
27284  my $uid = 500;
27285  my $gid = 500;
27286
27287  # Make sure that, if we're running as root, that the home directory has
27288  # permissions/privs set for the account we create
27289  if ($< == 0) {
27290    unless (chmod(0755, $home_dir)) {
27291      die("Can't set perms on $home_dir to 0755: $!");
27292    }
27293
27294    unless (chown($uid, $gid, $home_dir)) {
27295      die("Can't set owner of $home_dir to $uid/$gid: $!");
27296    }
27297  }
27298
27299  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
27300    '/bin/bash');
27301  auth_group_write($auth_group_file, $group, $gid, $user);
27302
27303  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
27304  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
27305
27306  my $fh;
27307
27308  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
27309  if (open($fh, "> $test_file")) {
27310    # Make a file that's larger than the maximum SSH2 packet size, forcing
27311    # the scp code to loop properly entire the entire large file is sent.
27312
27313    print $fh "ABCDefgh" x 16384;
27314    unless (close($fh)) {
27315      die("Can't write $test_file: $!");
27316    }
27317
27318  } else {
27319    die("Can't open $test_file: $!");
27320  }
27321
27322  # Calculate the MD5 checksum of this file, for comparison with the
27323  # downloaded file.
27324  my $ctx = Digest::MD5->new();
27325  my $expected_md5;
27326
27327  if (open($fh, "< $test_file")) {
27328    binmode($fh);
27329    $ctx->addfile($fh);
27330    $expected_md5 = $ctx->hexdigest();
27331    close($fh);
27332
27333  } else {
27334    die("Can't read $test_file: $!");
27335  }
27336
27337  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
27338
27339  my $config = {
27340    PidFile => $pid_file,
27341    ScoreboardFile => $scoreboard_file,
27342    SystemLog => $log_file,
27343    TraceLog => $log_file,
27344    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
27345
27346    AuthUserFile => $auth_user_file,
27347    AuthGroupFile => $auth_group_file,
27348
27349    IfModules => {
27350      'mod_delay.c' => {
27351        DelayEngine => 'off',
27352      },
27353
27354      'mod_sftp.c' => [
27355        "SFTPEngine on",
27356        "SFTPLog $log_file",
27357        "SFTPHostKey $rsa_host_key",
27358        "SFTPHostKey $dsa_host_key",
27359      ],
27360    },
27361  };
27362
27363  my ($port, $config_user, $config_group) = config_write($config_file, $config);
27364
27365  # Open pipes, for use between the parent and child processes.  Specifically,
27366  # the child will indicate when it's done with its test by writing a message
27367  # to the parent.
27368  my ($rfh, $wfh);
27369  unless (pipe($rfh, $wfh)) {
27370    die("Can't open pipe: $!");
27371  }
27372
27373  require Net::SSH2;
27374
27375  my $ex;
27376
27377  # Ignore SIGPIPE
27378  local $SIG{PIPE} = sub { };
27379
27380  # Fork child
27381  $self->handle_sigchld();
27382  defined(my $pid = fork()) or die("Can't fork: $!");
27383  if ($pid) {
27384    my $test_wfh;
27385    unless (open($test_wfh, "> $test_file2")) {
27386      die("Can't open $test_file2: $!");
27387    }
27388
27389    binmode($test_wfh);
27390
27391    eval {
27392      my $ssh2 = Net::SSH2->new();
27393
27394      sleep(1);
27395
27396      unless ($ssh2->connect('127.0.0.1', $port)) {
27397        my ($err_code, $err_name, $err_str) = $ssh2->error();
27398        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
27399      }
27400
27401      unless ($ssh2->auth_password($user, $passwd)) {
27402        my ($err_code, $err_name, $err_str) = $ssh2->error();
27403        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
27404      }
27405
27406      my $sftp = $ssh2->sftp();
27407      unless ($sftp) {
27408        my ($err_code, $err_name, $err_str) = $ssh2->error();
27409        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
27410      }
27411
27412      my $test_rfh = $sftp->open('test.txt', O_RDONLY);
27413      unless ($test_rfh) {
27414        my ($err_code, $err_name) = $sftp->error();
27415        die("Can't open test.txt: [$err_name] ($err_code)");
27416      }
27417
27418      my $buf;
27419      my $bufsz = 8192;
27420
27421      my $res = $test_rfh->read($buf, $bufsz);
27422      while ($res) {
27423        print $test_wfh $buf;
27424
27425        $res = $test_rfh->read($buf, $bufsz);
27426      }
27427
27428      unless (close($test_wfh)) {
27429        die("Can't write $test_file2: $!");
27430      }
27431
27432      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
27433      $test_rfh = undef;
27434
27435      # To close the SFTP channel, we have to explicitly destroy the object
27436      $sftp = undef;
27437
27438      $ssh2->disconnect();
27439    };
27440
27441    if ($@) {
27442      $ex = $@;
27443    }
27444
27445    $wfh->print("done\n");
27446    $wfh->flush();
27447
27448  } else {
27449    eval { server_wait($config_file, $rfh) };
27450    if ($@) {
27451      warn($@);
27452      exit 1;
27453    }
27454
27455    exit 0;
27456  }
27457
27458  # Stop server
27459  server_stop($pid_file);
27460
27461  $self->assert_child_ok($pid);
27462
27463  if ($ex) {
27464    test_append_logfile($log_file, $ex);
27465    unlink($log_file);
27466
27467    die($ex);
27468  }
27469
27470  # Calculate the MD5 checksum of the downloaded file, for comparison with the
27471  # downloaded file.
27472  $ctx->reset();
27473  my $md5;
27474
27475  if (open($fh, "< $test_file2")) {
27476    binmode($fh);
27477    $ctx->addfile($fh);
27478    $md5 = $ctx->hexdigest();
27479    close($fh);
27480
27481  } else {
27482    die("Can't read $test_file2: $!");
27483  }
27484
27485  $self->assert($expected_md5 eq $md5,
27486    test_msg("Expected '$expected_md5', got '$md5'"));
27487
27488  unlink($log_file);
27489}
27490
27491sub sftp_download_fifo_bug3314 {
27492  my $self = shift;
27493  my $tmpdir = $self->{tmpdir};
27494
27495  my $config_file = "$tmpdir/sftp.conf";
27496  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
27497  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
27498
27499  my $log_file = test_get_logfile();
27500
27501  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
27502  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
27503
27504  my $user = 'proftpd';
27505  my $passwd = 'test';
27506  my $group = 'ftpd';
27507  my $home_dir = File::Spec->rel2abs($tmpdir);
27508  my $uid = 500;
27509  my $gid = 500;
27510
27511  my $fifo = File::Spec->rel2abs("/tmp/test.fifo");
27512
27513  # Make sure that, if we're running as root, that the home directory has
27514  # permissions/privs set for the account we create
27515  if ($< == 0) {
27516    unless (chmod(0755, $home_dir)) {
27517      die("Can't set perms on $home_dir to 0755: $!");
27518    }
27519
27520    unless (chown($uid, $gid, $home_dir)) {
27521      die("Can't set owner of $home_dir to $uid/$gid: $!");
27522    }
27523  }
27524
27525  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
27526    '/bin/bash');
27527  auth_group_write($auth_group_file, $group, $gid, $user);
27528
27529  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
27530  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
27531
27532  my $config = {
27533    PidFile => $pid_file,
27534    ScoreboardFile => $scoreboard_file,
27535    SystemLog => $log_file,
27536    TraceLog => $log_file,
27537    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
27538
27539    AuthUserFile => $auth_user_file,
27540    AuthGroupFile => $auth_group_file,
27541
27542    IfModules => {
27543      'mod_delay.c' => {
27544        DelayEngine => 'off',
27545      },
27546
27547      'mod_sftp.c' => [
27548        "SFTPEngine on",
27549        "SFTPLog $log_file",
27550        "SFTPHostKey $rsa_host_key",
27551        "SFTPHostKey $dsa_host_key",
27552      ],
27553    },
27554  };
27555
27556  my ($port, $config_user, $config_group) = config_write($config_file, $config);
27557
27558  # Open pipes, for use between the parent and child processes.  Specifically,
27559  # the child will indicate when it's done with its test by writing a message
27560  # to the parent.
27561  my ($rfh, $wfh);
27562  unless (pipe($rfh, $wfh)) {
27563    die("Can't open pipe: $!");
27564  }
27565
27566  require Net::SSH2;
27567
27568  my $ex;
27569
27570  # Ignore SIGPIPE
27571  local $SIG{PIPE} = sub { };
27572
27573  # Fork child
27574  $self->handle_sigchld();
27575  defined(my $pid = fork()) or die("Can't fork: $!");
27576  if ($pid) {
27577    eval {
27578      my $ssh2 = Net::SSH2->new();
27579
27580      sleep(1);
27581
27582      unless ($ssh2->connect('127.0.0.1', $port)) {
27583        my ($err_code, $err_name, $err_str) = $ssh2->error();
27584        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
27585      }
27586
27587      unless ($ssh2->auth_password($user, $passwd)) {
27588        my ($err_code, $err_name, $err_str) = $ssh2->error();
27589        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
27590      }
27591
27592      my $sftp = $ssh2->sftp();
27593      unless ($sftp) {
27594        my ($err_code, $err_name, $err_str) = $ssh2->error();
27595        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
27596      }
27597
27598      my $fh = $sftp->open($fifo, O_RDONLY);
27599      unless ($fh) {
27600        my ($err_code, $err_name) = $sftp->error();
27601        die("Can't open $fifo: [$err_name] ($err_code)");
27602      }
27603
27604      my $buf;
27605      my $size = 0;
27606
27607      my $res = $fh->read($buf, 8192);
27608      while ($res) {
27609        $size += $res;
27610
27611        $res = $fh->read($buf, 8192);
27612      }
27613
27614      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
27615      $fh = undef;
27616
27617      # To close the SFTP channel, we have to explicitly destroy the object
27618      $sftp = undef;
27619
27620      $ssh2->disconnect();
27621    };
27622
27623    if ($@) {
27624      $ex = $@;
27625    }
27626
27627    $wfh->print("done\n");
27628    $wfh->flush();
27629
27630  } else {
27631    eval { server_wait($config_file, $rfh) };
27632    if ($@) {
27633      warn($@);
27634      exit 1;
27635    }
27636
27637    exit 0;
27638  }
27639
27640  # Stop server
27641  server_stop($pid_file);
27642
27643  $self->assert_child_ok($pid);
27644
27645  if ($ex) {
27646    test_append_logfile($log_file, $ex);
27647    unlink($log_file);
27648
27649    die($ex);
27650  }
27651
27652  unlink($log_file);
27653}
27654
27655sub sftp_ext_download_bug3550 {
27656  my $self = shift;
27657  my $tmpdir = $self->{tmpdir};
27658
27659  my $config_file = "$tmpdir/sftp.conf";
27660  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
27661  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
27662
27663  my $log_file = test_get_logfile();
27664
27665  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
27666  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
27667
27668  my $user = 'proftpd';
27669  my $passwd = 'test';
27670  my $group = 'ftpd';
27671  my $home_dir = File::Spec->rel2abs($tmpdir);
27672  my $uid = 500;
27673  my $gid = 500;
27674
27675  # Make sure that, if we're running as root, that the home directory has
27676  # permissions/privs set for the account we create
27677  if ($< == 0) {
27678    unless (chmod(0755, $home_dir)) {
27679      die("Can't set perms on $home_dir to 0755: $!");
27680    }
27681
27682    unless (chown($uid, $gid, $home_dir)) {
27683      die("Can't set owner of $home_dir to $uid/$gid: $!");
27684    }
27685  }
27686
27687  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
27688    '/bin/bash');
27689  auth_group_write($auth_group_file, $group, $gid, $user);
27690
27691  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
27692  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
27693
27694  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
27695  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
27696  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
27697
27698  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
27699  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
27700    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
27701  }
27702
27703  my $orig_file = File::Spec->rel2abs('t/etc/modules/mod_sftp/bug3550.php');
27704
27705  # Calculate the MD5 checksum of this file, for comparison with the downloaded
27706  # file.
27707  my $ctx = Digest::MD5->new();
27708  my $expected_md5;
27709
27710  if (open(my $fh, "< $orig_file")) {
27711    binmode($fh);
27712    $ctx->addfile($fh);
27713    $expected_md5 = $ctx->hexdigest();
27714    close($fh);
27715
27716  } else {
27717    die("Can't read $orig_file: $!");
27718  }
27719
27720  my $expected_sz = (stat($orig_file))[7];
27721
27722  my $src_file = File::Spec->rel2abs("$tmpdir/test.dat");
27723  unless (copy($orig_file, $src_file)) {
27724    die("Can't copy $orig_file to $src_file: $!");
27725  }
27726
27727  my $dst_file = File::Spec->rel2abs("$tmpdir/test2.dat");
27728
27729  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.txt");
27730  if (open(my $fh, "> $batch_file")) {
27731    print $fh "get -P $src_file $dst_file\n";
27732
27733    unless (close($fh)) {
27734      die("Can't write $batch_file: $!");
27735    }
27736
27737  } else {
27738    die("Can't open $batch_file: $!");
27739  }
27740
27741  my $config = {
27742    PidFile => $pid_file,
27743    ScoreboardFile => $scoreboard_file,
27744    SystemLog => $log_file,
27745    TraceLog => $log_file,
27746    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
27747
27748    AuthUserFile => $auth_user_file,
27749    AuthGroupFile => $auth_group_file,
27750
27751    IfModules => {
27752      'mod_delay.c' => {
27753        DelayEngine => 'off',
27754      },
27755
27756      'mod_sftp.c' => [
27757        "SFTPEngine on",
27758        "SFTPLog $log_file",
27759        "SFTPHostKey $rsa_host_key",
27760        "SFTPHostKey $dsa_host_key",
27761        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
27762
27763        "SFTPCiphers aes256-ctr aes192-ctr aes128-ctr",
27764        "SFTPDigests hmac-sha1 hmac-ripemd160",
27765
27766        # Bug#3551 requires that mod_sftp support compression, and that
27767        # the client use compression for the uploads.
27768        "SFTPCompression delayed",
27769      ],
27770    },
27771  };
27772
27773  my ($port, $config_user, $config_group) = config_write($config_file, $config);
27774
27775  # Open pipes, for use between the parent and child processes.  Specifically,
27776  # the child will indicate when it's done with its test by writing a message
27777  # to the parent.
27778  my ($rfh, $wfh);
27779  unless (pipe($rfh, $wfh)) {
27780    die("Can't open pipe: $!");
27781  }
27782
27783  require Net::SSH2;
27784
27785  my $ex;
27786
27787  # Ignore SIGPIPE
27788  local $SIG{PIPE} = sub { };
27789
27790  # Fork child
27791  $self->handle_sigchld();
27792  defined(my $pid = fork()) or die("Can't fork: $!");
27793  if ($pid) {
27794    eval {
27795      my @cmd = (
27796        'sftp',
27797        '-oBatchMode=yes',
27798        '-oCheckHostIP=no',
27799        '-oCompression=yes',
27800        "-oPort=$port",
27801        "-oIdentityFile=$rsa_priv_key",
27802        '-oPubkeyAuthentication=yes',
27803        '-oStrictHostKeyChecking=no',
27804        '-vvv',
27805        '-b',
27806        "$batch_file",
27807        "$user\@127.0.0.1",
27808      );
27809
27810      my $sftp_rh = IO::Handle->new();
27811      my $sftp_wh = IO::Handle->new();
27812      my $sftp_eh = IO::Handle->new();
27813
27814      $sftp_wh->autoflush(1);
27815
27816      sleep(1);
27817
27818      local $SIG{CHLD} = 'DEFAULT';
27819
27820      # Make sure that the perms on the priv key are what OpenSSH wants
27821      unless (chmod(0400, $rsa_priv_key)) {
27822        die("Can't set perms on $rsa_priv_key to 0400: $!");
27823      }
27824
27825      if ($ENV{TEST_VERBOSE}) {
27826        print STDERR "Executing: ", join(' ', @cmd), "\n";
27827      }
27828
27829      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
27830      waitpid($sftp_pid, 0);
27831      my $exit_status = $?;
27832
27833      # Restore the perms on the priv key
27834      unless (chmod(0644, $rsa_priv_key)) {
27835        die("Can't set perms on $rsa_priv_key to 0644: $!");
27836      }
27837
27838      my ($res, $errstr);
27839      if ($exit_status >> 8 == 0) {
27840        $errstr = join('', <$sftp_eh>);
27841        $res = 0;
27842
27843      } else {
27844        $errstr = join('', <$sftp_eh>);
27845        if ($ENV{TEST_VERBOSE}) {
27846          print STDERR "Stderr: $errstr\n";
27847        }
27848
27849        $res = 1;
27850      }
27851
27852      unless ($res == 0) {
27853        die("Can't download $src_file from server: $errstr");
27854      }
27855
27856      unless (-f $dst_file) {
27857        die("File '$dst_file' does not exist as expected");
27858      }
27859
27860      $ctx->reset();
27861      my $md5;
27862
27863      if (open(my $fh, "< $dst_file")) {
27864        binmode($fh);
27865        $ctx->addfile($fh);
27866        $md5 = $ctx->hexdigest();
27867        close($fh);
27868
27869      } else {
27870        die("Can't read $dst_file: $!");
27871      }
27872
27873      my $sz = (stat($dst_file))[7];
27874
27875      $self->assert($expected_sz == $sz,
27876        test_msg("Expected $expected_sz, got $sz"));
27877
27878      $self->assert($expected_md5 eq $md5,
27879        test_msg("Expected '$expected_md5', got '$md5'"));
27880    };
27881
27882    if ($@) {
27883      $ex = $@;
27884    }
27885
27886    $wfh->print("done\n");
27887    $wfh->flush();
27888
27889  } else {
27890    eval { server_wait($config_file, $rfh) };
27891    if ($@) {
27892      warn($@);
27893      exit 1;
27894    }
27895
27896    exit 0;
27897  }
27898
27899  # Stop server
27900  server_stop($pid_file);
27901
27902  $self->assert_child_ok($pid);
27903
27904  if ($ex) {
27905    test_append_logfile($log_file, $ex);
27906    unlink($log_file);
27907
27908    die($ex);
27909  }
27910
27911  unlink($log_file);
27912}
27913
27914sub sftp_ext_download_server_rekey {
27915  my $self = shift;
27916  my $tmpdir = $self->{tmpdir};
27917
27918  my $config_file = "$tmpdir/sftp.conf";
27919  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
27920  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
27921
27922  my $log_file = test_get_logfile();
27923
27924  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
27925  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
27926
27927  my $user = 'proftpd';
27928  my $passwd = 'test';
27929  my $group = 'ftpd';
27930  my $home_dir = File::Spec->rel2abs($tmpdir);
27931  my $uid = 500;
27932  my $gid = 500;
27933
27934  # Make sure that, if we're running as root, that the home directory has
27935  # permissions/privs set for the account we create
27936  if ($< == 0) {
27937    unless (chmod(0755, $home_dir)) {
27938      die("Can't set perms on $home_dir to 0755: $!");
27939    }
27940
27941    unless (chown($uid, $gid, $home_dir)) {
27942      die("Can't set owner of $home_dir to $uid/$gid: $!");
27943    }
27944  }
27945
27946  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
27947    '/bin/bash');
27948  auth_group_write($auth_group_file, $group, $gid, $user);
27949
27950  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
27951  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
27952
27953  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
27954  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
27955  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
27956
27957  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
27958  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
27959    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
27960  }
27961
27962  my $orig_file = File::Spec->rel2abs('t/etc/modules/mod_sftp/bug3550.php');
27963
27964  # Calculate the MD5 checksum of this file, for comparison with the downloaded
27965  # file.
27966  my $ctx = Digest::MD5->new();
27967  my $expected_md5;
27968
27969  if (open(my $fh, "< $orig_file")) {
27970    binmode($fh);
27971    $ctx->addfile($fh);
27972    $expected_md5 = $ctx->hexdigest();
27973    close($fh);
27974
27975  } else {
27976    die("Can't read $orig_file: $!");
27977  }
27978
27979  my $expected_sz = (stat($orig_file))[7];
27980
27981  my $src_file = File::Spec->rel2abs("$tmpdir/test.dat");
27982  unless (copy($orig_file, $src_file)) {
27983    die("Can't copy $orig_file to $src_file: $!");
27984  }
27985
27986  my $dst_file = File::Spec->rel2abs("$tmpdir/test2.dat");
27987
27988  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.txt");
27989  if (open(my $fh, "> $batch_file")) {
27990    print $fh "get -P $src_file $dst_file\n";
27991
27992    unless (close($fh)) {
27993      die("Can't write $batch_file: $!");
27994    }
27995
27996  } else {
27997    die("Can't open $batch_file: $!");
27998  }
27999
28000  my $timeout_idle = 10;
28001
28002  my $config = {
28003    PidFile => $pid_file,
28004    ScoreboardFile => $scoreboard_file,
28005    SystemLog => $log_file,
28006    TraceLog => $log_file,
28007    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
28008
28009    AuthUserFile => $auth_user_file,
28010    AuthGroupFile => $auth_group_file,
28011
28012    TimeoutIdle => $timeout_idle,
28013
28014    IfModules => {
28015      'mod_delay.c' => {
28016        DelayEngine => 'off',
28017      },
28018
28019      'mod_sftp.c' => [
28020        "SFTPEngine on",
28021        "SFTPLog $log_file",
28022        "SFTPHostKey $rsa_host_key",
28023        "SFTPHostKey $dsa_host_key",
28024        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
28025        "SFTPRekey required 600 256 10",
28026      ],
28027    },
28028  };
28029
28030  my ($port, $config_user, $config_group) = config_write($config_file, $config);
28031
28032  # Open pipes, for use between the parent and child processes.  Specifically,
28033  # the child will indicate when it's done with its test by writing a message
28034  # to the parent.
28035  my ($rfh, $wfh);
28036  unless (pipe($rfh, $wfh)) {
28037    die("Can't open pipe: $!");
28038  }
28039
28040  require Net::SSH2;
28041
28042  my $ex;
28043
28044  # Ignore SIGPIPE
28045  local $SIG{PIPE} = sub { };
28046
28047  # Fork child
28048  $self->handle_sigchld();
28049  defined(my $pid = fork()) or die("Can't fork: $!");
28050  if ($pid) {
28051    eval {
28052      my @cmd = (
28053        'sftp',
28054        '-oBatchMode=yes',
28055        '-oCheckHostIP=no',
28056#        '-oRekeyLimit=1024',
28057        "-oPort=$port",
28058        "-oIdentityFile=$rsa_priv_key",
28059        '-oPubkeyAuthentication=yes',
28060        '-oStrictHostKeyChecking=no',
28061        '-vvv',
28062        '-b',
28063        "$batch_file",
28064        "$user\@127.0.0.1",
28065      );
28066
28067      my $sftp_rh = IO::Handle->new();
28068      my $sftp_wh = IO::Handle->new();
28069      my $sftp_eh = IO::Handle->new();
28070
28071      $sftp_wh->autoflush(1);
28072
28073      sleep(1);
28074
28075      local $SIG{CHLD} = 'DEFAULT';
28076
28077      # Make sure that the perms on the priv key are what OpenSSH wants
28078      unless (chmod(0400, $rsa_priv_key)) {
28079        die("Can't set perms on $rsa_priv_key to 0400: $!");
28080      }
28081
28082      if ($ENV{TEST_VERBOSE}) {
28083        print STDERR "Executing: ", join(' ', @cmd), "\n";
28084      }
28085
28086      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
28087      waitpid($sftp_pid, 0);
28088      my $exit_status = $?;
28089
28090      # Restore the perms on the priv key
28091      unless (chmod(0644, $rsa_priv_key)) {
28092        die("Can't set perms on $rsa_priv_key to 0644: $!");
28093      }
28094
28095      my ($res, $errstr);
28096      if ($exit_status >> 8 == 0) {
28097        $errstr = join('', <$sftp_eh>);
28098        $res = 0;
28099
28100      } else {
28101        $errstr = join('', <$sftp_eh>);
28102        if ($ENV{TEST_VERBOSE}) {
28103          print STDERR "Stderr: $errstr\n";
28104        }
28105
28106        $res = 1;
28107      }
28108
28109      unless ($res == 0) {
28110        die("Can't download $src_file from server: $errstr");
28111      }
28112
28113      unless (-f $dst_file) {
28114        die("File '$dst_file' does not exist as expected");
28115      }
28116
28117      $ctx->reset();
28118      my $md5;
28119
28120      if (open(my $fh, "< $dst_file")) {
28121        binmode($fh);
28122        $ctx->addfile($fh);
28123        $md5 = $ctx->hexdigest();
28124        close($fh);
28125
28126      } else {
28127        die("Can't read $dst_file: $!");
28128      }
28129
28130      my $sz = (stat($dst_file))[7];
28131
28132      $self->assert($expected_sz == $sz,
28133        test_msg("Expected $expected_sz, got $sz"));
28134
28135      $self->assert($expected_md5 eq $md5,
28136        test_msg("Expected '$expected_md5', got '$md5'"));
28137    };
28138
28139    if ($@) {
28140      $ex = $@;
28141    }
28142
28143    $wfh->print("done\n");
28144    $wfh->flush();
28145
28146  } else {
28147    eval { server_wait($config_file, $rfh) };
28148    if ($@) {
28149      warn($@);
28150      exit 1;
28151    }
28152
28153    exit 0;
28154  }
28155
28156  # Stop server
28157  server_stop($pid_file);
28158
28159  $self->assert_child_ok($pid);
28160
28161  if ($ex) {
28162    test_append_logfile($log_file, $ex);
28163    unlink($log_file);
28164
28165    die($ex);
28166  }
28167
28168  unlink($log_file);
28169}
28170
28171sub sftp_ext_download_rekey_rsa1024_hostkey_bug4097 {
28172  my $self = shift;
28173  my $tmpdir = $self->{tmpdir};
28174  my $setup = test_setup($tmpdir, 'sftp');
28175
28176  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa1024_key');
28177
28178  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
28179  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
28180  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
28181
28182  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
28183  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
28184    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
28185  }
28186
28187  my $orig_file = File::Spec->rel2abs('t/etc/modules/mod_sftp/bug3550.php');
28188
28189  # Calculate the MD5 checksum of this file, for comparison with the downloaded
28190  # file.
28191  my $ctx = Digest::MD5->new();
28192  my $expected_md5;
28193
28194  if (open(my $fh, "< $orig_file")) {
28195    binmode($fh);
28196    $ctx->addfile($fh);
28197    $expected_md5 = $ctx->hexdigest();
28198    close($fh);
28199
28200  } else {
28201    die("Can't read $orig_file: $!");
28202  }
28203
28204  my $expected_sz = (stat($orig_file))[7];
28205
28206  my $src_file = File::Spec->rel2abs("$tmpdir/test.dat");
28207  unless (copy($orig_file, $src_file)) {
28208    die("Can't copy $orig_file to $src_file: $!");
28209  }
28210
28211  my $dst_file = File::Spec->rel2abs("$tmpdir/test2.dat");
28212
28213  my $batch_file = File::Spec->rel2abs("$tmpdir/sftp-batch.txt");
28214  if (open(my $fh, "> $batch_file")) {
28215    print $fh "get -P $src_file $dst_file\n";
28216
28217    unless (close($fh)) {
28218      die("Can't write $batch_file: $!");
28219    }
28220
28221  } else {
28222    die("Can't open $batch_file: $!");
28223  }
28224
28225  my $timeout_idle = 10;
28226
28227  my $config = {
28228    PidFile => $setup->{pid_file},
28229    ScoreboardFile => $setup->{scoreboard_file},
28230    SystemLog => $setup->{log_file},
28231    TraceLog => $setup->{log_file},
28232    Trace => 'ssh2:20 sftp:20',
28233
28234    AuthUserFile => $setup->{auth_user_file},
28235    AuthGroupFile => $setup->{auth_group_file},
28236
28237    TimeoutIdle => $timeout_idle,
28238
28239    IfModules => {
28240      'mod_delay.c' => {
28241        DelayEngine => 'off',
28242      },
28243
28244      'mod_sftp.c' => [
28245        "SFTPEngine on",
28246        "SFTPLog $setup->{log_file}",
28247        "SFTPHostKey $rsa_host_key",
28248        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
28249        "SFTPRekey required 600 256 10",
28250      ],
28251    },
28252  };
28253
28254  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
28255    $config);
28256
28257  # Open pipes, for use between the parent and child processes.  Specifically,
28258  # the child will indicate when it's done with its test by writing a message
28259  # to the parent.
28260  my ($rfh, $wfh);
28261  unless (pipe($rfh, $wfh)) {
28262    die("Can't open pipe: $!");
28263  }
28264
28265  require Net::SSH2;
28266
28267  my $ex;
28268
28269  # Ignore SIGPIPE
28270  local $SIG{PIPE} = sub { };
28271
28272  # Fork child
28273  $self->handle_sigchld();
28274  defined(my $pid = fork()) or die("Can't fork: $!");
28275  if ($pid) {
28276    sleep(1);
28277
28278    eval {
28279      my @cmd = (
28280        'sftp',
28281        '-oBatchMode=yes',
28282        '-oCheckHostIP=no',
28283#        '-oRekeyLimit=256',
28284        "-oPort=$port",
28285        "-oIdentityFile=$rsa_priv_key",
28286        '-oPubkeyAuthentication=yes',
28287        '-oStrictHostKeyChecking=no',
28288        '-vvv',
28289        '-b',
28290        "$batch_file",
28291        "$setup->{user}\@127.0.0.1",
28292      );
28293
28294      my $sftp_rh = IO::Handle->new();
28295      my $sftp_wh = IO::Handle->new();
28296      my $sftp_eh = IO::Handle->new();
28297
28298      $sftp_wh->autoflush(1);
28299
28300      sleep(1);
28301
28302      local $SIG{CHLD} = 'DEFAULT';
28303
28304      # Make sure that the perms on the priv key are what OpenSSH wants
28305      unless (chmod(0400, $rsa_priv_key)) {
28306        die("Can't set perms on $rsa_priv_key to 0400: $!");
28307      }
28308
28309      if ($ENV{TEST_VERBOSE}) {
28310        print STDERR "Executing: ", join(' ', @cmd), "\n";
28311      }
28312
28313      my $sftp_pid = open3($sftp_wh, $sftp_rh, $sftp_eh, @cmd);
28314      waitpid($sftp_pid, 0);
28315      my $exit_status = $?;
28316
28317      # Restore the perms on the priv key
28318      unless (chmod(0644, $rsa_priv_key)) {
28319        die("Can't set perms on $rsa_priv_key to 0644: $!");
28320      }
28321
28322      my ($res, $errstr);
28323      if ($exit_status >> 8 == 0) {
28324        $errstr = join('', <$sftp_eh>);
28325        $res = 0;
28326
28327      } else {
28328        if ($ENV{TEST_VERBOSE}) {
28329          $errstr = join('', <$sftp_eh>);
28330          print STDERR "Stderr: $errstr\n";
28331        }
28332
28333        $res = 1;
28334      }
28335
28336      unless ($res == 0) {
28337        die("Can't download $src_file from server: $errstr");
28338      }
28339
28340      unless (-f $dst_file) {
28341        die("File '$dst_file' does not exist as expected");
28342      }
28343
28344      $ctx->reset();
28345      my $md5;
28346
28347      if (open(my $fh, "< $dst_file")) {
28348        binmode($fh);
28349        $ctx->addfile($fh);
28350        $md5 = $ctx->hexdigest();
28351        close($fh);
28352
28353      } else {
28354        die("Can't read $dst_file: $!");
28355      }
28356
28357      my $sz = (stat($dst_file))[7];
28358
28359      $self->assert($expected_sz == $sz,
28360        test_msg("Expected size $expected_sz, got $sz"));
28361
28362      $self->assert($expected_md5 eq $md5,
28363        test_msg("Expected MD5 '$expected_md5', got '$md5'"));
28364    };
28365
28366    if ($@) {
28367      $ex = $@;
28368    }
28369
28370    $wfh->print("done\n");
28371    $wfh->flush();
28372
28373  } else {
28374    eval { server_wait($setup->{config_file}, $rfh) };
28375    if ($@) {
28376      warn($@);
28377      exit 1;
28378    }
28379
28380    exit 0;
28381  }
28382
28383  # Stop server
28384  server_stop($setup->{pid_file});
28385
28386  $self->assert_child_ok($pid);
28387
28388  test_cleanup($setup->{log_file}, $ex);
28389}
28390
28391sub sftp_download_server_rekey {
28392  my $self = shift;
28393  my $tmpdir = $self->{tmpdir};
28394  my $setup = test_setup($tmpdir, 'sftp');
28395
28396  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
28397  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
28398
28399  # Calculate the MD5 checksum of this file, for comparison with the downloaded
28400  # file.
28401  my $ctx = Digest::MD5->new();
28402  my $expected_md5;
28403
28404  my $src_file = File::Spec->rel2abs("$tmpdir/test.dat");
28405  if (open(my $fh, "> $src_file")) {
28406    my $max = 100;
28407    for (my $i = 0; $i < $max; $i++) {
28408      my $chunk = 'AbCdEfGh' x 16382;
28409      print $fh $chunk;
28410      $ctx->add($chunk);
28411    }
28412
28413    unless (close($fh)) {
28414      die("Can't write $src_file: $!");
28415    }
28416
28417  } else {
28418    die("Can't open $src_file: $!");
28419  }
28420
28421  $expected_md5 = $ctx->hexdigest();
28422  my $expected_sz = (stat($src_file))[7];
28423
28424  my $timeout_idle = 10;
28425
28426  my $config = {
28427    PidFile => $setup->{pid_file},
28428    ScoreboardFile => $setup->{scoreboard_file},
28429    SystemLog => $setup->{log_file},
28430    TraceLog => $setup->{log_file},
28431    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
28432
28433    AuthUserFile => $setup->{auth_user_file},
28434    AuthGroupFile => $setup->{auth_group_file},
28435
28436    TimeoutIdle => $timeout_idle,
28437
28438    IfModules => {
28439      'mod_delay.c' => {
28440        DelayEngine => 'off',
28441      },
28442
28443      'mod_sftp.c' => [
28444        "SFTPEngine on",
28445        "SFTPLog $setup->{log_file}",
28446        "SFTPHostKey $rsa_host_key",
28447        "SFTPHostKey $dsa_host_key",
28448        "SFTPRekey required 5 1",
28449      ],
28450    },
28451  };
28452
28453  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
28454    $config);
28455
28456  # Open pipes, for use between the parent and child processes.  Specifically,
28457  # the child will indicate when it's done with its test by writing a message
28458  # to the parent.
28459  my ($rfh, $wfh);
28460  unless (pipe($rfh, $wfh)) {
28461    die("Can't open pipe: $!");
28462  }
28463
28464  require Net::SSH2;
28465
28466  my $ex;
28467
28468  # Ignore SIGPIPE
28469  local $SIG{PIPE} = sub { };
28470
28471  # Fork child
28472  $self->handle_sigchld();
28473  defined(my $pid = fork()) or die("Can't fork: $!");
28474  if ($pid) {
28475    eval {
28476      sleep(1);
28477
28478      my $ssh2 = Net::SSH2->new();
28479      unless ($ssh2->connect('127.0.0.1', $port)) {
28480        my ($err_code, $err_name, $err_str) = $ssh2->error();
28481        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
28482      }
28483
28484      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
28485        my ($err_code, $err_name, $err_str) = $ssh2->error();
28486        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
28487      }
28488
28489      my $sftp = $ssh2->sftp();
28490      unless ($sftp) {
28491        my ($err_code, $err_name, $err_str) = $ssh2->error();
28492        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
28493      }
28494
28495      my $fh = $sftp->open('test.dat', O_RDONLY);
28496      unless ($fh) {
28497        my ($err_code, $err_name) = $sftp->error();
28498        die("Can't open test.dat: [$err_name] ($err_code)");
28499      }
28500
28501      $ctx->reset();
28502      my $buf = '';
28503      my $size = 0;
28504      my $md5;
28505
28506      my $res = $fh->read($buf, 8192);
28507      while ($res) {
28508        $size += $res;
28509        $ctx->add($buf);
28510
28511        $buf = '';
28512        $res = $fh->read($buf, 8192);
28513      }
28514
28515      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
28516      $fh = undef;
28517
28518      # To close the SFTP channel, we have to explicitly destroy the object
28519      $sftp = undef;
28520
28521      $ssh2->disconnect();
28522
28523      $self->assert($expected_sz == $size,
28524        test_msg("Expected $expected_sz, got $size"));
28525
28526      $md5 = $ctx->hexdigest();
28527      $self->assert($expected_md5 eq $md5,
28528        test_msg("Expected '$expected_md5', got '$md5'"));
28529    };
28530
28531    if ($@) {
28532      $ex = $@;
28533    }
28534
28535    $wfh->print("done\n");
28536    $wfh->flush();
28537
28538  } else {
28539    eval { server_wait($setup->{config_file}, $rfh, 30) };
28540    if ($@) {
28541      warn($@);
28542      exit 1;
28543    }
28544
28545    exit 0;
28546  }
28547
28548  # Stop server
28549  server_stop($setup->{pid_file});
28550  $self->assert_child_ok($pid);
28551
28552  test_cleanup($setup->{log_file}, $ex);
28553}
28554
28555sub sftp_download_readonly_bug3787 {
28556  my $self = shift;
28557  my $tmpdir = $self->{tmpdir};
28558
28559  my $config_file = "$tmpdir/sftp.conf";
28560  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
28561  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
28562
28563  my $log_file = test_get_logfile();
28564
28565  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
28566  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
28567
28568  my $user = 'proftpd';
28569  my $passwd = 'test';
28570  my $group = 'ftpd';
28571  my $home_dir = File::Spec->rel2abs($tmpdir);
28572  my $uid = 500;
28573  my $gid = 500;
28574
28575  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
28576  if (open(my $fh, "> $test_file")) {
28577    print $fh "ABCD" x 8192;
28578
28579    unless (close($fh)) {
28580      die("Can't write $test_file: $!");
28581    }
28582
28583  } else {
28584    die("Can't open $test_file: $!");
28585  }
28586
28587  # Make sure that, if we're running as root, that the home directory has
28588  # permissions/privs set for the account we create
28589  if ($< == 0) {
28590    unless (chmod(0755, $home_dir)) {
28591      die("Can't set perms on $home_dir to 0755: $!");
28592    }
28593
28594    unless (chown($uid, $gid, $home_dir, $test_file)) {
28595      die("Can't set owner of $home_dir to $uid/$gid: $!");
28596    }
28597  }
28598
28599  my $test_mode = (stat($test_file))[2];
28600
28601  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
28602    '/bin/bash');
28603  auth_group_write($auth_group_file, $group, $gid, $user);
28604
28605  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
28606  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
28607
28608  my $config = {
28609    PidFile => $pid_file,
28610    ScoreboardFile => $scoreboard_file,
28611    SystemLog => $log_file,
28612    TraceLog => $log_file,
28613    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
28614
28615    AuthUserFile => $auth_user_file,
28616    AuthGroupFile => $auth_group_file,
28617
28618    IfModules => {
28619      'mod_delay.c' => {
28620        DelayEngine => 'off',
28621      },
28622
28623      'mod_sftp.c' => [
28624        "SFTPEngine on",
28625        "SFTPLog $log_file",
28626        "SFTPHostKey $rsa_host_key",
28627        "SFTPHostKey $dsa_host_key",
28628      ],
28629    },
28630  };
28631
28632  my ($port, $config_user, $config_group) = config_write($config_file, $config);
28633
28634  # Open pipes, for use between the parent and child processes.  Specifically,
28635  # the child will indicate when it's done with its test by writing a message
28636  # to the parent.
28637  my ($rfh, $wfh);
28638  unless (pipe($rfh, $wfh)) {
28639    die("Can't open pipe: $!");
28640  }
28641
28642  require Net::SSH2;
28643
28644  my $ex;
28645
28646  # Ignore SIGPIPE
28647  local $SIG{PIPE} = sub { };
28648
28649  # Fork child
28650  $self->handle_sigchld();
28651  defined(my $pid = fork()) or die("Can't fork: $!");
28652  if ($pid) {
28653    eval {
28654      my $ssh2 = Net::SSH2->new();
28655
28656      sleep(1);
28657
28658      unless ($ssh2->connect('127.0.0.1', $port)) {
28659        my ($err_code, $err_name, $err_str) = $ssh2->error();
28660        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
28661      }
28662
28663      unless ($ssh2->auth_password($user, $passwd)) {
28664        my ($err_code, $err_name, $err_str) = $ssh2->error();
28665        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
28666      }
28667
28668      my $sftp = $ssh2->sftp();
28669      unless ($sftp) {
28670        my ($err_code, $err_name, $err_str) = $ssh2->error();
28671        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
28672      }
28673
28674      my $fh = $sftp->open('test.txt', O_RDONLY, 0);
28675      unless ($fh) {
28676        my ($err_code, $err_name) = $sftp->error();
28677        die("Can't open test.txt: [$err_name] ($err_code)");
28678      }
28679
28680      my $buf;
28681
28682      my $res = $fh->read($buf, 8192);
28683      while ($res) {
28684        $res = $fh->read($buf, 8192);
28685      }
28686
28687      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
28688      $fh = undef;
28689
28690      # To close the SFTP channel, we have to explicitly destroy the object
28691      $sftp = undef;
28692
28693      my $mode = (stat($test_file))[2];
28694      $self->assert($mode == $test_mode,
28695        test_msg("Expected mode $test_mode, got $mode"));
28696
28697      $ssh2->disconnect();
28698    };
28699
28700    if ($@) {
28701      $ex = $@;
28702    }
28703
28704    $wfh->print("done\n");
28705    $wfh->flush();
28706
28707  } else {
28708    eval { server_wait($config_file, $rfh) };
28709    if ($@) {
28710      warn($@);
28711      exit 1;
28712    }
28713
28714    exit 0;
28715  }
28716
28717  # Stop server
28718  server_stop($pid_file);
28719
28720  $self->assert_child_ok($pid);
28721
28722  if ($ex) {
28723    test_append_logfile($log_file, $ex);
28724    unlink($log_file);
28725
28726    die($ex);
28727  }
28728
28729  unlink($log_file);
28730}
28731
28732sub sftp_readdir {
28733  my $self = shift;
28734  my $tmpdir = $self->{tmpdir};
28735
28736  my $config_file = "$tmpdir/sftp.conf";
28737  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
28738  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
28739
28740  my $log_file = test_get_logfile();
28741
28742  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
28743  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
28744
28745  my $user = 'proftpd';
28746  my $passwd = 'test';
28747  my $group = 'ftpd';
28748  my $home_dir = File::Spec->rel2abs($tmpdir);
28749  my $uid = 500;
28750  my $gid = 500;
28751
28752  # Make sure that, if we're running as root, that the home directory has
28753  # permissions/privs set for the account we create
28754  if ($< == 0) {
28755    unless (chmod(0755, $home_dir)) {
28756      die("Can't set perms on $home_dir to 0755: $!");
28757    }
28758
28759    unless (chown($uid, $gid, $home_dir)) {
28760      die("Can't set owner of $home_dir to $uid/$gid: $!");
28761    }
28762  }
28763
28764  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
28765    '/bin/bash');
28766  auth_group_write($auth_group_file, $group, $gid, $user);
28767
28768  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
28769  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
28770
28771  my $config = {
28772    PidFile => $pid_file,
28773    ScoreboardFile => $scoreboard_file,
28774    SystemLog => $log_file,
28775    TraceLog => $log_file,
28776    Trace => 'auth:10 ssh2:20 sftp:20 scp:20',
28777
28778    AuthUserFile => $auth_user_file,
28779    AuthGroupFile => $auth_group_file,
28780
28781    IfModules => {
28782      'mod_delay.c' => {
28783        DelayEngine => 'off',
28784      },
28785
28786      'mod_sftp.c' => [
28787        "SFTPEngine on",
28788        "SFTPLog $log_file",
28789        "SFTPHostKey $rsa_host_key",
28790        "SFTPHostKey $dsa_host_key",
28791      ],
28792    },
28793  };
28794
28795  my ($port, $config_user, $config_group) = config_write($config_file, $config);
28796
28797  # Open pipes, for use between the parent and child processes.  Specifically,
28798  # the child will indicate when it's done with its test by writing a message
28799  # to the parent.
28800  my ($rfh, $wfh);
28801  unless (pipe($rfh, $wfh)) {
28802    die("Can't open pipe: $!");
28803  }
28804
28805  require Net::SSH2;
28806
28807  my $ex;
28808
28809  # Fork child
28810  $self->handle_sigchld();
28811  defined(my $pid = fork()) or die("Can't fork: $!");
28812  if ($pid) {
28813    eval {
28814      my $ssh2 = Net::SSH2->new();
28815
28816      sleep(1);
28817
28818      unless ($ssh2->connect('127.0.0.1', $port)) {
28819        my ($err_code, $err_name, $err_str) = $ssh2->error();
28820        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
28821      }
28822
28823      unless ($ssh2->auth_password($user, $passwd)) {
28824        my ($err_code, $err_name, $err_str) = $ssh2->error();
28825        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
28826      }
28827
28828      my $sftp = $ssh2->sftp();
28829      unless ($sftp) {
28830        my ($err_code, $err_name, $err_str) = $ssh2->error();
28831        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
28832      }
28833
28834      my $dir = $sftp->opendir('.');
28835      unless ($dir) {
28836        my ($err_code, $err_name) = $sftp->error();
28837        die("Can't open directory '.': [$err_name] ($err_code)");
28838      }
28839
28840      my $res = {};
28841
28842      my $file = $dir->read();
28843      while ($file) {
28844        $res->{$file->{name}} = $file;
28845        $file = $dir->read();
28846      }
28847
28848      my $expected = {
28849        '.' => 1,
28850        '..' => 1,
28851        'sftp.conf' => 1,
28852        'sftp.group' => 1,
28853        'sftp.passwd' => 1,
28854        'sftp.pid' => 1,
28855        'sftp.scoreboard' => 1,
28856        'sftp.scoreboard.lck' => 1,
28857      };
28858
28859      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
28860      $dir = undef;
28861
28862      # To close the SFTP channel, we have to explicitly destroy the object
28863      $sftp = undef;
28864
28865      $ssh2->disconnect();
28866
28867      my $ok = 1;
28868      my $mismatch;
28869
28870      my $seen = [];
28871      foreach my $name (keys(%$res)) {
28872        push(@$seen, $name);
28873
28874        unless (defined($expected->{$name})) {
28875          $mismatch = $name;
28876          $ok = 0;
28877          last;
28878        }
28879      }
28880
28881      unless ($ok) {
28882        die("Unexpected name '$mismatch' appeared in READDIR data")
28883      }
28884
28885      # Now remove from $expected all of the paths we saw; if there are
28886      # any entries remaining in $expected, something went wrong.
28887      foreach my $name (@$seen) {
28888        delete($expected->{$name});
28889      }
28890
28891      my $remaining = scalar(keys(%$expected));
28892      $self->assert(0 == $remaining,
28893        test_msg("Expected 0, got $remaining"));
28894    };
28895
28896    if ($@) {
28897      $ex = $@;
28898    }
28899
28900    $wfh->print("done\n");
28901    $wfh->flush();
28902
28903  } else {
28904    eval { server_wait($config_file, $rfh) };
28905    if ($@) {
28906      warn($@);
28907      exit 1;
28908    }
28909
28910    exit 0;
28911  }
28912
28913  # Stop server
28914  server_stop($pid_file);
28915
28916  $self->assert_child_ok($pid);
28917
28918  if ($ex) {
28919    test_append_logfile($log_file, $ex);
28920    unlink($log_file);
28921
28922    die($ex);
28923  }
28924
28925  unlink($log_file);
28926}
28927
28928sub sftp_readdir_abs_symlink_dir {
28929  my $self = shift;
28930  my $tmpdir = $self->{tmpdir};
28931  my $setup = test_setup($tmpdir, 'sftp');
28932
28933  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
28934  mkpath($test_dir);
28935
28936  my $sub_dir = File::Spec->rel2abs("$test_dir/sub.d");
28937  mkpath($sub_dir);
28938
28939  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
28940
28941  my $dst_path = $sub_dir;
28942  if ($^O eq 'darwin') {
28943    # MacOSX-specific hack
28944    $dst_path = '/private' . $dst_path;
28945  }
28946
28947  unless (symlink($dst_path, $test_symlink)) {
28948    die("Can't symlink $test_symlink to $dst_path: $!");
28949  }
28950
28951  if ($< == 0) {
28952    unless (chmod(0755, $test_dir, $sub_dir)) {
28953      die("Can't set perms on $test_dir to 0755: $!");
28954    }
28955
28956    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $sub_dir)) {
28957      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
28958    }
28959  }
28960
28961  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
28962  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
28963
28964  my $config = {
28965    PidFile => $setup->{pid_file},
28966    ScoreboardFile => $setup->{scoreboard_file},
28967    SystemLog => $setup->{log_file},
28968    TraceLog => $setup->{log_file},
28969    Trace => 'auth:10 fsio:10 ssh2:20 sftp:20 scp:20',
28970
28971    AuthUserFile => $setup->{auth_user_file},
28972    AuthGroupFile => $setup->{auth_group_file},
28973
28974    IfModules => {
28975      'mod_delay.c' => {
28976        DelayEngine => 'off',
28977      },
28978
28979      'mod_sftp.c' => [
28980        "SFTPEngine on",
28981        "SFTPLog $setup->{log_file}",
28982        "SFTPHostKey $rsa_host_key",
28983        "SFTPHostKey $dsa_host_key",
28984      ],
28985    },
28986  };
28987
28988  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
28989    $config);
28990
28991  # Open pipes, for use between the parent and child processes.  Specifically,
28992  # the child will indicate when it's done with its test by writing a message
28993  # to the parent.
28994  my ($rfh, $wfh);
28995  unless (pipe($rfh, $wfh)) {
28996    die("Can't open pipe: $!");
28997  }
28998
28999  require Net::SSH2;
29000
29001  my $ex;
29002
29003  # Fork child
29004  $self->handle_sigchld();
29005  defined(my $pid = fork()) or die("Can't fork: $!");
29006  if ($pid) {
29007    eval {
29008      my $ssh2 = Net::SSH2->new();
29009
29010      sleep(1);
29011
29012      unless ($ssh2->connect('127.0.0.1', $port)) {
29013        my ($err_code, $err_name, $err_str) = $ssh2->error();
29014        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
29015      }
29016
29017      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
29018        my ($err_code, $err_name, $err_str) = $ssh2->error();
29019        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
29020      }
29021
29022      my $sftp = $ssh2->sftp();
29023      unless ($sftp) {
29024        my ($err_code, $err_name, $err_str) = $ssh2->error();
29025        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
29026      }
29027
29028      my $path = 'test.d/test.lnk';
29029      my $dir = $sftp->opendir($path);
29030      unless ($dir) {
29031        my ($err_code, $err_name) = $sftp->error();
29032        die("Can't open directory '$path': [$err_name] ($err_code)");
29033      }
29034
29035      my $res = {};
29036
29037      my $file = $dir->read();
29038      while ($file) {
29039        $res->{$file->{name}} = $file;
29040        $file = $dir->read();
29041      }
29042
29043      my $expected = {
29044        '.' => 1,
29045        '..' => 1,
29046      };
29047
29048      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
29049      $dir = undef;
29050
29051      # To close the SFTP channel, we have to explicitly destroy the object
29052      $sftp = undef;
29053
29054      $ssh2->disconnect();
29055
29056      my $ok = 1;
29057      my $mismatch;
29058
29059      my $seen = [];
29060      foreach my $name (keys(%$res)) {
29061        push(@$seen, $name);
29062
29063        unless (defined($expected->{$name})) {
29064          $mismatch = $name;
29065          $ok = 0;
29066          last;
29067        }
29068      }
29069
29070      unless ($ok) {
29071        die("Unexpected name '$mismatch' appeared in READDIR data")
29072      }
29073
29074      # Now remove from $expected all of the paths we saw; if there are
29075      # any entries remaining in $expected, something went wrong.
29076      foreach my $name (@$seen) {
29077        delete($expected->{$name});
29078      }
29079
29080      my $remaining = scalar(keys(%$expected));
29081      $self->assert(0 == $remaining,
29082        test_msg("Expected 0, got $remaining"));
29083    };
29084    if ($@) {
29085      $ex = $@;
29086    }
29087
29088    $wfh->print("done\n");
29089    $wfh->flush();
29090
29091  } else {
29092    eval { server_wait($setup->{config_file}, $rfh) };
29093    if ($@) {
29094      warn($@);
29095      exit 1;
29096    }
29097
29098    exit 0;
29099  }
29100
29101  # Stop server
29102  server_stop($setup->{pid_file});
29103  $self->assert_child_ok($pid);
29104
29105  test_cleanup($setup->{log_file}, $ex);
29106}
29107
29108sub sftp_readdir_abs_symlink_dir_chrooted_bug4219 {
29109  my $self = shift;
29110  my $tmpdir = $self->{tmpdir};
29111  my $setup = test_setup($tmpdir, 'sftp');
29112
29113  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
29114  mkpath($test_dir);
29115
29116  my $sub_dir = File::Spec->rel2abs("$test_dir/sub.d");
29117  mkpath($sub_dir);
29118
29119  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
29120
29121  my $dst_path = $sub_dir;
29122  if ($^O eq 'darwin') {
29123    # MacOSX-specific hack
29124    $dst_path = '/private' . $dst_path;
29125  }
29126
29127  unless (symlink($dst_path, $test_symlink)) {
29128    die("Can't symlink $test_symlink to $dst_path: $!");
29129  }
29130
29131  if ($< == 0) {
29132    unless (chmod(0755, $test_dir, $sub_dir)) {
29133      die("Can't set perms on $test_dir to 0755: $!");
29134    }
29135
29136    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $sub_dir)) {
29137      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
29138    }
29139  }
29140
29141  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
29142  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
29143
29144  my $config = {
29145    PidFile => $setup->{pid_file},
29146    ScoreboardFile => $setup->{scoreboard_file},
29147    SystemLog => $setup->{log_file},
29148    TraceLog => $setup->{log_file},
29149    Trace => 'auth:10 fsio:10 ssh2:20 sftp:20 scp:20',
29150
29151    AuthUserFile => $setup->{auth_user_file},
29152    AuthGroupFile => $setup->{auth_group_file},
29153
29154    DefaultRoot => '~',
29155
29156    IfModules => {
29157      'mod_delay.c' => {
29158        DelayEngine => 'off',
29159      },
29160
29161      'mod_sftp.c' => [
29162        "SFTPEngine on",
29163        "SFTPLog $setup->{log_file}",
29164        "SFTPHostKey $rsa_host_key",
29165        "SFTPHostKey $dsa_host_key",
29166      ],
29167    },
29168  };
29169
29170  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
29171    $config);
29172
29173  # Open pipes, for use between the parent and child processes.  Specifically,
29174  # the child will indicate when it's done with its test by writing a message
29175  # to the parent.
29176  my ($rfh, $wfh);
29177  unless (pipe($rfh, $wfh)) {
29178    die("Can't open pipe: $!");
29179  }
29180
29181  require Net::SSH2;
29182
29183  my $ex;
29184
29185  # Fork child
29186  $self->handle_sigchld();
29187  defined(my $pid = fork()) or die("Can't fork: $!");
29188  if ($pid) {
29189    eval {
29190      my $ssh2 = Net::SSH2->new();
29191
29192      sleep(1);
29193
29194      unless ($ssh2->connect('127.0.0.1', $port)) {
29195        my ($err_code, $err_name, $err_str) = $ssh2->error();
29196        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
29197      }
29198
29199      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
29200        my ($err_code, $err_name, $err_str) = $ssh2->error();
29201        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
29202      }
29203
29204      my $sftp = $ssh2->sftp();
29205      unless ($sftp) {
29206        my ($err_code, $err_name, $err_str) = $ssh2->error();
29207        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
29208      }
29209
29210      my $path = 'test.d/test.lnk';
29211      my $dir = $sftp->opendir($path);
29212      unless ($dir) {
29213        my ($err_code, $err_name) = $sftp->error();
29214        die("Can't open directory '$path': [$err_name] ($err_code)");
29215      }
29216
29217      my $res = {};
29218
29219      my $file = $dir->read();
29220      while ($file) {
29221        $res->{$file->{name}} = $file;
29222        $file = $dir->read();
29223      }
29224
29225      my $expected = {
29226        '.' => 1,
29227        '..' => 1,
29228      };
29229
29230      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
29231      $dir = undef;
29232
29233      # To close the SFTP channel, we have to explicitly destroy the object
29234      $sftp = undef;
29235
29236      $ssh2->disconnect();
29237
29238      my $ok = 1;
29239      my $mismatch;
29240
29241      my $seen = [];
29242      foreach my $name (keys(%$res)) {
29243        push(@$seen, $name);
29244
29245        unless (defined($expected->{$name})) {
29246          $mismatch = $name;
29247          $ok = 0;
29248          last;
29249        }
29250      }
29251
29252      unless ($ok) {
29253        die("Unexpected name '$mismatch' appeared in READDIR data")
29254      }
29255
29256      # Now remove from $expected all of the paths we saw; if there are
29257      # any entries remaining in $expected, something went wrong.
29258      foreach my $name (@$seen) {
29259        delete($expected->{$name});
29260      }
29261
29262      my $remaining = scalar(keys(%$expected));
29263      $self->assert(0 == $remaining,
29264        test_msg("Expected 0, got $remaining"));
29265    };
29266    if ($@) {
29267      $ex = $@;
29268    }
29269
29270    $wfh->print("done\n");
29271    $wfh->flush();
29272
29273  } else {
29274    eval { server_wait($setup->{config_file}, $rfh) };
29275    if ($@) {
29276      warn($@);
29277      exit 1;
29278    }
29279
29280    exit 0;
29281  }
29282
29283  # Stop server
29284  server_stop($setup->{pid_file});
29285  $self->assert_child_ok($pid);
29286
29287  test_cleanup($setup->{log_file}, $ex);
29288}
29289
29290sub sftp_readdir_abs_symlink_dir_vroot {
29291  my $self = shift;
29292  my $tmpdir = $self->{tmpdir};
29293
29294  my $config_file = "$tmpdir/sftp.conf";
29295  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
29296  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
29297
29298  my $log_file = test_get_logfile();
29299
29300  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
29301  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
29302
29303  my $user = 'proftpd';
29304  my $passwd = 'test';
29305  my $group = 'ftpd';
29306  my $uid = 500;
29307  my $gid = 500;
29308
29309  # For this test, we want to create a symlink to a directory which lies
29310  # outside of the user's home dir; we will be using mod_vroot + DefaultRoot
29311  # to "jail" the user into their home directory.
29312
29313  my $home_dir = File::Spec->rel2abs("$tmpdir/subdir");
29314  mkpath($home_dir);
29315
29316  my $other_dir = File::Spec->rel2abs("$tmpdir/otherdir");
29317  mkpath($other_dir);
29318
29319  my $test_symlink = File::Spec->rel2abs("$home_dir/otherdir.lnk");
29320  unless (symlink($other_dir, $test_symlink)) {
29321    die("Can't symlink $test_symlink to $other_dir: $!");
29322  }
29323
29324  # Make sure that, if we're running as root, that the home directory has
29325  # permissions/privs set for the account we create
29326  if ($< == 0) {
29327    unless (chmod(0755, $home_dir)) {
29328      die("Can't set perms on $home_dir to 0755: $!");
29329    }
29330
29331    unless (chown($uid, $gid, $home_dir)) {
29332      die("Can't set owner of $home_dir to $uid/$gid: $!");
29333    }
29334  }
29335
29336  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
29337    '/bin/bash');
29338  auth_group_write($auth_group_file, $group, $gid, $user);
29339
29340  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
29341  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
29342
29343  my $config = {
29344    PidFile => $pid_file,
29345    ScoreboardFile => $scoreboard_file,
29346    SystemLog => $log_file,
29347    TraceLog => $log_file,
29348    Trace => 'auth:10 fsio:10 ssh2:20 sftp:20 scp:20',
29349
29350    AuthUserFile => $auth_user_file,
29351    AuthGroupFile => $auth_group_file,
29352
29353    IfModules => {
29354      'mod_delay.c' => {
29355        DelayEngine => 'off',
29356      },
29357
29358      'mod_sftp.c' => [
29359        "SFTPEngine on",
29360        "SFTPLog $log_file",
29361        "SFTPHostKey $rsa_host_key",
29362        "SFTPHostKey $dsa_host_key",
29363      ],
29364
29365      'mod_vroot.c' => {
29366        DefaultRoot => '~',
29367        VRootEngine => 'on',
29368        VRootLog => $log_file,
29369        VRootOptions => 'allowSymlinks',
29370      },
29371    },
29372  };
29373
29374  my ($port, $config_user, $config_group) = config_write($config_file, $config);
29375
29376  # Open pipes, for use between the parent and child processes.  Specifically,
29377  # the child will indicate when it's done with its test by writing a message
29378  # to the parent.
29379  my ($rfh, $wfh);
29380  unless (pipe($rfh, $wfh)) {
29381    die("Can't open pipe: $!");
29382  }
29383
29384  require Net::SSH2;
29385
29386  my $ex;
29387
29388  # Fork child
29389  $self->handle_sigchld();
29390  defined(my $pid = fork()) or die("Can't fork: $!");
29391  if ($pid) {
29392    eval {
29393      my $ssh2 = Net::SSH2->new();
29394
29395      sleep(1);
29396
29397      unless ($ssh2->connect('127.0.0.1', $port)) {
29398        my ($err_code, $err_name, $err_str) = $ssh2->error();
29399        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
29400      }
29401
29402      unless ($ssh2->auth_password($user, $passwd)) {
29403        my ($err_code, $err_name, $err_str) = $ssh2->error();
29404        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
29405      }
29406
29407      my $sftp = $ssh2->sftp();
29408      unless ($sftp) {
29409        my ($err_code, $err_name, $err_str) = $ssh2->error();
29410        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
29411      }
29412
29413      my $dir = $sftp->opendir('otherdir.lnk');
29414      unless ($dir) {
29415        my ($err_code, $err_name) = $sftp->error();
29416        die("Can't open directory 'otherdir.lnk': [$err_name] ($err_code)");
29417      }
29418
29419      my $res = {};
29420
29421      my $file = $dir->read();
29422      while ($file) {
29423        $res->{$file->{name}} = $file;
29424        $file = $dir->read();
29425      }
29426
29427      my $expected = {
29428        '.' => 1,
29429        '..' => 1,
29430      };
29431
29432      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
29433      $dir = undef;
29434
29435      # To close the SFTP channel, we have to explicitly destroy the object
29436      $sftp = undef;
29437
29438      $ssh2->disconnect();
29439
29440      my $ok = 1;
29441      my $mismatch;
29442
29443      my $seen = [];
29444      foreach my $name (keys(%$res)) {
29445        push(@$seen, $name);
29446
29447        unless (defined($expected->{$name})) {
29448          $mismatch = $name;
29449          $ok = 0;
29450          last;
29451        }
29452      }
29453
29454      unless ($ok) {
29455        die("Unexpected name '$mismatch' appeared in READDIR data")
29456      }
29457
29458      # Now remove from $expected all of the paths we saw; if there are
29459      # any entries remaining in $expected, something went wrong.
29460      foreach my $name (@$seen) {
29461        delete($expected->{$name});
29462      }
29463
29464      my $remaining = scalar(keys(%$expected));
29465      $self->assert(0 == $remaining,
29466        test_msg("Expected 0, got $remaining"));
29467    };
29468
29469    if ($@) {
29470      $ex = $@;
29471    }
29472
29473    $wfh->print("done\n");
29474    $wfh->flush();
29475
29476  } else {
29477    eval { server_wait($config_file, $rfh) };
29478    if ($@) {
29479      warn($@);
29480      exit 1;
29481    }
29482
29483    exit 0;
29484  }
29485
29486  # Stop server
29487  server_stop($pid_file);
29488
29489  $self->assert_child_ok($pid);
29490
29491  if ($ex) {
29492    test_append_logfile($log_file, $ex);
29493    unlink($log_file);
29494
29495    die($ex);
29496  }
29497
29498  unlink($log_file);
29499}
29500
29501sub sftp_readdir_rel_symlink_dir {
29502  my $self = shift;
29503  my $tmpdir = $self->{tmpdir};
29504  my $setup = test_setup($tmpdir, 'sftp');
29505
29506  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
29507  mkpath($test_dir);
29508
29509  my $sub_dir = File::Spec->rel2abs("$test_dir/sub.d");
29510  mkpath($sub_dir);
29511
29512  # Change to the test directory in order to create a relative path in the
29513  # symlink we need
29514
29515  my $cwd = getcwd();
29516  unless (chdir($test_dir)) {
29517    die("Can't chdir to $test_dir: $!");
29518  }
29519
29520  unless (symlink('./sub.d', './test.lnk')) {
29521    die("Can't symlink 'test.lnk' to './sub.d': $!");
29522  }
29523
29524  unless (chdir($cwd)) {
29525    die("Can't chdir to $cwd: $!");
29526  }
29527
29528  if ($< == 0) {
29529    unless (chmod(0755, $test_dir, $sub_dir)) {
29530      die("Can't set perms on $test_dir to 0755: $!");
29531    }
29532
29533    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $sub_dir)) {
29534      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
29535    }
29536  }
29537
29538  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
29539  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
29540
29541  my $config = {
29542    PidFile => $setup->{pid_file},
29543    ScoreboardFile => $setup->{scoreboard_file},
29544    SystemLog => $setup->{log_file},
29545    TraceLog => $setup->{log_file},
29546    Trace => 'auth:10 fsio:10 ssh2:20 sftp:20 scp:20',
29547
29548    AuthUserFile => $setup->{auth_user_file},
29549    AuthGroupFile => $setup->{auth_group_file},
29550
29551    IfModules => {
29552      'mod_delay.c' => {
29553        DelayEngine => 'off',
29554      },
29555
29556      'mod_sftp.c' => [
29557        "SFTPEngine on",
29558        "SFTPLog $setup->{log_file}",
29559        "SFTPHostKey $rsa_host_key",
29560        "SFTPHostKey $dsa_host_key",
29561      ],
29562    },
29563  };
29564
29565  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
29566    $config);
29567
29568  # Open pipes, for use between the parent and child processes.  Specifically,
29569  # the child will indicate when it's done with its test by writing a message
29570  # to the parent.
29571  my ($rfh, $wfh);
29572  unless (pipe($rfh, $wfh)) {
29573    die("Can't open pipe: $!");
29574  }
29575
29576  require Net::SSH2;
29577
29578  my $ex;
29579
29580  # Fork child
29581  $self->handle_sigchld();
29582  defined(my $pid = fork()) or die("Can't fork: $!");
29583  if ($pid) {
29584    eval {
29585      my $ssh2 = Net::SSH2->new();
29586
29587      sleep(1);
29588
29589      unless ($ssh2->connect('127.0.0.1', $port)) {
29590        my ($err_code, $err_name, $err_str) = $ssh2->error();
29591        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
29592      }
29593
29594      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
29595        my ($err_code, $err_name, $err_str) = $ssh2->error();
29596        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
29597      }
29598
29599      my $sftp = $ssh2->sftp();
29600      unless ($sftp) {
29601        my ($err_code, $err_name, $err_str) = $ssh2->error();
29602        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
29603      }
29604
29605      my $path = 'test.d/test.lnk';
29606      my $dir = $sftp->opendir($path);
29607      unless ($dir) {
29608        my ($err_code, $err_name) = $sftp->error();
29609        die("Can't open directory '$path': [$err_name] ($err_code)");
29610      }
29611
29612      my $res = {};
29613
29614      my $file = $dir->read();
29615      while ($file) {
29616        $res->{$file->{name}} = $file;
29617        $file = $dir->read();
29618      }
29619
29620      my $expected = {
29621        '.' => 1,
29622        '..' => 1,
29623      };
29624
29625      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
29626      $dir = undef;
29627
29628      # To close the SFTP channel, we have to explicitly destroy the object
29629      $sftp = undef;
29630
29631      $ssh2->disconnect();
29632
29633      my $ok = 1;
29634      my $mismatch;
29635
29636      my $seen = [];
29637      foreach my $name (keys(%$res)) {
29638        push(@$seen, $name);
29639
29640        unless (defined($expected->{$name})) {
29641          $mismatch = $name;
29642          $ok = 0;
29643          last;
29644        }
29645      }
29646
29647      unless ($ok) {
29648        die("Unexpected name '$mismatch' appeared in READDIR data")
29649      }
29650
29651      # Now remove from $expected all of the paths we saw; if there are
29652      # any entries remaining in $expected, something went wrong.
29653      foreach my $name (@$seen) {
29654        delete($expected->{$name});
29655      }
29656
29657      my $remaining = scalar(keys(%$expected));
29658      $self->assert(0 == $remaining,
29659        test_msg("Expected 0, got $remaining"));
29660    };
29661    if ($@) {
29662      $ex = $@;
29663    }
29664
29665    $wfh->print("done\n");
29666    $wfh->flush();
29667
29668  } else {
29669    eval { server_wait($setup->{config_file}, $rfh) };
29670    if ($@) {
29671      warn($@);
29672      exit 1;
29673    }
29674
29675    exit 0;
29676  }
29677
29678  # Stop server
29679  server_stop($setup->{pid_file});
29680  $self->assert_child_ok($pid);
29681
29682  test_cleanup($setup->{log_file}, $ex);
29683}
29684
29685sub sftp_readdir_rel_symlink_dir_chrooted_bug4219 {
29686  my $self = shift;
29687  my $tmpdir = $self->{tmpdir};
29688  my $setup = test_setup($tmpdir, 'sftp');
29689
29690  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
29691  mkpath($test_dir);
29692
29693  my $sub_dir = File::Spec->rel2abs("$test_dir/sub.d");
29694  mkpath($sub_dir);
29695
29696  # Change to the test directory in order to create a relative path in the
29697  # symlink we need
29698
29699  my $cwd = getcwd();
29700  unless (chdir($test_dir)) {
29701    die("Can't chdir to $test_dir: $!");
29702  }
29703
29704  unless (symlink('./sub.d', './test.lnk')) {
29705    die("Can't symlink 'test.lnk' to './sub.d': $!");
29706  }
29707
29708  unless (chdir($cwd)) {
29709    die("Can't chdir to $cwd: $!");
29710  }
29711
29712  if ($< == 0) {
29713    unless (chmod(0755, $test_dir, $sub_dir)) {
29714      die("Can't set perms on $test_dir to 0755: $!");
29715    }
29716
29717    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $sub_dir)) {
29718      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
29719    }
29720  }
29721
29722  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
29723  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
29724
29725  my $config = {
29726    PidFile => $setup->{pid_file},
29727    ScoreboardFile => $setup->{scoreboard_file},
29728    SystemLog => $setup->{log_file},
29729    TraceLog => $setup->{log_file},
29730    Trace => 'auth:10 fsio:10 ssh2:20 sftp:20 scp:20',
29731
29732    AuthUserFile => $setup->{auth_user_file},
29733    AuthGroupFile => $setup->{auth_group_file},
29734
29735    DefaultRoot => '~',
29736
29737    IfModules => {
29738      'mod_delay.c' => {
29739        DelayEngine => 'off',
29740      },
29741
29742      'mod_sftp.c' => [
29743        "SFTPEngine on",
29744        "SFTPLog $setup->{log_file}",
29745        "SFTPHostKey $rsa_host_key",
29746        "SFTPHostKey $dsa_host_key",
29747      ],
29748    },
29749  };
29750
29751  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
29752    $config);
29753
29754  # Open pipes, for use between the parent and child processes.  Specifically,
29755  # the child will indicate when it's done with its test by writing a message
29756  # to the parent.
29757  my ($rfh, $wfh);
29758  unless (pipe($rfh, $wfh)) {
29759    die("Can't open pipe: $!");
29760  }
29761
29762  require Net::SSH2;
29763
29764  my $ex;
29765
29766  # Fork child
29767  $self->handle_sigchld();
29768  defined(my $pid = fork()) or die("Can't fork: $!");
29769  if ($pid) {
29770    eval {
29771      my $ssh2 = Net::SSH2->new();
29772
29773      sleep(1);
29774
29775      unless ($ssh2->connect('127.0.0.1', $port)) {
29776        my ($err_code, $err_name, $err_str) = $ssh2->error();
29777        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
29778      }
29779
29780      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
29781        my ($err_code, $err_name, $err_str) = $ssh2->error();
29782        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
29783      }
29784
29785      my $sftp = $ssh2->sftp();
29786      unless ($sftp) {
29787        my ($err_code, $err_name, $err_str) = $ssh2->error();
29788        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
29789      }
29790
29791      my $path = 'test.d/test.lnk';
29792      my $dir = $sftp->opendir($path);
29793      unless ($dir) {
29794        my ($err_code, $err_name) = $sftp->error();
29795        die("Can't open directory '$path': [$err_name] ($err_code)");
29796      }
29797
29798      my $res = {};
29799
29800      my $file = $dir->read();
29801      while ($file) {
29802        $res->{$file->{name}} = $file;
29803        $file = $dir->read();
29804      }
29805
29806      my $expected = {
29807        '.' => 1,
29808        '..' => 1,
29809      };
29810
29811      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
29812      $dir = undef;
29813
29814      # To close the SFTP channel, we have to explicitly destroy the object
29815      $sftp = undef;
29816
29817      $ssh2->disconnect();
29818
29819      my $ok = 1;
29820      my $mismatch;
29821
29822      my $seen = [];
29823      foreach my $name (keys(%$res)) {
29824        push(@$seen, $name);
29825
29826        unless (defined($expected->{$name})) {
29827          $mismatch = $name;
29828          $ok = 0;
29829          last;
29830        }
29831      }
29832
29833      unless ($ok) {
29834        die("Unexpected name '$mismatch' appeared in READDIR data")
29835      }
29836
29837      # Now remove from $expected all of the paths we saw; if there are
29838      # any entries remaining in $expected, something went wrong.
29839      foreach my $name (@$seen) {
29840        delete($expected->{$name});
29841      }
29842
29843      my $remaining = scalar(keys(%$expected));
29844      $self->assert(0 == $remaining,
29845        test_msg("Expected 0, got $remaining"));
29846    };
29847    if ($@) {
29848      $ex = $@;
29849    }
29850
29851    $wfh->print("done\n");
29852    $wfh->flush();
29853
29854  } else {
29855    eval { server_wait($setup->{config_file}, $rfh) };
29856    if ($@) {
29857      warn($@);
29858      exit 1;
29859    }
29860
29861    exit 0;
29862  }
29863
29864  # Stop server
29865  server_stop($setup->{pid_file});
29866  $self->assert_child_ok($pid);
29867
29868  test_cleanup($setup->{log_file}, $ex);
29869}
29870
29871sub sftp_readdir_wide_dir {
29872  my $self = shift;
29873  my $tmpdir = $self->{tmpdir};
29874
29875  my $config_file = "$tmpdir/sftp.conf";
29876  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
29877  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
29878
29879  my $log_file = test_get_logfile();
29880
29881  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
29882  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
29883
29884  my $user = 'proftpd';
29885  my $passwd = 'test';
29886  my $group = 'ftpd';
29887  my $home_dir = File::Spec->rel2abs($tmpdir);
29888  my $uid = 500;
29889  my $gid = 500;
29890
29891  # Make sure that, if we're running as root, that the home directory has
29892  # permissions/privs set for the account we create
29893  if ($< == 0) {
29894    unless (chmod(0755, $home_dir)) {
29895      die("Can't set perms on $home_dir to 0755: $!");
29896    }
29897
29898    unless (chown($uid, $gid, $home_dir)) {
29899      die("Can't set owner of $home_dir to $uid/$gid: $!");
29900    }
29901  }
29902
29903  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
29904    '/bin/bash');
29905  auth_group_write($auth_group_file, $group, $gid, $user);
29906
29907  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
29908  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
29909
29910  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
29911  mkpath($test_dir);
29912
29913  my $expected = {
29914    '.' => 1,
29915    '..' => 1,
29916  };
29917
29918  my $max_nfiles = 250;
29919  for (my $i = 0; $i < $max_nfiles; $i++) {
29920    my $test_filename = 'SomeReallyLongAndObnoxiousTestFileNameTemplate' . $i;
29921
29922    # The expected hash is used later for verifying the results of the READDIR
29923    $expected->{$test_filename} = 1;
29924
29925    my $test_path = File::Spec->rel2abs("$test_dir/$test_filename");
29926
29927    if (open(my $fh, "> $test_path")) {
29928      close($fh);
29929
29930    } else {
29931      die("Can't open $test_path: $!");
29932    }
29933  }
29934
29935  my $config = {
29936    PidFile => $pid_file,
29937    ScoreboardFile => $scoreboard_file,
29938    SystemLog => $log_file,
29939    TraceLog => $log_file,
29940    Trace => 'auth:10 ssh2:20 sftp:20 scp:20',
29941
29942    AuthUserFile => $auth_user_file,
29943    AuthGroupFile => $auth_group_file,
29944
29945    IfModules => {
29946      'mod_delay.c' => {
29947        DelayEngine => 'off',
29948      },
29949
29950      'mod_sftp.c' => [
29951        "SFTPEngine on",
29952        "SFTPLog $log_file",
29953        "SFTPHostKey $rsa_host_key",
29954        "SFTPHostKey $dsa_host_key",
29955      ],
29956    },
29957  };
29958
29959  my ($port, $config_user, $config_group) = config_write($config_file, $config);
29960
29961  # Open pipes, for use between the parent and child processes.  Specifically,
29962  # the child will indicate when it's done with its test by writing a message
29963  # to the parent.
29964  my ($rfh, $wfh);
29965  unless (pipe($rfh, $wfh)) {
29966    die("Can't open pipe: $!");
29967  }
29968
29969  require Net::SSH2;
29970
29971  my $ex;
29972
29973  # Fork child
29974  $self->handle_sigchld();
29975  defined(my $pid = fork()) or die("Can't fork: $!");
29976  if ($pid) {
29977    eval {
29978      my $ssh2 = Net::SSH2->new();
29979
29980      sleep(1);
29981
29982      unless ($ssh2->connect('127.0.0.1', $port)) {
29983        my ($err_code, $err_name, $err_str) = $ssh2->error();
29984        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
29985      }
29986
29987      unless ($ssh2->auth_password($user, $passwd)) {
29988        my ($err_code, $err_name, $err_str) = $ssh2->error();
29989        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
29990      }
29991
29992      my $sftp = $ssh2->sftp();
29993      unless ($sftp) {
29994        my ($err_code, $err_name, $err_str) = $ssh2->error();
29995        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
29996      }
29997
29998      my $dir = $sftp->opendir('test.d');
29999      unless ($dir) {
30000        my ($err_code, $err_name) = $sftp->error();
30001        die("Can't open directory 'test.d': [$err_name] ($err_code)");
30002      }
30003
30004      my $res = {};
30005
30006      my $file = $dir->read();
30007      while ($file) {
30008        $res->{$file->{name}} = $file;
30009        $file = $dir->read();
30010      }
30011
30012      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
30013      $dir = undef;
30014
30015      # To close the SFTP channel, we have to explicitly destroy the object
30016      $sftp = undef;
30017
30018      $ssh2->disconnect();
30019
30020      my $ok = 1;
30021      my $mismatch;
30022
30023      my $seen = [];
30024      foreach my $name (keys(%$res)) {
30025        push(@$seen, $name);
30026
30027        unless (defined($expected->{$name})) {
30028          $mismatch = $name;
30029          $ok = 0;
30030          last;
30031        }
30032      }
30033
30034      unless ($ok) {
30035        die("Unexpected name '$mismatch' appeared in READDIR data")
30036      }
30037
30038      my $nseen = scalar(@$seen);
30039
30040      # We add two here for '.' and '..'
30041      my $expected_seen = $max_nfiles + 2;
30042      $self->assert($expected_seen == $nseen,
30043        test_msg("Expected '$expected_seen' files, got $nseen"));
30044
30045      # Now remove from $expected all of the paths we saw; if there are
30046      # any entries remaining in $expected, something went wrong.
30047      foreach my $name (@$seen) {
30048        delete($expected->{$name});
30049      }
30050
30051      my $remaining = scalar(keys(%$expected));
30052      $self->assert(0 == $remaining,
30053        test_msg("Expected 0, got $remaining"));
30054    };
30055
30056    if ($@) {
30057      $ex = $@;
30058    }
30059
30060    $wfh->print("done\n");
30061    $wfh->flush();
30062
30063  } else {
30064    eval { server_wait($config_file, $rfh) };
30065    if ($@) {
30066      warn($@);
30067      exit 1;
30068    }
30069
30070    exit 0;
30071  }
30072
30073  # Stop server
30074  server_stop($pid_file);
30075
30076  $self->assert_child_ok($pid);
30077
30078  if ($ex) {
30079    test_append_logfile($log_file, $ex);
30080    unlink($log_file);
30081
30082    die($ex);
30083  }
30084
30085  unlink($log_file);
30086}
30087
30088sub sftp_readdir_with_removes {
30089  my $self = shift;
30090  my $tmpdir = $self->{tmpdir};
30091
30092  my $config_file = "$tmpdir/sftp.conf";
30093  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
30094  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
30095
30096  my $log_file = test_get_logfile();
30097
30098  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
30099  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
30100
30101  my $user = 'proftpd';
30102  my $passwd = 'test';
30103  my $group = 'ftpd';
30104  my $home_dir = File::Spec->rel2abs($tmpdir);
30105  my $uid = 500;
30106  my $gid = 500;
30107
30108  # Make sure that, if we're running as root, that the home directory has
30109  # permissions/privs set for the account we create
30110  if ($< == 0) {
30111    unless (chmod(0755, $home_dir)) {
30112      die("Can't set perms on $home_dir to 0755: $!");
30113    }
30114
30115    unless (chown($uid, $gid, $home_dir)) {
30116      die("Can't set owner of $home_dir to $uid/$gid: $!");
30117    }
30118  }
30119
30120  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
30121    '/bin/bash');
30122  auth_group_write($auth_group_file, $group, $gid, $user);
30123
30124  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
30125  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
30126
30127  my $test_file1 = File::Spec->rel2abs("$tmpdir/test1.txt");
30128  if (open(my $fh, "> $test_file1")) {
30129    print $fh "Hello, World!\n";
30130    unless (close($fh)) {
30131      die("Can't write $test_file1");
30132    }
30133
30134  } else {
30135    die("Can't open $test_file1");
30136  }
30137
30138  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
30139  if (open(my $fh, "> $test_file2")) {
30140    print $fh "Hello, World!\n";
30141    unless (close($fh)) {
30142      die("Can't write $test_file2");
30143    }
30144
30145  } else {
30146    die("Can't open $test_file2");
30147  }
30148
30149  my $test_file3 = File::Spec->rel2abs("$tmpdir/test3.txt");
30150  if (open(my $fh, "> $test_file3")) {
30151    print $fh "Hello, World!\n";
30152    unless (close($fh)) {
30153      die("Can't write $test_file3");
30154    }
30155
30156  } else {
30157    die("Can't open $test_file3");
30158  }
30159
30160  my $config = {
30161    PidFile => $pid_file,
30162    ScoreboardFile => $scoreboard_file,
30163    SystemLog => $log_file,
30164    TraceLog => $log_file,
30165    Trace => 'ssh2:20 sftp:20',
30166
30167    AuthUserFile => $auth_user_file,
30168    AuthGroupFile => $auth_group_file,
30169
30170    IfModules => {
30171      'mod_delay.c' => {
30172        DelayEngine => 'off',
30173      },
30174
30175      'mod_sftp.c' => [
30176        "SFTPEngine on",
30177        "SFTPLog $log_file",
30178        "SFTPHostKey $rsa_host_key",
30179        "SFTPHostKey $dsa_host_key",
30180      ],
30181    },
30182  };
30183
30184  my ($port, $config_user, $config_group) = config_write($config_file, $config);
30185
30186  # Open pipes, for use between the parent and child processes.  Specifically,
30187  # the child will indicate when it's done with its test by writing a message
30188  # to the parent.
30189  my ($rfh, $wfh);
30190  unless (pipe($rfh, $wfh)) {
30191    die("Can't open pipe: $!");
30192  }
30193
30194  require Net::SSH2;
30195
30196  my $ex;
30197
30198  # Fork child
30199  $self->handle_sigchld();
30200  defined(my $pid = fork()) or die("Can't fork: $!");
30201  if ($pid) {
30202    eval {
30203      my $ssh2 = Net::SSH2->new();
30204
30205      sleep(1);
30206
30207      unless ($ssh2->connect('127.0.0.1', $port)) {
30208        my ($err_code, $err_name, $err_str) = $ssh2->error();
30209        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
30210      }
30211
30212      unless ($ssh2->auth_password($user, $passwd)) {
30213        my ($err_code, $err_name, $err_str) = $ssh2->error();
30214        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
30215      }
30216
30217      my $sftp = $ssh2->sftp();
30218      unless ($sftp) {
30219        my ($err_code, $err_name, $err_str) = $ssh2->error();
30220        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
30221      }
30222
30223      my $dir = $sftp->opendir('.');
30224      unless ($dir) {
30225        my ($err_code, $err_name) = $sftp->error();
30226        die("Can't open directory '.': [$err_name] ($err_code)");
30227      }
30228
30229      $dir->read();
30230
30231      # Before we close the directory, we do the following, 3 times in a row:
30232      #
30233      #   OPEN/STAT/READ/CLOSE/REMOVE
30234      #
30235      # and then do a closedir.
30236
30237      my $files = [$test_file1, $test_file2, $test_file3];
30238      for my $file (@$files) {
30239        my $fh = $sftp->open($file, O_RDONLY);
30240        unless ($fh) {
30241          my ($err_code, $err_name) = $sftp->error();
30242          die("Can't open $file: [$err_name] ($err_code)");
30243        }
30244
30245        my $attrs = $sftp->stat($file, 1);
30246        unless ($attrs) {
30247          my ($err_code, $err_name) = $sftp->error();
30248          die("Can't stat $file: [$err_name] ($err_code)");
30249        }
30250
30251        my $buf;
30252        my $size = 0;
30253
30254        my $res = $fh->read($buf, 8192);
30255        while ($res) {
30256          $size += $res;
30257          $res = $fh->read($buf, 8192);
30258        }
30259
30260        # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
30261        $fh = undef;
30262
30263        $res = $sftp->unlink($file);
30264        unless ($res) {
30265          my ($err_code, $err_name) = $sftp->error();
30266          die("Can't remove $file: [$err_name] ($err_code)");
30267        }
30268      }
30269
30270      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
30271      $dir = undef;
30272
30273      # To close the SFTP channel, we have to explicitly destroy the object
30274      $sftp = undef;
30275
30276      $ssh2->disconnect();
30277    };
30278
30279    if ($@) {
30280      $ex = $@;
30281    }
30282
30283    $wfh->print("done\n");
30284    $wfh->flush();
30285
30286  } else {
30287    eval { server_wait($config_file, $rfh) };
30288    if ($@) {
30289      warn($@);
30290      exit 1;
30291    }
30292
30293    exit 0;
30294  }
30295
30296  # Stop server
30297  server_stop($pid_file);
30298
30299  $self->assert_child_ok($pid);
30300
30301  eval {
30302    if (open(my $fh, "< $log_file")) {
30303      my $ok = 1;
30304
30305      while (my $line = <$fh>) {
30306        if ($line =~ /Invalid handle/) {
30307          $ok = 0;
30308          last;
30309        }
30310      }
30311
30312      close($fh);
30313
30314      $self->assert($ok,
30315        test_msg("Unexpectedly saw 'Invalid handle' SFTP response"));
30316
30317    } else {
30318      die("Can't read $log_file: $!");
30319    }
30320  };
30321  if ($@) {
30322    $ex = $@;
30323  }
30324
30325  if ($ex) {
30326    test_append_logfile($log_file, $ex);
30327    unlink($log_file);
30328
30329    die($ex);
30330  }
30331
30332  unlink($log_file);
30333}
30334
30335sub sftp_mkdir {
30336  my $self = shift;
30337  my $tmpdir = $self->{tmpdir};
30338
30339  my $config_file = "$tmpdir/sftp.conf";
30340  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
30341  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
30342
30343  my $log_file = test_get_logfile();
30344
30345  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
30346  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
30347
30348  my $user = 'proftpd';
30349  my $passwd = 'test';
30350  my $group = 'ftpd';
30351  my $home_dir = File::Spec->rel2abs($tmpdir);
30352  my $uid = 500;
30353  my $gid = 500;
30354
30355  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
30356
30357  # Make sure that, if we're running as root, that the home directory has
30358  # permissions/privs set for the account we create
30359  if ($< == 0) {
30360    unless (chmod(0755, $home_dir)) {
30361      die("Can't set perms on $home_dir to 0755: $!");
30362    }
30363
30364    unless (chown($uid, $gid, $home_dir)) {
30365      die("Can't set owner of $home_dir to $uid/$gid: $!");
30366    }
30367  }
30368
30369  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
30370    '/bin/bash');
30371  auth_group_write($auth_group_file, $group, $gid, $user);
30372
30373  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
30374  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
30375
30376  my $config = {
30377    PidFile => $pid_file,
30378    ScoreboardFile => $scoreboard_file,
30379    SystemLog => $log_file,
30380    TraceLog => $log_file,
30381    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
30382
30383    AuthUserFile => $auth_user_file,
30384    AuthGroupFile => $auth_group_file,
30385
30386    IfModules => {
30387      'mod_delay.c' => {
30388        DelayEngine => 'off',
30389      },
30390
30391      'mod_sftp.c' => [
30392        "SFTPEngine on",
30393        "SFTPLog $log_file",
30394        "SFTPHostKey $rsa_host_key",
30395        "SFTPHostKey $dsa_host_key",
30396      ],
30397    },
30398  };
30399
30400  my ($port, $config_user, $config_group) = config_write($config_file, $config);
30401
30402  # Open pipes, for use between the parent and child processes.  Specifically,
30403  # the child will indicate when it's done with its test by writing a message
30404  # to the parent.
30405  my ($rfh, $wfh);
30406  unless (pipe($rfh, $wfh)) {
30407    die("Can't open pipe: $!");
30408  }
30409
30410  require Net::SSH2;
30411
30412  my $ex;
30413
30414  # Fork child
30415  $self->handle_sigchld();
30416  defined(my $pid = fork()) or die("Can't fork: $!");
30417  if ($pid) {
30418    eval {
30419      my $ssh2 = Net::SSH2->new();
30420
30421      sleep(1);
30422
30423      unless ($ssh2->connect('127.0.0.1', $port)) {
30424        my ($err_code, $err_name, $err_str) = $ssh2->error();
30425        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
30426      }
30427
30428      unless ($ssh2->auth_password($user, $passwd)) {
30429        my ($err_code, $err_name, $err_str) = $ssh2->error();
30430        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
30431      }
30432
30433      my $sftp = $ssh2->sftp();
30434      unless ($sftp) {
30435        my ($err_code, $err_name, $err_str) = $ssh2->error();
30436        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
30437      }
30438
30439      my $res = $sftp->mkdir('testdir');
30440      unless ($res) {
30441        my ($err_code, $err_name) = $sftp->error();
30442        die("Can't mkdir testdir: [$err_name] ($err_code)");
30443      }
30444
30445      $sftp = undef;
30446      $ssh2->disconnect();
30447
30448      unless (-d $test_dir) {
30449        die("$test_dir directory does not exist as expected");
30450      }
30451    };
30452
30453    if ($@) {
30454      $ex = $@;
30455    }
30456
30457    $wfh->print("done\n");
30458    $wfh->flush();
30459
30460  } else {
30461    eval { server_wait($config_file, $rfh) };
30462    if ($@) {
30463      warn($@);
30464      exit 1;
30465    }
30466
30467    exit 0;
30468  }
30469
30470  # Stop server
30471  server_stop($pid_file);
30472
30473  $self->assert_child_ok($pid);
30474
30475  if ($ex) {
30476    test_append_logfile($log_file, $ex);
30477    unlink($log_file);
30478
30479    die($ex);
30480  }
30481
30482  unlink($log_file);
30483}
30484
30485sub sftp_mkdir_eexist {
30486  my $self = shift;
30487  my $tmpdir = $self->{tmpdir};
30488
30489  my $config_file = "$tmpdir/sftp.conf";
30490  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
30491  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
30492
30493  my $log_file = test_get_logfile();
30494
30495  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
30496  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
30497
30498  my $user = 'proftpd';
30499  my $passwd = 'test';
30500  my $group = 'ftpd';
30501  my $home_dir = File::Spec->rel2abs($tmpdir);
30502  my $uid = 500;
30503  my $gid = 500;
30504
30505  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
30506  mkpath($test_dir);
30507
30508  # Make sure that, if we're running as root, that the home directory has
30509  # permissions/privs set for the account we create
30510  if ($< == 0) {
30511    unless (chmod(0755, $home_dir, $test_dir)) {
30512      die("Can't set perms on $home_dir to 0755: $!");
30513    }
30514
30515    unless (chown($uid, $gid, $home_dir, $test_dir)) {
30516      die("Can't set owner of $home_dir to $uid/$gid: $!");
30517    }
30518  }
30519
30520  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
30521    '/bin/bash');
30522  auth_group_write($auth_group_file, $group, $gid, $user);
30523
30524  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
30525  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
30526
30527  my $config = {
30528    PidFile => $pid_file,
30529    ScoreboardFile => $scoreboard_file,
30530    SystemLog => $log_file,
30531    TraceLog => $log_file,
30532    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
30533
30534    AuthUserFile => $auth_user_file,
30535    AuthGroupFile => $auth_group_file,
30536
30537    IfModules => {
30538      'mod_delay.c' => {
30539        DelayEngine => 'off',
30540      },
30541
30542      'mod_sftp.c' => [
30543        "SFTPEngine on",
30544        "SFTPLog $log_file",
30545        "SFTPHostKey $rsa_host_key",
30546        "SFTPHostKey $dsa_host_key",
30547      ],
30548    },
30549  };
30550
30551  my ($port, $config_user, $config_group) = config_write($config_file, $config);
30552
30553  # Open pipes, for use between the parent and child processes.  Specifically,
30554  # the child will indicate when it's done with its test by writing a message
30555  # to the parent.
30556  my ($rfh, $wfh);
30557  unless (pipe($rfh, $wfh)) {
30558    die("Can't open pipe: $!");
30559  }
30560
30561  require Net::SSH2;
30562
30563  my $ex;
30564
30565  # Fork child
30566  $self->handle_sigchld();
30567  defined(my $pid = fork()) or die("Can't fork: $!");
30568  if ($pid) {
30569    eval {
30570      my $ssh2 = Net::SSH2->new();
30571
30572      sleep(1);
30573
30574      unless ($ssh2->connect('127.0.0.1', $port)) {
30575        my ($err_code, $err_name, $err_str) = $ssh2->error();
30576        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
30577      }
30578
30579      unless ($ssh2->auth_password($user, $passwd)) {
30580        my ($err_code, $err_name, $err_str) = $ssh2->error();
30581        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
30582      }
30583
30584      my $sftp = $ssh2->sftp();
30585      unless ($sftp) {
30586        my ($err_code, $err_name, $err_str) = $ssh2->error();
30587        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
30588      }
30589
30590      my $res = $sftp->mkdir('testdir');
30591      if ($res) {
30592        die("MKDIR testdir succeeded unexpectedly");
30593      }
30594
30595      my ($err_code, $err_name) = $sftp->error();
30596      $self->assert($err_name eq 'SSH_FX_FAILURE',
30597        test_msg("Expected error name 'SSH_FX_FAILURE', got '$err_name'"));
30598
30599      $sftp = undef;
30600      $ssh2->disconnect();
30601
30602      unless (-d $test_dir) {
30603        die("$test_dir directory does not exist as expected");
30604      }
30605    };
30606
30607    if ($@) {
30608      $ex = $@;
30609    }
30610
30611    $wfh->print("done\n");
30612    $wfh->flush();
30613
30614  } else {
30615    eval { server_wait($config_file, $rfh) };
30616    if ($@) {
30617      warn($@);
30618      exit 1;
30619    }
30620
30621    exit 0;
30622  }
30623
30624  # Stop server
30625  server_stop($pid_file);
30626
30627  $self->assert_child_ok($pid);
30628
30629  if ($ex) {
30630    test_append_logfile($log_file, $ex);
30631    unlink($log_file);
30632
30633    die($ex);
30634  }
30635
30636  unlink($log_file);
30637}
30638
30639sub sftp_mkdir_abs_symlink_eexist {
30640  my $self = shift;
30641  my $tmpdir = $self->{tmpdir};
30642  my $setup = test_setup($tmpdir, 'sftp');
30643
30644  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
30645  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
30646
30647  my $dst_path = $test_dir;
30648  if ($^O eq 'darwin') {
30649    # MacOSX-specific hack
30650    $dst_path = '/private' . $dst_path;
30651  }
30652
30653  unless (symlink($test_dir, $test_symlink)) {
30654    die("Can't symlink $test_symlink to $test_dir: $!");
30655  }
30656
30657  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
30658  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
30659
30660  my $config = {
30661    PidFile => $setup->{pid_file},
30662    ScoreboardFile => $setup->{scoreboard_file},
30663    SystemLog => $setup->{log_file},
30664    TraceLog => $setup->{log_file},
30665    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
30666
30667    AuthUserFile => $setup->{auth_user_file},
30668    AuthGroupFile => $setup->{auth_group_file},
30669
30670    IfModules => {
30671      'mod_delay.c' => {
30672        DelayEngine => 'off',
30673      },
30674
30675      'mod_sftp.c' => [
30676        "SFTPEngine on",
30677        "SFTPLog $setup->{log_file}",
30678        "SFTPHostKey $rsa_host_key",
30679        "SFTPHostKey $dsa_host_key",
30680      ],
30681    },
30682  };
30683
30684  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
30685    $config);
30686
30687  # Open pipes, for use between the parent and child processes.  Specifically,
30688  # the child will indicate when it's done with its test by writing a message
30689  # to the parent.
30690  my ($rfh, $wfh);
30691  unless (pipe($rfh, $wfh)) {
30692    die("Can't open pipe: $!");
30693  }
30694
30695  require Net::SSH2;
30696
30697  my $ex;
30698
30699  # Fork child
30700  $self->handle_sigchld();
30701  defined(my $pid = fork()) or die("Can't fork: $!");
30702  if ($pid) {
30703    eval {
30704      my $ssh2 = Net::SSH2->new();
30705
30706      sleep(1);
30707
30708      unless ($ssh2->connect('127.0.0.1', $port)) {
30709        my ($err_code, $err_name, $err_str) = $ssh2->error();
30710        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
30711      }
30712
30713      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
30714        my ($err_code, $err_name, $err_str) = $ssh2->error();
30715        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
30716      }
30717
30718      my $sftp = $ssh2->sftp();
30719      unless ($sftp) {
30720        my ($err_code, $err_name, $err_str) = $ssh2->error();
30721        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
30722      }
30723
30724      my $path = 'test.lnk';
30725      my $res = $sftp->mkdir($path);
30726      if ($res) {
30727        die("MKDIR $path succeeded unexpectedly");
30728      }
30729
30730      my ($err_code, $err_name) = $sftp->error();
30731      $self->assert($err_name eq 'SSH_FX_FAILURE',
30732        test_msg("Expected error name 'SSH_FX_FAILURE', got '$err_name'"));
30733
30734      $sftp = undef;
30735      $ssh2->disconnect();
30736
30737      $self->assert(!-d $test_dir,
30738        test_msg("Directory $test_dir exists unexpectedly"));
30739    };
30740    if ($@) {
30741      $ex = $@;
30742    }
30743
30744    $wfh->print("done\n");
30745    $wfh->flush();
30746
30747  } else {
30748    eval { server_wait($setup->{config_file}, $rfh) };
30749    if ($@) {
30750      warn($@);
30751      exit 1;
30752    }
30753
30754    exit 0;
30755  }
30756
30757  # Stop server
30758  server_stop($setup->{pid_file});
30759  $self->assert_child_ok($pid);
30760
30761  test_cleanup($setup->{log_file}, $ex);
30762}
30763
30764sub sftp_mkdir_abs_symlink_eexist_chrooted_bug4219 {
30765  my $self = shift;
30766  my $tmpdir = $self->{tmpdir};
30767  my $setup = test_setup($tmpdir, 'sftp');
30768
30769  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
30770  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
30771
30772  my $dst_path = $test_dir;
30773  if ($^O eq 'darwin') {
30774    # MacOSX-specific hack
30775    $dst_path = '/private' . $dst_path;
30776  }
30777
30778  unless (symlink($test_dir, $test_symlink)) {
30779    die("Can't symlink $test_symlink to $test_dir: $!");
30780  }
30781
30782  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
30783  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
30784
30785  my $config = {
30786    PidFile => $setup->{pid_file},
30787    ScoreboardFile => $setup->{scoreboard_file},
30788    SystemLog => $setup->{log_file},
30789    TraceLog => $setup->{log_file},
30790    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
30791
30792    AuthUserFile => $setup->{auth_user_file},
30793    AuthGroupFile => $setup->{auth_group_file},
30794
30795    DefaultRoot => '~',
30796
30797    IfModules => {
30798      'mod_delay.c' => {
30799        DelayEngine => 'off',
30800      },
30801
30802      'mod_sftp.c' => [
30803        "SFTPEngine on",
30804        "SFTPLog $setup->{log_file}",
30805        "SFTPHostKey $rsa_host_key",
30806        "SFTPHostKey $dsa_host_key",
30807      ],
30808    },
30809  };
30810
30811  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
30812    $config);
30813
30814  # Open pipes, for use between the parent and child processes.  Specifically,
30815  # the child will indicate when it's done with its test by writing a message
30816  # to the parent.
30817  my ($rfh, $wfh);
30818  unless (pipe($rfh, $wfh)) {
30819    die("Can't open pipe: $!");
30820  }
30821
30822  require Net::SSH2;
30823
30824  my $ex;
30825
30826  # Fork child
30827  $self->handle_sigchld();
30828  defined(my $pid = fork()) or die("Can't fork: $!");
30829  if ($pid) {
30830    eval {
30831      my $ssh2 = Net::SSH2->new();
30832
30833      sleep(1);
30834
30835      unless ($ssh2->connect('127.0.0.1', $port)) {
30836        my ($err_code, $err_name, $err_str) = $ssh2->error();
30837        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
30838      }
30839
30840      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
30841        my ($err_code, $err_name, $err_str) = $ssh2->error();
30842        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
30843      }
30844
30845      my $sftp = $ssh2->sftp();
30846      unless ($sftp) {
30847        my ($err_code, $err_name, $err_str) = $ssh2->error();
30848        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
30849      }
30850
30851      my $path = 'test.lnk';
30852      my $res = $sftp->mkdir($path);
30853      if ($res) {
30854        die("MKDIR $path succeeded unexpectedly");
30855      }
30856
30857      my ($err_code, $err_name) = $sftp->error();
30858      $self->assert($err_name eq 'SSH_FX_FAILURE',
30859        test_msg("Expected error name 'SSH_FX_FAILURE', got '$err_name'"));
30860
30861      $sftp = undef;
30862      $ssh2->disconnect();
30863
30864      $self->assert(!-d $test_dir,
30865        test_msg("Directory $test_dir exists unexpectedly"));
30866    };
30867    if ($@) {
30868      $ex = $@;
30869    }
30870
30871    $wfh->print("done\n");
30872    $wfh->flush();
30873
30874  } else {
30875    eval { server_wait($setup->{config_file}, $rfh) };
30876    if ($@) {
30877      warn($@);
30878      exit 1;
30879    }
30880
30881    exit 0;
30882  }
30883
30884  # Stop server
30885  server_stop($setup->{pid_file});
30886  $self->assert_child_ok($pid);
30887
30888  test_cleanup($setup->{log_file}, $ex);
30889}
30890
30891sub sftp_mkdir_rel_symlink_eexist {
30892  my $self = shift;
30893  my $tmpdir = $self->{tmpdir};
30894  my $setup = test_setup($tmpdir, 'sftp');
30895
30896  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
30897
30898  # Change to the test directory in order to create a relative path in the
30899  # symlink we need
30900
30901  my $cwd = getcwd();
30902  unless (chdir($tmpdir)) {
30903    die("Can't chdir to $tmpdir: $!");
30904  }
30905
30906  unless (symlink('./test.d', './test.lnk')) {
30907    die("Can't symlink 'test.lnk' to './test.d': $!");
30908  }
30909
30910  unless (chdir($cwd)) {
30911    die("Can't chdir to $cwd: $!");
30912  }
30913
30914  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
30915  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
30916
30917  my $config = {
30918    PidFile => $setup->{pid_file},
30919    ScoreboardFile => $setup->{scoreboard_file},
30920    SystemLog => $setup->{log_file},
30921    TraceLog => $setup->{log_file},
30922    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
30923
30924    AuthUserFile => $setup->{auth_user_file},
30925    AuthGroupFile => $setup->{auth_group_file},
30926
30927    IfModules => {
30928      'mod_delay.c' => {
30929        DelayEngine => 'off',
30930      },
30931
30932      'mod_sftp.c' => [
30933        "SFTPEngine on",
30934        "SFTPLog $setup->{log_file}",
30935        "SFTPHostKey $rsa_host_key",
30936        "SFTPHostKey $dsa_host_key",
30937      ],
30938    },
30939  };
30940
30941  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
30942    $config);
30943
30944  # Open pipes, for use between the parent and child processes.  Specifically,
30945  # the child will indicate when it's done with its test by writing a message
30946  # to the parent.
30947  my ($rfh, $wfh);
30948  unless (pipe($rfh, $wfh)) {
30949    die("Can't open pipe: $!");
30950  }
30951
30952  require Net::SSH2;
30953
30954  my $ex;
30955
30956  # Fork child
30957  $self->handle_sigchld();
30958  defined(my $pid = fork()) or die("Can't fork: $!");
30959  if ($pid) {
30960    eval {
30961      my $ssh2 = Net::SSH2->new();
30962
30963      sleep(1);
30964
30965      unless ($ssh2->connect('127.0.0.1', $port)) {
30966        my ($err_code, $err_name, $err_str) = $ssh2->error();
30967        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
30968      }
30969
30970      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
30971        my ($err_code, $err_name, $err_str) = $ssh2->error();
30972        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
30973      }
30974
30975      my $sftp = $ssh2->sftp();
30976      unless ($sftp) {
30977        my ($err_code, $err_name, $err_str) = $ssh2->error();
30978        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
30979      }
30980
30981      my $path = 'test.lnk';
30982      my $res = $sftp->mkdir($path);
30983      if ($res) {
30984        die("MKDIR $path succeeded unexpectedly");
30985      }
30986
30987      my ($err_code, $err_name) = $sftp->error();
30988      $self->assert($err_name eq 'SSH_FX_FAILURE',
30989        test_msg("Expected error name 'SSH_FX_FAILURE', got '$err_name'"));
30990
30991      $sftp = undef;
30992      $ssh2->disconnect();
30993
30994      $self->assert(!-d $test_dir,
30995        test_msg("Directory $test_dir exists unexpectedly"));
30996    };
30997    if ($@) {
30998      $ex = $@;
30999    }
31000
31001    $wfh->print("done\n");
31002    $wfh->flush();
31003
31004  } else {
31005    eval { server_wait($setup->{config_file}, $rfh) };
31006    if ($@) {
31007      warn($@);
31008      exit 1;
31009    }
31010
31011    exit 0;
31012  }
31013
31014  # Stop server
31015  server_stop($setup->{pid_file});
31016  $self->assert_child_ok($pid);
31017
31018  test_cleanup($setup->{log_file}, $ex);
31019}
31020
31021sub sftp_mkdir_rel_symlink_eexist_chrooted_bug4219 {
31022  my $self = shift;
31023  my $tmpdir = $self->{tmpdir};
31024  my $setup = test_setup($tmpdir, 'sftp');
31025
31026  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
31027
31028  # Change to the test directory in order to create a relative path in the
31029  # symlink we need
31030
31031  my $cwd = getcwd();
31032  unless (chdir($tmpdir)) {
31033    die("Can't chdir to $tmpdir: $!");
31034  }
31035
31036  unless (symlink('./test.d', './test.lnk')) {
31037    die("Can't symlink 'test.lnk' to './test.d': $!");
31038  }
31039
31040  unless (chdir($cwd)) {
31041    die("Can't chdir to $cwd: $!");
31042  }
31043
31044  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31045  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31046
31047  my $config = {
31048    PidFile => $setup->{pid_file},
31049    ScoreboardFile => $setup->{scoreboard_file},
31050    SystemLog => $setup->{log_file},
31051    TraceLog => $setup->{log_file},
31052    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
31053
31054    AuthUserFile => $setup->{auth_user_file},
31055    AuthGroupFile => $setup->{auth_group_file},
31056
31057    DefaultRoot => '~',
31058
31059    IfModules => {
31060      'mod_delay.c' => {
31061        DelayEngine => 'off',
31062      },
31063
31064      'mod_sftp.c' => [
31065        "SFTPEngine on",
31066        "SFTPLog $setup->{log_file}",
31067        "SFTPHostKey $rsa_host_key",
31068        "SFTPHostKey $dsa_host_key",
31069      ],
31070    },
31071  };
31072
31073  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
31074    $config);
31075
31076  # Open pipes, for use between the parent and child processes.  Specifically,
31077  # the child will indicate when it's done with its test by writing a message
31078  # to the parent.
31079  my ($rfh, $wfh);
31080  unless (pipe($rfh, $wfh)) {
31081    die("Can't open pipe: $!");
31082  }
31083
31084  require Net::SSH2;
31085
31086  my $ex;
31087
31088  # Fork child
31089  $self->handle_sigchld();
31090  defined(my $pid = fork()) or die("Can't fork: $!");
31091  if ($pid) {
31092    eval {
31093      my $ssh2 = Net::SSH2->new();
31094
31095      sleep(1);
31096
31097      unless ($ssh2->connect('127.0.0.1', $port)) {
31098        my ($err_code, $err_name, $err_str) = $ssh2->error();
31099        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
31100      }
31101
31102      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
31103        my ($err_code, $err_name, $err_str) = $ssh2->error();
31104        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
31105      }
31106
31107      my $sftp = $ssh2->sftp();
31108      unless ($sftp) {
31109        my ($err_code, $err_name, $err_str) = $ssh2->error();
31110        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
31111      }
31112
31113      my $path = 'test.lnk';
31114      my $res = $sftp->mkdir($path);
31115      if ($res) {
31116        die("MKDIR $path succeeded unexpectedly");
31117      }
31118
31119      my ($err_code, $err_name) = $sftp->error();
31120      $self->assert($err_name eq 'SSH_FX_FAILURE',
31121        test_msg("Expected error name 'SSH_FX_FAILURE', got '$err_name'"));
31122
31123      $sftp = undef;
31124      $ssh2->disconnect();
31125
31126      $self->assert(!-d $test_dir,
31127        test_msg("Directory $test_dir exists unexpectedly"));
31128    };
31129    if ($@) {
31130      $ex = $@;
31131    }
31132
31133    $wfh->print("done\n");
31134    $wfh->flush();
31135
31136  } else {
31137    eval { server_wait($setup->{config_file}, $rfh) };
31138    if ($@) {
31139      warn($@);
31140      exit 1;
31141    }
31142
31143    exit 0;
31144  }
31145
31146  # Stop server
31147  server_stop($setup->{pid_file});
31148  $self->assert_child_ok($pid);
31149
31150  test_cleanup($setup->{log_file}, $ex);
31151}
31152
31153sub sftp_mkdir_readdir_bug3481 {
31154  my $self = shift;
31155  my $tmpdir = $self->{tmpdir};
31156
31157  my $config_file = "$tmpdir/sftp.conf";
31158  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
31159  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
31160
31161  my $log_file = test_get_logfile();
31162
31163  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
31164  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
31165
31166  my $user = 'proftpd';
31167  my $passwd = 'test';
31168  my $group = 'ftpd';
31169  my $home_dir = File::Spec->rel2abs($tmpdir);
31170  my $uid = 500;
31171  my $gid = 500;
31172
31173  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
31174
31175  # Make sure that, if we're running as root, that the home directory has
31176  # permissions/privs set for the account we create
31177  if ($< == 0) {
31178    unless (chmod(0755, $home_dir)) {
31179      die("Can't set perms on $home_dir to 0755: $!");
31180    }
31181
31182    unless (chown($uid, $gid, $home_dir)) {
31183      die("Can't set owner of $home_dir to $uid/$gid: $!");
31184    }
31185  }
31186
31187  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
31188    '/bin/bash');
31189  auth_group_write($auth_group_file, $group, $gid, $user);
31190
31191  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31192  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31193
31194  my $config = {
31195    PidFile => $pid_file,
31196    ScoreboardFile => $scoreboard_file,
31197    SystemLog => $log_file,
31198    TraceLog => $log_file,
31199    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
31200
31201    AuthUserFile => $auth_user_file,
31202    AuthGroupFile => $auth_group_file,
31203
31204    IfModules => {
31205      'mod_delay.c' => {
31206        DelayEngine => 'off',
31207      },
31208
31209      'mod_sftp.c' => [
31210        "SFTPEngine on",
31211        "SFTPLog $log_file",
31212        "SFTPHostKey $rsa_host_key",
31213        "SFTPHostKey $dsa_host_key",
31214      ],
31215    },
31216  };
31217
31218  my ($port, $config_user, $config_group) = config_write($config_file, $config);
31219
31220  # Open pipes, for use between the parent and child processes.  Specifically,
31221  # the child will indicate when it's done with its test by writing a message
31222  # to the parent.
31223  my ($rfh, $wfh);
31224  unless (pipe($rfh, $wfh)) {
31225    die("Can't open pipe: $!");
31226  }
31227
31228  require Net::SSH2;
31229
31230  my $ex;
31231
31232  # See http://forums.proftpd.org/smf/index.php/topic,4759.0.html
31233
31234  # Fork child
31235  $self->handle_sigchld();
31236  defined(my $pid = fork()) or die("Can't fork: $!");
31237  if ($pid) {
31238    eval {
31239      my $ssh2 = Net::SSH2->new();
31240
31241      sleep(1);
31242
31243      unless ($ssh2->connect('127.0.0.1', $port)) {
31244        my ($err_code, $err_name, $err_str) = $ssh2->error();
31245        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
31246      }
31247
31248      unless ($ssh2->auth_password($user, $passwd)) {
31249        my ($err_code, $err_name, $err_str) = $ssh2->error();
31250        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
31251      }
31252
31253      my $sftp = $ssh2->sftp();
31254      unless ($sftp) {
31255        my ($err_code, $err_name, $err_str) = $ssh2->error();
31256        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
31257      }
31258
31259      my $res = $sftp->mkdir('testdir');
31260      unless ($res) {
31261        my ($err_code, $err_name) = $sftp->error();
31262        die("Can't mkdir testdir: [$err_name] ($err_code)");
31263      }
31264
31265      # Create 10 files in the sub directory
31266      my $count = 10;
31267      for (my $i = 0; $i < $count; $i++) {
31268        my $test_file = 'testdir/test_' . sprintf("%03s", $i);
31269
31270        my $fh = $sftp->open($test_file, O_CREAT, 0644);
31271        unless ($fh) {
31272          my ($err_code, $err_name) = $sftp->error();
31273          die("OPEN $test_file failed: [$err_name] ($err_code)");
31274        }
31275
31276        $fh = undef;
31277      }
31278
31279      # Now read the test directory twice
31280      my $dir = $sftp->opendir('testdir');
31281      unless ($dir) {
31282        my ($err_code, $err_name) = $sftp->error();
31283        die("OPENDIR testdir failed: [$err_name] ($err_code)");
31284      }
31285
31286      my $files1 = {};
31287
31288      my $file = $dir->read();
31289      while ($file) {
31290        $files1->{$file->{name}} = $file;
31291        $file = $dir->read();
31292      }
31293
31294      $dir = undef;
31295
31296      $dir = $sftp->opendir('testdir');
31297      unless ($dir) {
31298        my ($err_code, $err_name) = $sftp->error();
31299        die("OPENDIR testdir failed: [$err_name] ($err_code)");
31300      }
31301
31302      my $files2 = {};
31303
31304      $file = $dir->read();
31305      while ($file) {
31306        $files2->{$file->{name}} = $file;
31307        $file = $dir->read();
31308      }
31309
31310      $dir = undef;
31311
31312      # To close the SFTP channel, we have to explicitly destroy the object
31313      $sftp = undef;
31314
31315      # Make sure that the same paths were returned in the directory listings
31316      foreach my $file (keys(%$files1)) {
31317        unless (defined($files2->{$file})) {
31318          die("File $file unexpectedly missing from second READDIR");
31319        }
31320      }
31321
31322      foreach my $file (keys(%$files2)) {
31323        unless (defined($files1->{$file})) {
31324          die("File $file unexpectedly missing from first READDIR");
31325        }
31326      }
31327
31328      $ssh2->disconnect();
31329    };
31330
31331    if ($@) {
31332      $ex = $@;
31333    }
31334
31335    $wfh->print("done\n");
31336    $wfh->flush();
31337
31338  } else {
31339    eval { server_wait($config_file, $rfh) };
31340    if ($@) {
31341      warn($@);
31342      exit 1;
31343    }
31344
31345    exit 0;
31346  }
31347
31348  # Stop server
31349  server_stop($pid_file);
31350
31351  $self->assert_child_ok($pid);
31352
31353  if ($ex) {
31354    test_append_logfile($log_file, $ex);
31355    unlink($log_file);
31356
31357    die($ex);
31358  }
31359
31360  unlink($log_file);
31361}
31362
31363sub sftp_rmdir {
31364  my $self = shift;
31365  my $tmpdir = $self->{tmpdir};
31366  my $setup = test_setup($tmpdir, 'sftp');
31367
31368  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
31369  mkpath($test_dir);
31370
31371  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31372  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31373
31374  my $config = {
31375    PidFile => $setup->{pid_file},
31376    ScoreboardFile => $setup->{scoreboard_file},
31377    SystemLog => $setup->{log_file},
31378    TraceLog => $setup->{log_file},
31379    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
31380
31381    AuthUserFile => $setup->{auth_user_file},
31382    AuthGroupFile => $setup->{auth_group_file},
31383
31384    IfModules => {
31385      'mod_delay.c' => {
31386        DelayEngine => 'off',
31387      },
31388
31389      'mod_sftp.c' => [
31390        "SFTPEngine on",
31391        "SFTPLog $setup->{log_file}",
31392        "SFTPHostKey $rsa_host_key",
31393        "SFTPHostKey $dsa_host_key",
31394      ],
31395    },
31396  };
31397
31398  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
31399    $config);
31400
31401  # Open pipes, for use between the parent and child processes.  Specifically,
31402  # the child will indicate when it's done with its test by writing a message
31403  # to the parent.
31404  my ($rfh, $wfh);
31405  unless (pipe($rfh, $wfh)) {
31406    die("Can't open pipe: $!");
31407  }
31408
31409  require Net::SSH2;
31410
31411  my $ex;
31412
31413  # Fork child
31414  $self->handle_sigchld();
31415  defined(my $pid = fork()) or die("Can't fork: $!");
31416  if ($pid) {
31417    eval {
31418      my $ssh2 = Net::SSH2->new();
31419
31420      sleep(1);
31421
31422      unless ($ssh2->connect('127.0.0.1', $port)) {
31423        my ($err_code, $err_name, $err_str) = $ssh2->error();
31424        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
31425      }
31426
31427      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
31428        my ($err_code, $err_name, $err_str) = $ssh2->error();
31429        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
31430      }
31431
31432      my $sftp = $ssh2->sftp();
31433      unless ($sftp) {
31434        my ($err_code, $err_name, $err_str) = $ssh2->error();
31435        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
31436      }
31437
31438      my $path = 'test.d';
31439      my $res = $sftp->rmdir($path);
31440      unless ($res) {
31441        my ($err_code, $err_name) = $sftp->error();
31442        die("RMDIR $path failed: [$err_name] ($err_code)");
31443      }
31444
31445      $sftp = undef;
31446      $ssh2->disconnect();
31447
31448      $self->assert(!-d $test_dir,
31449        test_msg("Directory $test_dir exists unexpectedly"));
31450    };
31451    if ($@) {
31452      $ex = $@;
31453    }
31454
31455    $wfh->print("done\n");
31456    $wfh->flush();
31457
31458  } else {
31459    eval { server_wait($setup->{config_file}, $rfh) };
31460    if ($@) {
31461      warn($@);
31462      exit 1;
31463    }
31464
31465    exit 0;
31466  }
31467
31468  # Stop server
31469  server_stop($setup->{pid_file});
31470  $self->assert_child_ok($pid);
31471
31472  test_cleanup($setup->{log_file}, $ex);
31473}
31474
31475sub sftp_rmdir_dir_not_empty {
31476  my $self = shift;
31477  my $tmpdir = $self->{tmpdir};
31478
31479  my $config_file = "$tmpdir/sftp.conf";
31480  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
31481  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
31482
31483  my $log_file = test_get_logfile();
31484
31485  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
31486  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
31487
31488  my $user = 'proftpd';
31489  my $passwd = 'test';
31490  my $group = 'ftpd';
31491  my $home_dir = File::Spec->rel2abs($tmpdir);
31492  my $uid = 500;
31493  my $gid = 500;
31494
31495  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
31496  mkpath($test_dir);
31497
31498  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
31499  if (open(my $fh, "> $test_file")) {
31500    print $fh "Hello, World!\n";
31501    unless (close($fh)) {
31502      die("Can't write $test_file: $!");
31503    }
31504
31505  } else {
31506    die("Can't open $test_file: $!");
31507  }
31508
31509  # Make sure that, if we're running as root, that the home directory has
31510  # permissions/privs set for the account we create
31511  if ($< == 0) {
31512    unless (chmod(0755, $home_dir)) {
31513      die("Can't set perms on $home_dir to 0755: $!");
31514    }
31515
31516    unless (chown($uid, $gid, $home_dir)) {
31517      die("Can't set owner of $home_dir to $uid/$gid: $!");
31518    }
31519  }
31520
31521  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
31522    '/bin/bash');
31523  auth_group_write($auth_group_file, $group, $gid, $user);
31524
31525  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31526  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31527
31528  my $config = {
31529    PidFile => $pid_file,
31530    ScoreboardFile => $scoreboard_file,
31531    SystemLog => $log_file,
31532    TraceLog => $log_file,
31533    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
31534
31535    AuthUserFile => $auth_user_file,
31536    AuthGroupFile => $auth_group_file,
31537
31538    IfModules => {
31539      'mod_delay.c' => {
31540        DelayEngine => 'off',
31541      },
31542
31543      'mod_sftp.c' => [
31544        "SFTPEngine on",
31545        "SFTPLog $log_file",
31546        "SFTPHostKey $rsa_host_key",
31547        "SFTPHostKey $dsa_host_key",
31548      ],
31549    },
31550  };
31551
31552  my ($port, $config_user, $config_group) = config_write($config_file, $config);
31553
31554  # Open pipes, for use between the parent and child processes.  Specifically,
31555  # the child will indicate when it's done with its test by writing a message
31556  # to the parent.
31557  my ($rfh, $wfh);
31558  unless (pipe($rfh, $wfh)) {
31559    die("Can't open pipe: $!");
31560  }
31561
31562  require Net::SSH2;
31563
31564  my $ex;
31565
31566  # Fork child
31567  $self->handle_sigchld();
31568  defined(my $pid = fork()) or die("Can't fork: $!");
31569  if ($pid) {
31570    eval {
31571      my $ssh2 = Net::SSH2->new();
31572
31573      sleep(1);
31574
31575      unless ($ssh2->connect('127.0.0.1', $port)) {
31576        my ($err_code, $err_name, $err_str) = $ssh2->error();
31577        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
31578      }
31579
31580      unless ($ssh2->auth_password($user, $passwd)) {
31581        my ($err_code, $err_name, $err_str) = $ssh2->error();
31582        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
31583      }
31584
31585      my $sftp = $ssh2->sftp();
31586      unless ($sftp) {
31587        my ($err_code, $err_name, $err_str) = $ssh2->error();
31588        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
31589      }
31590
31591      my $res = $sftp->rmdir('testdir');
31592      if ($res) {
31593        die("RMDIR testdir succeeded unexpectedly");
31594      }
31595
31596      my ($err_code, $err_name) = $sftp->error();
31597
31598      my $expected = 'SSH_FX_FAILURE';
31599      $self->assert($expected eq $err_name,
31600        test_msg("Expected '$expected', got '$err_name'"));
31601
31602      $sftp = undef;
31603      $ssh2->disconnect();
31604
31605      unless (-d $test_dir) {
31606        die("$test_dir directory does not exist as expected");
31607      }
31608    };
31609
31610    if ($@) {
31611      $ex = $@;
31612    }
31613
31614    $wfh->print("done\n");
31615    $wfh->flush();
31616
31617  } else {
31618    eval { server_wait($config_file, $rfh) };
31619    if ($@) {
31620      warn($@);
31621      exit 1;
31622    }
31623
31624    exit 0;
31625  }
31626
31627  # Stop server
31628  server_stop($pid_file);
31629
31630  $self->assert_child_ok($pid);
31631
31632  if ($ex) {
31633    test_append_logfile($log_file, $ex);
31634    unlink($log_file);
31635
31636    die($ex);
31637  }
31638
31639  unlink($log_file);
31640}
31641
31642sub sftp_rmdir_abs_symlink {
31643  my $self = shift;
31644  my $tmpdir = $self->{tmpdir};
31645  my $setup = test_setup($tmpdir, 'sftp');
31646
31647  my $sub_dir = File::Spec->rel2abs("$tmpdir/sub.d");
31648  mkpath($sub_dir);
31649
31650  my $test_dir = File::Spec->rel2abs("$sub_dir/test.d");
31651  mkpath($test_dir);
31652
31653  my $test_symlink = File::Spec->rel2abs("$sub_dir/test.lnk");
31654
31655  my $dst_path = $test_dir;
31656  if ($^O eq 'darwin') {
31657    # MacOSX-specific hack
31658    $dst_path = '/private' . $dst_path;
31659  }
31660
31661  unless (symlink($dst_path, $test_symlink)) {
31662    die("Can't symlink $test_symlink to $dst_path: $!");
31663  }
31664
31665  if ($< == 0) {
31666    unless (chmod(0755, $sub_dir)) {
31667      die("Can't set perms on $sub_dir to 0755: $!");
31668    }
31669
31670    unless (chown($setup->{uid}, $setup->{gid}, $sub_dir)) {
31671      die("Can't set owner of $sub_dir to $setup->{uid}/$setup->{gid}: $!");
31672    }
31673  }
31674
31675  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31676  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31677
31678  my $config = {
31679    PidFile => $setup->{pid_file},
31680    ScoreboardFile => $setup->{scoreboard_file},
31681    SystemLog => $setup->{log_file},
31682    TraceLog => $setup->{log_file},
31683    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
31684
31685    AuthUserFile => $setup->{auth_user_file},
31686    AuthGroupFile => $setup->{auth_group_file},
31687
31688    IfModules => {
31689      'mod_delay.c' => {
31690        DelayEngine => 'off',
31691      },
31692
31693      'mod_sftp.c' => [
31694        "SFTPEngine on",
31695        "SFTPLog $setup->{log_file}",
31696        "SFTPHostKey $rsa_host_key",
31697        "SFTPHostKey $dsa_host_key",
31698      ],
31699    },
31700  };
31701
31702  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
31703    $config);
31704
31705  # Open pipes, for use between the parent and child processes.  Specifically,
31706  # the child will indicate when it's done with its test by writing a message
31707  # to the parent.
31708  my ($rfh, $wfh);
31709  unless (pipe($rfh, $wfh)) {
31710    die("Can't open pipe: $!");
31711  }
31712
31713  require Net::SSH2;
31714
31715  my $ex;
31716
31717  # Fork child
31718  $self->handle_sigchld();
31719  defined(my $pid = fork()) or die("Can't fork: $!");
31720  if ($pid) {
31721    eval {
31722      my $ssh2 = Net::SSH2->new();
31723
31724      sleep(1);
31725
31726      unless ($ssh2->connect('127.0.0.1', $port)) {
31727        my ($err_code, $err_name, $err_str) = $ssh2->error();
31728        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
31729      }
31730
31731      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
31732        my ($err_code, $err_name, $err_str) = $ssh2->error();
31733        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
31734      }
31735
31736      my $sftp = $ssh2->sftp();
31737      unless ($sftp) {
31738        my ($err_code, $err_name, $err_str) = $ssh2->error();
31739        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
31740      }
31741
31742      my $path = 'sub.d/test.lnk';
31743      my $res = $sftp->rmdir($path);
31744      unless ($res) {
31745        my ($err_code, $err_name) = $sftp->error();
31746        die("RMDIR $path failed: [$err_name] ($err_code)");
31747      }
31748
31749      $sftp = undef;
31750      $ssh2->disconnect();
31751
31752      $self->assert(!-d $test_dir,
31753        test_msg("Directory $test_dir exists unexpectedly"));
31754    };
31755    if ($@) {
31756      $ex = $@;
31757    }
31758
31759    $wfh->print("done\n");
31760    $wfh->flush();
31761
31762  } else {
31763    eval { server_wait($setup->{config_file}, $rfh) };
31764    if ($@) {
31765      warn($@);
31766      exit 1;
31767    }
31768
31769    exit 0;
31770  }
31771
31772  # Stop server
31773  server_stop($setup->{pid_file});
31774  $self->assert_child_ok($pid);
31775
31776  test_cleanup($setup->{log_file}, $ex);
31777}
31778
31779sub sftp_rmdir_abs_symlink_chrooted_bug4219 {
31780  my $self = shift;
31781  my $tmpdir = $self->{tmpdir};
31782  my $setup = test_setup($tmpdir, 'sftp');
31783
31784  my $sub_dir = File::Spec->rel2abs("$tmpdir/sub.d");
31785  mkpath($sub_dir);
31786
31787  my $test_dir = File::Spec->rel2abs("$sub_dir/test.d");
31788  mkpath($test_dir);
31789
31790  my $test_symlink = File::Spec->rel2abs("$sub_dir/test.lnk");
31791
31792  my $dst_path = $test_dir;
31793  if ($^O eq 'darwin') {
31794    # MacOSX-specific hack
31795    $dst_path = '/private' . $dst_path;
31796  }
31797
31798  unless (symlink($dst_path, $test_symlink)) {
31799    die("Can't symlink $test_symlink to $dst_path: $!");
31800  }
31801
31802  if ($< == 0) {
31803    unless (chmod(0755, $sub_dir)) {
31804      die("Can't set perms on $sub_dir to 0755: $!");
31805    }
31806
31807    unless (chown($setup->{uid}, $setup->{gid}, $sub_dir)) {
31808      die("Can't set owner of $sub_dir to $setup->{uid}/$setup->{gid}: $!");
31809    }
31810  }
31811
31812  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31813  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31814
31815  my $config = {
31816    PidFile => $setup->{pid_file},
31817    ScoreboardFile => $setup->{scoreboard_file},
31818    SystemLog => $setup->{log_file},
31819    TraceLog => $setup->{log_file},
31820    Trace => 'DEFAULT:10 fsio:20 ssh2:20 sftp:20 scp:20',
31821
31822    AuthUserFile => $setup->{auth_user_file},
31823    AuthGroupFile => $setup->{auth_group_file},
31824
31825    DefaultRoot => '~',
31826
31827    IfModules => {
31828      'mod_delay.c' => {
31829        DelayEngine => 'off',
31830      },
31831
31832      'mod_sftp.c' => [
31833        "SFTPEngine on",
31834        "SFTPLog $setup->{log_file}",
31835        "SFTPHostKey $rsa_host_key",
31836        "SFTPHostKey $dsa_host_key",
31837      ],
31838    },
31839  };
31840
31841  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
31842    $config);
31843
31844  # Open pipes, for use between the parent and child processes.  Specifically,
31845  # the child will indicate when it's done with its test by writing a message
31846  # to the parent.
31847  my ($rfh, $wfh);
31848  unless (pipe($rfh, $wfh)) {
31849    die("Can't open pipe: $!");
31850  }
31851
31852  require Net::SSH2;
31853
31854  my $ex;
31855
31856  # Fork child
31857  $self->handle_sigchld();
31858  defined(my $pid = fork()) or die("Can't fork: $!");
31859  if ($pid) {
31860    eval {
31861      my $ssh2 = Net::SSH2->new();
31862
31863      sleep(1);
31864
31865      unless ($ssh2->connect('127.0.0.1', $port)) {
31866        my ($err_code, $err_name, $err_str) = $ssh2->error();
31867        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
31868      }
31869
31870      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
31871        my ($err_code, $err_name, $err_str) = $ssh2->error();
31872        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
31873      }
31874
31875      my $sftp = $ssh2->sftp();
31876      unless ($sftp) {
31877        my ($err_code, $err_name, $err_str) = $ssh2->error();
31878        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
31879      }
31880
31881      my $path = 'sub.d/test.lnk';
31882      my $res = $sftp->rmdir($path);
31883      unless ($res) {
31884        my ($err_code, $err_name) = $sftp->error();
31885        die("RMDIR $path failed: [$err_name] ($err_code)");
31886      }
31887
31888      $sftp = undef;
31889      $ssh2->disconnect();
31890
31891      $self->assert(!-d $test_dir,
31892        test_msg("Directory $test_dir exists unexpectedly"));
31893    };
31894    if ($@) {
31895      $ex = $@;
31896    }
31897
31898    $wfh->print("done\n");
31899    $wfh->flush();
31900
31901  } else {
31902    eval { server_wait($setup->{config_file}, $rfh) };
31903    if ($@) {
31904      warn($@);
31905      exit 1;
31906    }
31907
31908    exit 0;
31909  }
31910
31911  # Stop server
31912  server_stop($setup->{pid_file});
31913  $self->assert_child_ok($pid);
31914
31915  test_cleanup($setup->{log_file}, $ex);
31916}
31917
31918sub sftp_rmdir_rel_symlink {
31919  my $self = shift;
31920  my $tmpdir = $self->{tmpdir};
31921  my $setup = test_setup($tmpdir, 'sftp');
31922
31923  my $sub_dir = File::Spec->rel2abs("$tmpdir/sub.d");
31924  mkpath($sub_dir);
31925
31926  my $test_dir = File::Spec->rel2abs("$sub_dir/test.d");
31927  mkpath($test_dir);
31928
31929  # Change to the test directory in order to create a relative path in the
31930  # symlink we need
31931
31932  my $cwd = getcwd();
31933  unless (chdir($sub_dir)) {
31934    die("Can't chdir to $sub_dir: $!");
31935  }
31936
31937  unless (symlink('./test.d', './test.lnk')) {
31938    die("Can't symlink 'test.lnk' to './test.d': $!");
31939  }
31940
31941  unless (chdir($cwd)) {
31942    die("Can't chdir to $cwd: $!");
31943  }
31944
31945  if ($< == 0) {
31946    unless (chmod(0755, $sub_dir)) {
31947      die("Can't set perms on $sub_dir to 0755: $!");
31948    }
31949
31950    unless (chown($setup->{uid}, $setup->{gid}, $sub_dir)) {
31951      die("Can't set owner of $sub_dir to $setup->{uid}/$setup->{gid}: $!");
31952    }
31953  }
31954
31955  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
31956  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
31957
31958  my $config = {
31959    PidFile => $setup->{pid_file},
31960    ScoreboardFile => $setup->{scoreboard_file},
31961    SystemLog => $setup->{log_file},
31962    TraceLog => $setup->{log_file},
31963    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
31964
31965    AuthUserFile => $setup->{auth_user_file},
31966    AuthGroupFile => $setup->{auth_group_file},
31967
31968    IfModules => {
31969      'mod_delay.c' => {
31970        DelayEngine => 'off',
31971      },
31972
31973      'mod_sftp.c' => [
31974        "SFTPEngine on",
31975        "SFTPLog $setup->{log_file}",
31976        "SFTPHostKey $rsa_host_key",
31977        "SFTPHostKey $dsa_host_key",
31978      ],
31979    },
31980  };
31981
31982  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
31983    $config);
31984
31985  # Open pipes, for use between the parent and child processes.  Specifically,
31986  # the child will indicate when it's done with its test by writing a message
31987  # to the parent.
31988  my ($rfh, $wfh);
31989  unless (pipe($rfh, $wfh)) {
31990    die("Can't open pipe: $!");
31991  }
31992
31993  require Net::SSH2;
31994
31995  my $ex;
31996
31997  # Fork child
31998  $self->handle_sigchld();
31999  defined(my $pid = fork()) or die("Can't fork: $!");
32000  if ($pid) {
32001    eval {
32002      my $ssh2 = Net::SSH2->new();
32003
32004      sleep(1);
32005
32006      unless ($ssh2->connect('127.0.0.1', $port)) {
32007        my ($err_code, $err_name, $err_str) = $ssh2->error();
32008        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32009      }
32010
32011      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
32012        my ($err_code, $err_name, $err_str) = $ssh2->error();
32013        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32014      }
32015
32016      my $sftp = $ssh2->sftp();
32017      unless ($sftp) {
32018        my ($err_code, $err_name, $err_str) = $ssh2->error();
32019        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32020      }
32021
32022      my $path = 'sub.d/test.lnk';
32023      my $res = $sftp->rmdir($path);
32024      unless ($res) {
32025        my ($err_code, $err_name) = $sftp->error();
32026        die("RMDIR $path failed: [$err_name] ($err_code)");
32027      }
32028
32029      $sftp = undef;
32030      $ssh2->disconnect();
32031
32032      $self->assert(!-d $test_dir,
32033        test_msg("Directory $test_dir exists unexpectedly"));
32034    };
32035    if ($@) {
32036      $ex = $@;
32037    }
32038
32039    $wfh->print("done\n");
32040    $wfh->flush();
32041
32042  } else {
32043    eval { server_wait($setup->{config_file}, $rfh) };
32044    if ($@) {
32045      warn($@);
32046      exit 1;
32047    }
32048
32049    exit 0;
32050  }
32051
32052  # Stop server
32053  server_stop($setup->{pid_file});
32054  $self->assert_child_ok($pid);
32055
32056  test_cleanup($setup->{log_file}, $ex);
32057}
32058
32059sub sftp_rmdir_rel_symlink_chrooted_bug4219 {
32060  my $self = shift;
32061  my $tmpdir = $self->{tmpdir};
32062  my $setup = test_setup($tmpdir, 'sftp');
32063
32064  my $sub_dir = File::Spec->rel2abs("$tmpdir/sub.d");
32065  mkpath($sub_dir);
32066
32067  my $test_dir = File::Spec->rel2abs("$sub_dir/test.d");
32068  mkpath($test_dir);
32069
32070  # Change to the test directory in order to create a relative path in the
32071  # symlink we need
32072
32073  my $cwd = getcwd();
32074  unless (chdir($sub_dir)) {
32075    die("Can't chdir to $sub_dir: $!");
32076  }
32077
32078  unless (symlink('./test.d', './test.lnk')) {
32079    die("Can't symlink 'test.lnk' to './test.d': $!");
32080  }
32081
32082  unless (chdir($cwd)) {
32083    die("Can't chdir to $cwd: $!");
32084  }
32085
32086  if ($< == 0) {
32087    unless (chmod(0755, $sub_dir)) {
32088      die("Can't set perms on $sub_dir to 0755: $!");
32089    }
32090
32091    unless (chown($setup->{uid}, $setup->{gid}, $sub_dir)) {
32092      die("Can't set owner of $sub_dir to $setup->{uid}/$setup->{gid}: $!");
32093    }
32094  }
32095
32096  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32097  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32098
32099  my $config = {
32100    PidFile => $setup->{pid_file},
32101    ScoreboardFile => $setup->{scoreboard_file},
32102    SystemLog => $setup->{log_file},
32103    TraceLog => $setup->{log_file},
32104    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32105
32106    AuthUserFile => $setup->{auth_user_file},
32107    AuthGroupFile => $setup->{auth_group_file},
32108
32109    DefaultRoot => '~',
32110
32111    IfModules => {
32112      'mod_delay.c' => {
32113        DelayEngine => 'off',
32114      },
32115
32116      'mod_sftp.c' => [
32117        "SFTPEngine on",
32118        "SFTPLog $setup->{log_file}",
32119        "SFTPHostKey $rsa_host_key",
32120        "SFTPHostKey $dsa_host_key",
32121      ],
32122    },
32123  };
32124
32125  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
32126    $config);
32127
32128  # Open pipes, for use between the parent and child processes.  Specifically,
32129  # the child will indicate when it's done with its test by writing a message
32130  # to the parent.
32131  my ($rfh, $wfh);
32132  unless (pipe($rfh, $wfh)) {
32133    die("Can't open pipe: $!");
32134  }
32135
32136  require Net::SSH2;
32137
32138  my $ex;
32139
32140  # Fork child
32141  $self->handle_sigchld();
32142  defined(my $pid = fork()) or die("Can't fork: $!");
32143  if ($pid) {
32144    eval {
32145      my $ssh2 = Net::SSH2->new();
32146
32147      sleep(1);
32148
32149      unless ($ssh2->connect('127.0.0.1', $port)) {
32150        my ($err_code, $err_name, $err_str) = $ssh2->error();
32151        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32152      }
32153
32154      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
32155        my ($err_code, $err_name, $err_str) = $ssh2->error();
32156        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32157      }
32158
32159      my $sftp = $ssh2->sftp();
32160      unless ($sftp) {
32161        my ($err_code, $err_name, $err_str) = $ssh2->error();
32162        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32163      }
32164
32165      my $path = 'sub.d/test.lnk';
32166      my $res = $sftp->rmdir($path);
32167      unless ($res) {
32168        my ($err_code, $err_name) = $sftp->error();
32169        die("RMDIR $path failed: [$err_name] ($err_code)");
32170      }
32171
32172      $sftp = undef;
32173      $ssh2->disconnect();
32174
32175      $self->assert(!-d $test_dir,
32176        test_msg("Directory $test_dir exists unexpectedly"));
32177    };
32178    if ($@) {
32179      $ex = $@;
32180    }
32181
32182    $wfh->print("done\n");
32183    $wfh->flush();
32184
32185  } else {
32186    eval { server_wait($setup->{config_file}, $rfh) };
32187    if ($@) {
32188      warn($@);
32189      exit 1;
32190    }
32191
32192    exit 0;
32193  }
32194
32195  # Stop server
32196  server_stop($setup->{pid_file});
32197  $self->assert_child_ok($pid);
32198
32199  test_cleanup($setup->{log_file}, $ex);
32200}
32201
32202sub sftp_remove {
32203  my $self = shift;
32204  my $tmpdir = $self->{tmpdir};
32205
32206  my $config_file = "$tmpdir/sftp.conf";
32207  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
32208  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
32209
32210  my $log_file = test_get_logfile();
32211
32212  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
32213  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
32214
32215  my $user = 'proftpd';
32216  my $passwd = 'test';
32217  my $group = 'ftpd';
32218  my $home_dir = File::Spec->rel2abs($tmpdir);
32219  my $uid = 500;
32220  my $gid = 500;
32221
32222  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
32223  if (open(my $fh, "> $test_file")) {
32224    print $fh "ABCD" x 8192;
32225
32226    unless (close($fh)) {
32227      die("Can't write $test_file: $!");
32228    }
32229
32230  } else {
32231    die("Can't open $test_file: $!");
32232  }
32233
32234  # Make sure that, if we're running as root, that the home directory has
32235  # permissions/privs set for the account we create
32236  if ($< == 0) {
32237    unless (chmod(0755, $home_dir)) {
32238      die("Can't set perms on $home_dir to 0755: $!");
32239    }
32240
32241    unless (chown($uid, $gid, $home_dir)) {
32242      die("Can't set owner of $home_dir to $uid/$gid: $!");
32243    }
32244  }
32245
32246  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
32247    '/bin/bash');
32248  auth_group_write($auth_group_file, $group, $gid, $user);
32249
32250  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32251  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32252
32253  my $config = {
32254    PidFile => $pid_file,
32255    ScoreboardFile => $scoreboard_file,
32256    SystemLog => $log_file,
32257    TraceLog => $log_file,
32258    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32259
32260    AuthUserFile => $auth_user_file,
32261    AuthGroupFile => $auth_group_file,
32262
32263    IfModules => {
32264      'mod_delay.c' => {
32265        DelayEngine => 'off',
32266      },
32267
32268      'mod_sftp.c' => [
32269        "SFTPEngine on",
32270        "SFTPLog $log_file",
32271        "SFTPHostKey $rsa_host_key",
32272        "SFTPHostKey $dsa_host_key",
32273      ],
32274    },
32275  };
32276
32277  my ($port, $config_user, $config_group) = config_write($config_file, $config);
32278
32279  # Open pipes, for use between the parent and child processes.  Specifically,
32280  # the child will indicate when it's done with its test by writing a message
32281  # to the parent.
32282  my ($rfh, $wfh);
32283  unless (pipe($rfh, $wfh)) {
32284    die("Can't open pipe: $!");
32285  }
32286
32287  require Net::SSH2;
32288
32289  my $ex;
32290
32291  # Fork child
32292  $self->handle_sigchld();
32293  defined(my $pid = fork()) or die("Can't fork: $!");
32294  if ($pid) {
32295    eval {
32296      my $ssh2 = Net::SSH2->new();
32297
32298      sleep(1);
32299
32300      unless ($ssh2->connect('127.0.0.1', $port)) {
32301        my ($err_code, $err_name, $err_str) = $ssh2->error();
32302        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32303      }
32304
32305      unless ($ssh2->auth_password($user, $passwd)) {
32306        my ($err_code, $err_name, $err_str) = $ssh2->error();
32307        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32308      }
32309
32310      my $sftp = $ssh2->sftp();
32311      unless ($sftp) {
32312        my ($err_code, $err_name, $err_str) = $ssh2->error();
32313        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32314      }
32315
32316      my $res = $sftp->unlink('test.txt');
32317      unless ($res) {
32318        my ($err_code, $err_name) = $sftp->error();
32319        die("Can't remove test.txt: [$err_name] ($err_code)");
32320      }
32321
32322      $sftp = undef;
32323      $ssh2->disconnect();
32324
32325      if (-f $test_file) {
32326        die("$test_file file exists unexpectedly");
32327      }
32328    };
32329
32330    if ($@) {
32331      $ex = $@;
32332    }
32333
32334    $wfh->print("done\n");
32335    $wfh->flush();
32336
32337  } else {
32338    eval { server_wait($config_file, $rfh) };
32339    if ($@) {
32340      warn($@);
32341      exit 1;
32342    }
32343
32344    exit 0;
32345  }
32346
32347  # Stop server
32348  server_stop($pid_file);
32349
32350  $self->assert_child_ok($pid);
32351
32352  if ($ex) {
32353    test_append_logfile($log_file, $ex);
32354    unlink($log_file);
32355
32356    die($ex);
32357  }
32358
32359  unlink($log_file);
32360}
32361
32362sub sftp_rename {
32363  my $self = shift;
32364  my $tmpdir = $self->{tmpdir};
32365
32366  my $config_file = "$tmpdir/sftp.conf";
32367  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
32368  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
32369
32370  my $log_file = test_get_logfile();
32371
32372  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
32373  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
32374
32375  my $user = 'proftpd';
32376  my $passwd = 'test';
32377  my $group = 'ftpd';
32378  my $home_dir = File::Spec->rel2abs($tmpdir);
32379  my $uid = 500;
32380  my $gid = 500;
32381
32382  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
32383  if (open(my $fh, "> $test_file")) {
32384    print $fh "ABCD" x 8192;
32385
32386    unless (close($fh)) {
32387      die("Can't write $test_file: $!");
32388    }
32389
32390  } else {
32391    die("Can't open $test_file: $!");
32392  }
32393
32394  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
32395
32396  # Make sure that, if we're running as root, that the home directory has
32397  # permissions/privs set for the account we create
32398  if ($< == 0) {
32399    unless (chmod(0755, $home_dir)) {
32400      die("Can't set perms on $home_dir to 0755: $!");
32401    }
32402
32403    unless (chown($uid, $gid, $home_dir)) {
32404      die("Can't set owner of $home_dir to $uid/$gid: $!");
32405    }
32406  }
32407
32408  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
32409    '/bin/bash');
32410  auth_group_write($auth_group_file, $group, $gid, $user);
32411
32412  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32413  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32414
32415  my $config = {
32416    PidFile => $pid_file,
32417    ScoreboardFile => $scoreboard_file,
32418    SystemLog => $log_file,
32419    TraceLog => $log_file,
32420    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32421
32422    AuthUserFile => $auth_user_file,
32423    AuthGroupFile => $auth_group_file,
32424
32425    IfModules => {
32426      'mod_delay.c' => {
32427        DelayEngine => 'off',
32428      },
32429
32430      'mod_sftp.c' => [
32431        "SFTPEngine on",
32432        "SFTPLog $log_file",
32433        "SFTPHostKey $rsa_host_key",
32434        "SFTPHostKey $dsa_host_key",
32435      ],
32436    },
32437  };
32438
32439  my ($port, $config_user, $config_group) = config_write($config_file, $config);
32440
32441  # Open pipes, for use between the parent and child processes.  Specifically,
32442  # the child will indicate when it's done with its test by writing a message
32443  # to the parent.
32444  my ($rfh, $wfh);
32445  unless (pipe($rfh, $wfh)) {
32446    die("Can't open pipe: $!");
32447  }
32448
32449  require Net::SSH2;
32450
32451  my $ex;
32452
32453  # Fork child
32454  $self->handle_sigchld();
32455  defined(my $pid = fork()) or die("Can't fork: $!");
32456  if ($pid) {
32457    eval {
32458      my $ssh2 = Net::SSH2->new();
32459
32460      sleep(1);
32461
32462      unless ($ssh2->connect('127.0.0.1', $port)) {
32463        my ($err_code, $err_name, $err_str) = $ssh2->error();
32464        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32465      }
32466
32467      unless ($ssh2->auth_password($user, $passwd)) {
32468        my ($err_code, $err_name, $err_str) = $ssh2->error();
32469        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32470      }
32471
32472      my $sftp = $ssh2->sftp();
32473      unless ($sftp) {
32474        my ($err_code, $err_name, $err_str) = $ssh2->error();
32475        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32476      }
32477
32478      my $res = $sftp->rename('test.txt', 'test2.txt');
32479      unless ($res) {
32480        my ($err_code, $err_name) = $sftp->error();
32481        die("Can't rename test.txt to test2.txt: [$err_name] ($err_code)");
32482      }
32483
32484      $sftp = undef;
32485      $ssh2->disconnect();
32486
32487      if (-f $test_file) {
32488        die("$test_file file exists unexpectedly");
32489      }
32490
32491      unless (-f $test_file2) {
32492        die("$test_file2 file does not exist as expected");
32493      }
32494    };
32495
32496    if ($@) {
32497      $ex = $@;
32498    }
32499
32500    $wfh->print("done\n");
32501    $wfh->flush();
32502
32503  } else {
32504    eval { server_wait($config_file, $rfh) };
32505    if ($@) {
32506      warn($@);
32507      exit 1;
32508    }
32509
32510    exit 0;
32511  }
32512
32513  # Stop server
32514  server_stop($pid_file);
32515
32516  $self->assert_child_ok($pid);
32517
32518  if ($ex) {
32519    test_append_logfile($log_file, $ex);
32520    unlink($log_file);
32521
32522    die($ex);
32523  }
32524
32525  unlink($log_file);
32526}
32527
32528sub sftp_symlink {
32529  my $self = shift;
32530  my $tmpdir = $self->{tmpdir};
32531  my $setup = test_setup($tmpdir, 'sftp');
32532
32533  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
32534  if (open(my $fh, "> $test_file")) {
32535    print $fh "ABCD" x 8192;
32536
32537    unless (close($fh)) {
32538      die("Can't write $test_file: $!");
32539    }
32540
32541  } else {
32542    die("Can't open $test_file: $!");
32543  }
32544
32545  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
32546
32547  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32548  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32549
32550  my $config = {
32551    PidFile => $setup->{pid_file},
32552    ScoreboardFile => $setup->{scoreboard_file},
32553    SystemLog => $setup->{log_file},
32554    TraceLog => $setup->{log_file},
32555    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32556
32557    AuthUserFile => $setup->{auth_user_file},
32558    AuthGroupFile => $setup->{auth_group_file},
32559
32560    IfModules => {
32561      'mod_delay.c' => {
32562        DelayEngine => 'off',
32563      },
32564
32565      'mod_sftp.c' => [
32566        "SFTPEngine on",
32567        "SFTPLog $setup->{log_file}",
32568        "SFTPHostKey $rsa_host_key",
32569        "SFTPHostKey $dsa_host_key",
32570      ],
32571    },
32572  };
32573
32574  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
32575    $config);
32576
32577  # Open pipes, for use between the parent and child processes.  Specifically,
32578  # the child will indicate when it's done with its test by writing a message
32579  # to the parent.
32580  my ($rfh, $wfh);
32581  unless (pipe($rfh, $wfh)) {
32582    die("Can't open pipe: $!");
32583  }
32584
32585  require Net::SSH2;
32586
32587  my $ex;
32588
32589  # Fork child
32590  $self->handle_sigchld();
32591  defined(my $pid = fork()) or die("Can't fork: $!");
32592  if ($pid) {
32593    eval {
32594      my $ssh2 = Net::SSH2->new();
32595
32596      sleep(1);
32597
32598      unless ($ssh2->connect('127.0.0.1', $port)) {
32599        my ($err_code, $err_name, $err_str) = $ssh2->error();
32600        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32601      }
32602
32603      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
32604        my ($err_code, $err_name, $err_str) = $ssh2->error();
32605        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32606      }
32607
32608      my $sftp = $ssh2->sftp();
32609      unless ($sftp) {
32610        my ($err_code, $err_name, $err_str) = $ssh2->error();
32611        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32612      }
32613
32614      my $res = $sftp->symlink('test.txt', 'test.lnk');
32615      unless ($res) {
32616        my ($err_code, $err_name) = $sftp->error();
32617        die("Can't symlink test.lnk to test.txt: [$err_name] ($err_code)");
32618      }
32619
32620      $sftp = undef;
32621      $ssh2->disconnect();
32622
32623      $self->assert(-l $test_symlink,
32624        test_msg("$test_symlink symlink does not exist as expected"));
32625
32626      # Make sure that the created symlink points to the target using a
32627      # RELATIVE path (Bug#4081).
32628      my $target = readlink($test_symlink);
32629      my $expected = 'test.txt';
32630      $self->assert($expected eq $target,
32631        test_msg("Expected target '$expected', got '$target'"));
32632    };
32633
32634    if ($@) {
32635      $ex = $@;
32636    }
32637
32638    $wfh->print("done\n");
32639    $wfh->flush();
32640
32641  } else {
32642    eval { server_wait($setup->{config_file}, $rfh) };
32643    if ($@) {
32644      warn($@);
32645      exit 1;
32646    }
32647
32648    exit 0;
32649  }
32650
32651  # Stop server
32652  server_stop($setup->{pid_file});
32653
32654  $self->assert_child_ok($pid);
32655  test_cleanup($setup->{log_file}, $ex);
32656}
32657
32658sub sftp_symlink_dst_already_exists {
32659  my $self = shift;
32660  my $tmpdir = $self->{tmpdir};
32661  my $setup = test_setup($tmpdir, 'sftp');
32662
32663  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
32664  if (open(my $fh, "> $test_file")) {
32665    print $fh "ABCD" x 8192;
32666
32667    unless (close($fh)) {
32668      die("Can't write $test_file: $!");
32669    }
32670
32671  } else {
32672    die("Can't open $test_file: $!");
32673  }
32674
32675  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
32676  if (open(my $fh, "> $test_symlink")) {
32677    close($fh);
32678
32679  } else {
32680    die("Can't open $test_symlink: $!");
32681  }
32682
32683  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32684  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32685
32686  my $config = {
32687    PidFile => $setup->{pid_file},
32688    ScoreboardFile => $setup->{scoreboard_file},
32689    SystemLog => $setup->{log_file},
32690    TraceLog => $setup->{log_file},
32691    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32692
32693    AuthUserFile => $setup->{auth_user_file},
32694    AuthGroupFile => $setup->{auth_group_file},
32695
32696    IfModules => {
32697      'mod_delay.c' => {
32698        DelayEngine => 'off',
32699      },
32700
32701      'mod_sftp.c' => [
32702        "SFTPEngine on",
32703        "SFTPLog $setup->{log_file}",
32704        "SFTPHostKey $rsa_host_key",
32705        "SFTPHostKey $dsa_host_key",
32706      ],
32707    },
32708  };
32709
32710  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
32711    $config);
32712
32713  # Open pipes, for use between the parent and child processes.  Specifically,
32714  # the child will indicate when it's done with its test by writing a message
32715  # to the parent.
32716  my ($rfh, $wfh);
32717  unless (pipe($rfh, $wfh)) {
32718    die("Can't open pipe: $!");
32719  }
32720
32721  require Net::SSH2;
32722
32723  my $ex;
32724
32725  # Fork child
32726  $self->handle_sigchld();
32727  defined(my $pid = fork()) or die("Can't fork: $!");
32728  if ($pid) {
32729    eval {
32730      my $ssh2 = Net::SSH2->new();
32731
32732      sleep(1);
32733
32734      unless ($ssh2->connect('127.0.0.1', $port)) {
32735        my ($err_code, $err_name, $err_str) = $ssh2->error();
32736        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32737      }
32738
32739      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
32740        my ($err_code, $err_name, $err_str) = $ssh2->error();
32741        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32742      }
32743
32744      my $sftp = $ssh2->sftp();
32745      unless ($sftp) {
32746        my ($err_code, $err_name, $err_str) = $ssh2->error();
32747        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32748      }
32749
32750      my $res = $sftp->symlink('test.txt', 'test.lnk');
32751      if ($res) {
32752        die("Symlink test.lnk to test.txt succeeded unexpectedly");
32753      }
32754
32755      my ($err_code, $err_name) = $sftp->error();
32756
32757      $sftp = undef;
32758      $ssh2->disconnect();
32759
32760      my $expected = 'SSH_FX_FAILURE';
32761      $self->assert($expected eq $err_name,
32762        test_msg("Expected '$expected', got '$err_name'"));
32763
32764      $self->assert(!-l $test_symlink,
32765        test_msg("$test_symlink symlink exists unexpectedly"));
32766    };
32767
32768    if ($@) {
32769      $ex = $@;
32770    }
32771
32772    $wfh->print("done\n");
32773    $wfh->flush();
32774
32775  } else {
32776    eval { server_wait($setup->{config_file}, $rfh) };
32777    if ($@) {
32778      warn($@);
32779      exit 1;
32780    }
32781
32782    exit 0;
32783  }
32784
32785  # Stop server
32786  server_stop($setup->{pid_file});
32787
32788  $self->assert_child_ok($pid);
32789  test_cleanup($setup->{log_file}, $ex);
32790}
32791
32792sub sftp_symlink_src_does_not_exist {
32793  my $self = shift;
32794  my $tmpdir = $self->{tmpdir};
32795
32796  my $config_file = "$tmpdir/sftp.conf";
32797  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
32798  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
32799
32800  my $log_file = test_get_logfile();
32801
32802  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
32803  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
32804
32805  my $user = 'proftpd';
32806  my $passwd = 'test';
32807  my $group = 'ftpd';
32808  my $home_dir = File::Spec->rel2abs($tmpdir);
32809  my $uid = 500;
32810  my $gid = 500;
32811
32812  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
32813  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
32814
32815  # Make sure that, if we're running as root, that the home directory has
32816  # permissions/privs set for the account we create
32817  if ($< == 0) {
32818    unless (chmod(0755, $home_dir)) {
32819      die("Can't set perms on $home_dir to 0755: $!");
32820    }
32821
32822    unless (chown($uid, $gid, $home_dir)) {
32823      die("Can't set owner of $home_dir to $uid/$gid: $!");
32824    }
32825  }
32826
32827  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
32828    '/bin/bash');
32829  auth_group_write($auth_group_file, $group, $gid, $user);
32830
32831  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32832  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32833
32834  my $config = {
32835    PidFile => $pid_file,
32836    ScoreboardFile => $scoreboard_file,
32837    SystemLog => $log_file,
32838    TraceLog => $log_file,
32839    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32840
32841    AuthUserFile => $auth_user_file,
32842    AuthGroupFile => $auth_group_file,
32843
32844    IfModules => {
32845      'mod_delay.c' => {
32846        DelayEngine => 'off',
32847      },
32848
32849      'mod_sftp.c' => [
32850        "SFTPEngine on",
32851        "SFTPLog $log_file",
32852        "SFTPHostKey $rsa_host_key",
32853        "SFTPHostKey $dsa_host_key",
32854      ],
32855    },
32856  };
32857
32858  my ($port, $config_user, $config_group) = config_write($config_file, $config);
32859
32860  # Open pipes, for use between the parent and child processes.  Specifically,
32861  # the child will indicate when it's done with its test by writing a message
32862  # to the parent.
32863  my ($rfh, $wfh);
32864  unless (pipe($rfh, $wfh)) {
32865    die("Can't open pipe: $!");
32866  }
32867
32868  require Net::SSH2;
32869
32870  my $ex;
32871
32872  # Fork child
32873  $self->handle_sigchld();
32874  defined(my $pid = fork()) or die("Can't fork: $!");
32875  if ($pid) {
32876    eval {
32877      my $ssh2 = Net::SSH2->new();
32878
32879      sleep(1);
32880
32881      unless ($ssh2->connect('127.0.0.1', $port)) {
32882        my ($err_code, $err_name, $err_str) = $ssh2->error();
32883        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
32884      }
32885
32886      unless ($ssh2->auth_password($user, $passwd)) {
32887        my ($err_code, $err_name, $err_str) = $ssh2->error();
32888        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
32889      }
32890
32891      my $sftp = $ssh2->sftp();
32892      unless ($sftp) {
32893        my ($err_code, $err_name, $err_str) = $ssh2->error();
32894        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
32895      }
32896
32897      my $res = $sftp->symlink('test.txt', 'test.lnk');
32898      unless ($res) {
32899        my ($err_code, $err_name) = $sftp->error();
32900        die("Symlink test.lnk to test.txt failed: [$err_name] ($err_code)");
32901      }
32902
32903
32904      $sftp = undef;
32905      $ssh2->disconnect();
32906
32907      $self->assert(-l $test_symlink,
32908        test_msg("$test_symlink symlink does not exist as expected"));
32909    };
32910
32911    if ($@) {
32912      $ex = $@;
32913    }
32914
32915    $wfh->print("done\n");
32916    $wfh->flush();
32917
32918  } else {
32919    eval { server_wait($config_file, $rfh) };
32920    if ($@) {
32921      warn($@);
32922      exit 1;
32923    }
32924
32925    exit 0;
32926  }
32927
32928  # Stop server
32929  server_stop($pid_file);
32930
32931  $self->assert_child_ok($pid);
32932
32933  if ($ex) {
32934    test_append_logfile($log_file, $ex);
32935    unlink($log_file);
32936
32937    die($ex);
32938  }
32939
32940  unlink($log_file);
32941}
32942
32943sub sftp_readlink_abs_dst {
32944  my $self = shift;
32945  my $tmpdir = $self->{tmpdir};
32946  my $setup = test_setup($tmpdir, 'sftp');
32947
32948  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
32949  if (open(my $fh, "> $test_file")) {
32950    print $fh "ABCD" x 8192;
32951
32952    unless (close($fh)) {
32953      die("Can't write $test_file: $!");
32954    }
32955
32956  } else {
32957    die("Can't open $test_file: $!");
32958  }
32959
32960  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
32961  unless (symlink($test_file, $test_symlink)) {
32962    die("Can't symlink $test_symlink to $test_file: $!");
32963  }
32964
32965  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
32966  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
32967
32968  my $config = {
32969    PidFile => $setup->{pid_file},
32970    ScoreboardFile => $setup->{scoreboard_file},
32971    SystemLog => $setup->{log_file},
32972    TraceLog => $setup->{log_file},
32973    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
32974
32975    AuthUserFile => $setup->{auth_user_file},
32976    AuthGroupFile => $setup->{auth_group_file},
32977
32978    IfModules => {
32979      'mod_delay.c' => {
32980        DelayEngine => 'off',
32981      },
32982
32983      'mod_sftp.c' => [
32984        "SFTPEngine on",
32985        "SFTPLog $setup->{log_file}",
32986        "SFTPHostKey $rsa_host_key",
32987        "SFTPHostKey $dsa_host_key",
32988      ],
32989    },
32990  };
32991
32992  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
32993    $config);
32994
32995  # Open pipes, for use between the parent and child processes.  Specifically,
32996  # the child will indicate when it's done with its test by writing a message
32997  # to the parent.
32998  my ($rfh, $wfh);
32999  unless (pipe($rfh, $wfh)) {
33000    die("Can't open pipe: $!");
33001  }
33002
33003  require Net::SSH2;
33004
33005  my $ex;
33006
33007  # Fork child
33008  $self->handle_sigchld();
33009  defined(my $pid = fork()) or die("Can't fork: $!");
33010  if ($pid) {
33011    eval {
33012      my $ssh2 = Net::SSH2->new();
33013
33014      sleep(1);
33015
33016      unless ($ssh2->connect('127.0.0.1', $port)) {
33017        my ($err_code, $err_name, $err_str) = $ssh2->error();
33018        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33019      }
33020
33021      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
33022        my ($err_code, $err_name, $err_str) = $ssh2->error();
33023        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33024      }
33025
33026      my $sftp = $ssh2->sftp();
33027      unless ($sftp) {
33028        my ($err_code, $err_name, $err_str) = $ssh2->error();
33029        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33030      }
33031
33032      my $path = $sftp->readlink('test.lnk');
33033      unless ($path) {
33034        my ($err_code, $err_name) = $sftp->error();
33035        die("Can't readlink test.lnk: [$err_name] ($err_code)");
33036      }
33037
33038      $sftp = undef;
33039      $ssh2->disconnect();
33040
33041      $self->assert($test_file eq $path,
33042        test_msg("Expected '$test_file', got '$path'"));
33043    };
33044
33045    if ($@) {
33046      $ex = $@;
33047    }
33048
33049    $wfh->print("done\n");
33050    $wfh->flush();
33051
33052  } else {
33053    eval { server_wait($setup->{config_file}, $rfh) };
33054    if ($@) {
33055      warn($@);
33056      exit 1;
33057    }
33058
33059    exit 0;
33060  }
33061
33062  # Stop server
33063  server_stop($setup->{pid_file});
33064  $self->assert_child_ok($pid);
33065
33066  test_cleanup($setup->{log_file}, $ex);
33067}
33068
33069sub sftp_readlink_abs_dst_chrooted_bug4219 {
33070  my $self = shift;
33071  my $tmpdir = $self->{tmpdir};
33072  my $setup = test_setup($tmpdir, 'sftp');
33073
33074  my $test_file = File::Spec->rel2abs("$setup->{home_dir}/test.txt");
33075  if (open(my $fh, "> $test_file")) {
33076    print $fh "ABCD" x 8192;
33077
33078    unless (close($fh)) {
33079      die("Can't write $test_file: $!");
33080    }
33081
33082  } else {
33083    die("Can't open $test_file: $!");
33084  }
33085
33086  my $test_symlink = File::Spec->rel2abs("$setup->{home_dir}/test.lnk");
33087
33088  my $dst_path = $test_file;
33089  if ($^O eq 'darwin') {
33090    # MacOSX-specific hack
33091    $dst_path = '/private' . $dst_path;
33092  }
33093
33094  unless (symlink($dst_path, $test_symlink)) {
33095    die("Can't symlink $test_symlink to $dst_path: $!");
33096  }
33097
33098  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33099  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33100
33101  my $config = {
33102    PidFile => $setup->{pid_file},
33103    ScoreboardFile => $setup->{scoreboard_file},
33104    SystemLog => $setup->{log_file},
33105    TraceLog => $setup->{log_file},
33106    Trace => 'fsio:20 ssh2:20 sftp:20 scp:20',
33107
33108    AuthUserFile => $setup->{auth_user_file},
33109    AuthGroupFile => $setup->{auth_group_file},
33110    DefaultRoot => '~',
33111
33112    IfModules => {
33113      'mod_delay.c' => {
33114        DelayEngine => 'off',
33115      },
33116
33117      'mod_sftp.c' => [
33118        "SFTPEngine on",
33119        "SFTPLog $setup->{log_file}",
33120        "SFTPHostKey $rsa_host_key",
33121        "SFTPHostKey $dsa_host_key",
33122      ],
33123    },
33124  };
33125
33126  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
33127    $config);
33128
33129  # Open pipes, for use between the parent and child processes.  Specifically,
33130  # the child will indicate when it's done with its test by writing a message
33131  # to the parent.
33132  my ($rfh, $wfh);
33133  unless (pipe($rfh, $wfh)) {
33134    die("Can't open pipe: $!");
33135  }
33136
33137  require Net::SSH2;
33138
33139  my $ex;
33140
33141  # Fork child
33142  $self->handle_sigchld();
33143  defined(my $pid = fork()) or die("Can't fork: $!");
33144  if ($pid) {
33145    eval {
33146      my $ssh2 = Net::SSH2->new();
33147
33148      sleep(1);
33149
33150      unless ($ssh2->connect('127.0.0.1', $port)) {
33151        my ($err_code, $err_name, $err_str) = $ssh2->error();
33152        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33153      }
33154
33155      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
33156        my ($err_code, $err_name, $err_str) = $ssh2->error();
33157        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33158      }
33159
33160      my $sftp = $ssh2->sftp();
33161      unless ($sftp) {
33162        my ($err_code, $err_name, $err_str) = $ssh2->error();
33163        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33164      }
33165
33166      my $path = $sftp->readlink('test.lnk');
33167      unless ($path) {
33168        my ($err_code, $err_name) = $sftp->error();
33169        die("Can't readlink test.lnk: [$err_name] ($err_code)");
33170      }
33171
33172      $sftp = undef;
33173      $ssh2->disconnect();
33174
33175      # Because we are chrooted, AND the absolute destination path is within
33176      # the chroot, the retrieved path will be adjusted for the chroot
33177      # (Bug#4219).
33178      my $expected = '/test.txt';
33179      $self->assert($expected eq $path,
33180        test_msg("Expected '$expected', got '$path'"));
33181    };
33182
33183    if ($@) {
33184      $ex = $@;
33185    }
33186
33187    $wfh->print("done\n");
33188    $wfh->flush();
33189
33190  } else {
33191    eval { server_wait($setup->{config_file}, $rfh) };
33192    if ($@) {
33193      warn($@);
33194      exit 1;
33195    }
33196
33197    exit 0;
33198  }
33199
33200  # Stop server
33201  server_stop($setup->{pid_file});
33202  $self->assert_child_ok($pid);
33203
33204  test_cleanup($setup->{log_file}, $ex);
33205}
33206
33207sub sftp_readlink_rel_dst {
33208  my $self = shift;
33209  my $tmpdir = $self->{tmpdir};
33210  my $setup = test_setup($tmpdir, 'sftp');
33211
33212  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
33213  if (open(my $fh, "> $test_file")) {
33214    print $fh "ABCD" x 8192;
33215
33216    unless (close($fh)) {
33217      die("Can't write $test_file: $!");
33218    }
33219
33220  } else {
33221    die("Can't open $test_file: $!");
33222  }
33223
33224  my $dst_path = './test.txt';
33225  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
33226  unless (symlink($dst_path, $test_symlink)) {
33227    die("Can't symlink $test_symlink to $dst_path: $!");
33228  }
33229
33230  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33231  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33232
33233  my $config = {
33234    PidFile => $setup->{pid_file},
33235    ScoreboardFile => $setup->{scoreboard_file},
33236    SystemLog => $setup->{log_file},
33237    TraceLog => $setup->{log_file},
33238    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
33239
33240    AuthUserFile => $setup->{auth_user_file},
33241    AuthGroupFile => $setup->{auth_group_file},
33242
33243    IfModules => {
33244      'mod_delay.c' => {
33245        DelayEngine => 'off',
33246      },
33247
33248      'mod_sftp.c' => [
33249        "SFTPEngine on",
33250        "SFTPLog $setup->{log_file}",
33251        "SFTPHostKey $rsa_host_key",
33252        "SFTPHostKey $dsa_host_key",
33253      ],
33254    },
33255  };
33256
33257  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
33258    $config);
33259
33260  # Open pipes, for use between the parent and child processes.  Specifically,
33261  # the child will indicate when it's done with its test by writing a message
33262  # to the parent.
33263  my ($rfh, $wfh);
33264  unless (pipe($rfh, $wfh)) {
33265    die("Can't open pipe: $!");
33266  }
33267
33268  require Net::SSH2;
33269
33270  my $ex;
33271
33272  # Fork child
33273  $self->handle_sigchld();
33274  defined(my $pid = fork()) or die("Can't fork: $!");
33275  if ($pid) {
33276    eval {
33277      my $ssh2 = Net::SSH2->new();
33278
33279      sleep(1);
33280
33281      unless ($ssh2->connect('127.0.0.1', $port)) {
33282        my ($err_code, $err_name, $err_str) = $ssh2->error();
33283        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33284      }
33285
33286      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
33287        my ($err_code, $err_name, $err_str) = $ssh2->error();
33288        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33289      }
33290
33291      my $sftp = $ssh2->sftp();
33292      unless ($sftp) {
33293        my ($err_code, $err_name, $err_str) = $ssh2->error();
33294        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33295      }
33296
33297      my $path = $sftp->readlink('test.lnk');
33298      unless ($path) {
33299        my ($err_code, $err_name) = $sftp->error();
33300        die("Can't readlink test.lnk: [$err_name] ($err_code)");
33301      }
33302
33303      $sftp = undef;
33304      $ssh2->disconnect();
33305
33306      $self->assert($dst_path eq $path,
33307        test_msg("Expected '$dst_path', got '$path'"));
33308    };
33309
33310    if ($@) {
33311      $ex = $@;
33312    }
33313
33314    $wfh->print("done\n");
33315    $wfh->flush();
33316
33317  } else {
33318    eval { server_wait($setup->{config_file}, $rfh) };
33319    if ($@) {
33320      warn($@);
33321      exit 1;
33322    }
33323
33324    exit 0;
33325  }
33326
33327  # Stop server
33328  server_stop($setup->{pid_file});
33329  $self->assert_child_ok($pid);
33330
33331  test_cleanup($setup->{log_file}, $ex);
33332}
33333
33334sub sftp_readlink_rel_dst_chrooted_bug4219 {
33335  my $self = shift;
33336  my $tmpdir = $self->{tmpdir};
33337  my $setup = test_setup($tmpdir, 'sftp');
33338
33339  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
33340  if (open(my $fh, "> $test_file")) {
33341    print $fh "ABCD" x 8192;
33342
33343    unless (close($fh)) {
33344      die("Can't write $test_file: $!");
33345    }
33346
33347  } else {
33348    die("Can't open $test_file: $!");
33349  }
33350
33351  my $dst_path = './test.txt';
33352  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
33353  unless (symlink($dst_path, $test_symlink)) {
33354    die("Can't symlink $test_symlink to $dst_path: $!");
33355  }
33356
33357  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33358  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33359
33360  my $config = {
33361    PidFile => $setup->{pid_file},
33362    ScoreboardFile => $setup->{scoreboard_file},
33363    SystemLog => $setup->{log_file},
33364    TraceLog => $setup->{log_file},
33365    Trace => 'fsio:20 ssh2:20 sftp:20 scp:20',
33366
33367    AuthUserFile => $setup->{auth_user_file},
33368    AuthGroupFile => $setup->{auth_group_file},
33369    DefaultRoot => '~',
33370
33371    IfModules => {
33372      'mod_delay.c' => {
33373        DelayEngine => 'off',
33374      },
33375
33376      'mod_sftp.c' => [
33377        "SFTPEngine on",
33378        "SFTPLog $setup->{log_file}",
33379        "SFTPHostKey $rsa_host_key",
33380        "SFTPHostKey $dsa_host_key",
33381      ],
33382    },
33383  };
33384
33385  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
33386    $config);
33387
33388  # Open pipes, for use between the parent and child processes.  Specifically,
33389  # the child will indicate when it's done with its test by writing a message
33390  # to the parent.
33391  my ($rfh, $wfh);
33392  unless (pipe($rfh, $wfh)) {
33393    die("Can't open pipe: $!");
33394  }
33395
33396  require Net::SSH2;
33397
33398  my $ex;
33399
33400  # Fork child
33401  $self->handle_sigchld();
33402  defined(my $pid = fork()) or die("Can't fork: $!");
33403  if ($pid) {
33404    eval {
33405      my $ssh2 = Net::SSH2->new();
33406
33407      sleep(1);
33408
33409      unless ($ssh2->connect('127.0.0.1', $port)) {
33410        my ($err_code, $err_name, $err_str) = $ssh2->error();
33411        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33412      }
33413
33414      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
33415        my ($err_code, $err_name, $err_str) = $ssh2->error();
33416        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33417      }
33418
33419      my $sftp = $ssh2->sftp();
33420      unless ($sftp) {
33421        my ($err_code, $err_name, $err_str) = $ssh2->error();
33422        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33423      }
33424
33425      my $path = $sftp->readlink('test.lnk');
33426      unless ($path) {
33427        my ($err_code, $err_name) = $sftp->error();
33428        die("Can't readlink test.lnk: [$err_name] ($err_code)");
33429      }
33430
33431      $sftp = undef;
33432      $ssh2->disconnect();
33433
33434      $self->assert($dst_path eq $path,
33435        test_msg("Expected '$dst_path', got '$path'"));
33436    };
33437
33438    if ($@) {
33439      $ex = $@;
33440    }
33441
33442    $wfh->print("done\n");
33443    $wfh->flush();
33444
33445  } else {
33446    eval { server_wait($setup->{config_file}, $rfh) };
33447    if ($@) {
33448      warn($@);
33449      exit 1;
33450    }
33451
33452    exit 0;
33453  }
33454
33455  # Stop server
33456  server_stop($setup->{pid_file});
33457  $self->assert_child_ok($pid);
33458
33459  test_cleanup($setup->{log_file}, $ex);
33460}
33461
33462sub sftp_readlink_symlink_dir_bug4140 {
33463  my $self = shift;
33464  my $tmpdir = $self->{tmpdir};
33465
33466  my $config_file = "$tmpdir/sftp.conf";
33467  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
33468  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
33469
33470  my $log_file = test_get_logfile();
33471
33472  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
33473  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
33474
33475  my $user = 'proftpd';
33476  my $passwd = 'test';
33477  my $group = 'ftpd';
33478  my $home_dir = File::Spec->rel2abs($tmpdir);
33479  my $uid = 500;
33480  my $gid = 500;
33481
33482  # Make sure that, if we're running as root, that the home directory has
33483  # permissions/privs set for the account we create
33484  if ($< == 0) {
33485    unless (chmod(0755, $home_dir)) {
33486      die("Can't set perms on $home_dir to 0755: $!");
33487    }
33488
33489    unless (chown($uid, $gid, $home_dir)) {
33490      die("Can't set owner of $home_dir to $uid/$gid: $!");
33491    }
33492  }
33493
33494  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
33495    '/bin/bash');
33496  auth_group_write($auth_group_file, $group, $gid, $user);
33497
33498  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33499  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33500
33501  my $dir_name = 'test.d';
33502  my $test_dir = File::Spec->rel2abs("$tmpdir/$dir_name");
33503  mkpath($test_dir);
33504
33505  my $cwd = getcwd();
33506  unless (chdir($tmpdir)) {
33507    die("Can't chdir to $tmpdir: $!");
33508  }
33509
33510  unless (symlink('test.d', 'test.lnk')) {
33511    die("Can't symlink 'test.d' to 'test.lnk': $!");
33512  }
33513
33514  unless (chdir($cwd)) {
33515    die("Can't chdir to $cwd: $!");
33516  }
33517
33518  my $config = {
33519    PidFile => $pid_file,
33520    ScoreboardFile => $scoreboard_file,
33521    SystemLog => $log_file,
33522    TraceLog => $log_file,
33523    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
33524
33525    AuthUserFile => $auth_user_file,
33526    AuthGroupFile => $auth_group_file,
33527
33528    IfModules => {
33529      'mod_delay.c' => {
33530        DelayEngine => 'off',
33531      },
33532
33533      'mod_sftp.c' => [
33534        "SFTPEngine on",
33535        "SFTPLog $log_file",
33536        "SFTPHostKey $rsa_host_key",
33537        "SFTPHostKey $dsa_host_key",
33538      ],
33539    },
33540  };
33541
33542  my ($port, $config_user, $config_group) = config_write($config_file, $config);
33543
33544  # Open pipes, for use between the parent and child processes.  Specifically,
33545  # the child will indicate when it's done with its test by writing a message
33546  # to the parent.
33547  my ($rfh, $wfh);
33548  unless (pipe($rfh, $wfh)) {
33549    die("Can't open pipe: $!");
33550  }
33551
33552  require Net::SSH2;
33553
33554  my $ex;
33555
33556  # Fork child
33557  $self->handle_sigchld();
33558  defined(my $pid = fork()) or die("Can't fork: $!");
33559  if ($pid) {
33560    eval {
33561      my $ssh2 = Net::SSH2->new();
33562
33563      sleep(1);
33564
33565      unless ($ssh2->connect('127.0.0.1', $port)) {
33566        my ($err_code, $err_name, $err_str) = $ssh2->error();
33567        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33568      }
33569
33570      unless ($ssh2->auth_password($user, $passwd)) {
33571        my ($err_code, $err_name, $err_str) = $ssh2->error();
33572        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33573      }
33574
33575      my $sftp = $ssh2->sftp();
33576      unless ($sftp) {
33577        my ($err_code, $err_name, $err_str) = $ssh2->error();
33578        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33579      }
33580
33581      my $path = $sftp->readlink('test.lnk');
33582      unless ($path) {
33583        my ($err_code, $err_name) = $sftp->error();
33584        die("Can't readlink test.lnk: [$err_name] ($err_code)");
33585      }
33586
33587      $sftp = undef;
33588      $ssh2->disconnect();
33589
33590      $self->assert($dir_name eq $path,
33591        test_msg("Expected '$dir_name', got '$path'"));
33592    };
33593
33594    if ($@) {
33595      $ex = $@;
33596    }
33597
33598    $wfh->print("done\n");
33599    $wfh->flush();
33600
33601  } else {
33602    eval { server_wait($config_file, $rfh) };
33603    if ($@) {
33604      warn($@);
33605      exit 1;
33606    }
33607
33608    exit 0;
33609  }
33610
33611  # Stop server
33612  server_stop($pid_file);
33613
33614  $self->assert_child_ok($pid);
33615
33616  if ($ex) {
33617    test_append_logfile($log_file, $ex);
33618    unlink($log_file);
33619
33620    die($ex);
33621  }
33622
33623  unlink($log_file);
33624}
33625
33626sub sftp_config_allowoverwrite {
33627  my $self = shift;
33628  my $tmpdir = $self->{tmpdir};
33629
33630  my $config_file = "$tmpdir/sftp.conf";
33631  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
33632  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
33633
33634  my $log_file = test_get_logfile();
33635
33636  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
33637  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
33638
33639  my $user = 'proftpd';
33640  my $passwd = 'test';
33641  my $group = 'ftpd';
33642  my $home_dir = File::Spec->rel2abs($tmpdir);
33643  my $uid = 500;
33644  my $gid = 500;
33645
33646  # Make sure that, if we're running as root, that the home directory has
33647  # permissions/privs set for the account we create
33648  if ($< == 0) {
33649    unless (chmod(0755, $home_dir)) {
33650      die("Can't set perms on $home_dir to 0755: $!");
33651    }
33652
33653    unless (chown($uid, $gid, $home_dir)) {
33654      die("Can't set owner of $home_dir to $uid/$gid: $!");
33655    }
33656  }
33657
33658  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
33659    '/bin/bash');
33660  auth_group_write($auth_group_file, $group, $gid, $user);
33661
33662  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33663  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33664
33665  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
33666  if (open(my $fh, "> $test_file")) {
33667    close($fh);
33668
33669  } else {
33670    die("Can't open $test_file: $!");
33671  }
33672
33673  my $config = {
33674    PidFile => $pid_file,
33675    ScoreboardFile => $scoreboard_file,
33676    SystemLog => $log_file,
33677    TraceLog => $log_file,
33678    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
33679
33680    AuthUserFile => $auth_user_file,
33681    AuthGroupFile => $auth_group_file,
33682
33683    Directory => {
33684      '~' => {
33685        AllowOverwrite => 'off',
33686      },
33687    },
33688
33689    IfModules => {
33690      'mod_delay.c' => {
33691        DelayEngine => 'off',
33692      },
33693
33694      'mod_sftp.c' => [
33695        "SFTPEngine on",
33696        "SFTPLog $log_file",
33697        "SFTPHostKey $rsa_host_key",
33698        "SFTPHostKey $dsa_host_key",
33699      ],
33700    },
33701  };
33702
33703  my ($port, $config_user, $config_group) = config_write($config_file, $config);
33704
33705  # Open pipes, for use between the parent and child processes.  Specifically,
33706  # the child will indicate when it's done with its test by writing a message
33707  # to the parent.
33708  my ($rfh, $wfh);
33709  unless (pipe($rfh, $wfh)) {
33710    die("Can't open pipe: $!");
33711  }
33712
33713  require Net::SSH2;
33714
33715  my $ex;
33716
33717  # Ignore SIGPIPE
33718  local $SIG{PIPE} = sub { };
33719
33720  # Fork child
33721  $self->handle_sigchld();
33722  defined(my $pid = fork()) or die("Can't fork: $!");
33723  if ($pid) {
33724    eval {
33725      my $ssh2 = Net::SSH2->new();
33726
33727      sleep(1);
33728
33729      unless ($ssh2->connect('127.0.0.1', $port)) {
33730        my ($err_code, $err_name, $err_str) = $ssh2->error();
33731        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33732      }
33733
33734      unless ($ssh2->auth_password($user, $passwd)) {
33735        my ($err_code, $err_name, $err_str) = $ssh2->error();
33736        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33737      }
33738
33739      my $sftp = $ssh2->sftp();
33740      unless ($sftp) {
33741        my ($err_code, $err_name, $err_str) = $ssh2->error();
33742        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33743      }
33744
33745      my $fh = $sftp->open('test.txt', O_WRONLY);
33746      if ($fh) {
33747        $fh = undef;
33748        die("OPEN test.txt succeeded unexpectedly");
33749      }
33750
33751      my ($err_code, $err_name) = $sftp->error();
33752      $sftp = undef;
33753      $ssh2->disconnect();
33754
33755      my $expected = 'SSH_FX_PERMISSION_DENIED';
33756      $self->assert($expected eq $err_name,
33757        test_msg("Expected '$expected', got '$err_name'"));
33758    };
33759
33760    if ($@) {
33761      $ex = $@;
33762    }
33763
33764    $wfh->print("done\n");
33765    $wfh->flush();
33766
33767  } else {
33768    eval { server_wait($config_file, $rfh) };
33769    if ($@) {
33770      warn($@);
33771      exit 1;
33772    }
33773
33774    exit 0;
33775  }
33776
33777  # Stop server
33778  server_stop($pid_file);
33779
33780  $self->assert_child_ok($pid);
33781
33782  if ($ex) {
33783    test_append_logfile($log_file, $ex);
33784    unlink($log_file);
33785
33786    die($ex);
33787  }
33788
33789  unlink($log_file);
33790}
33791
33792sub sftp_config_allowstorerestart {
33793  my $self = shift;
33794  my $tmpdir = $self->{tmpdir};
33795
33796  my $config_file = "$tmpdir/sftp.conf";
33797  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
33798  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
33799
33800  my $log_file = test_get_logfile();
33801
33802  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
33803  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
33804
33805  my $user = 'proftpd';
33806  my $passwd = 'test';
33807  my $group = 'ftpd';
33808  my $home_dir = File::Spec->rel2abs($tmpdir);
33809  my $uid = 500;
33810  my $gid = 500;
33811
33812  # Make sure that, if we're running as root, that the home directory has
33813  # permissions/privs set for the account we create
33814  if ($< == 0) {
33815    unless (chmod(0755, $home_dir)) {
33816      die("Can't set perms on $home_dir to 0755: $!");
33817    }
33818
33819    unless (chown($uid, $gid, $home_dir)) {
33820      die("Can't set owner of $home_dir to $uid/$gid: $!");
33821    }
33822  }
33823
33824  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
33825    '/bin/bash');
33826  auth_group_write($auth_group_file, $group, $gid, $user);
33827
33828  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33829  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33830
33831  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
33832  if (open(my $fh, "> $test_file")) {
33833    print $fh "ABCD\n";
33834    unless (close($fh)) {
33835      die("Can't write $test_file: $!");
33836    }
33837
33838  } else {
33839    die("Can't open $test_file: $!");
33840  }
33841
33842  my $config = {
33843    PidFile => $pid_file,
33844    ScoreboardFile => $scoreboard_file,
33845    SystemLog => $log_file,
33846    TraceLog => $log_file,
33847    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
33848
33849    AuthUserFile => $auth_user_file,
33850    AuthGroupFile => $auth_group_file,
33851
33852    Directory => {
33853      '~' => {
33854        AllowOverwrite => 'on',
33855      },
33856    },
33857
33858    IfModules => {
33859      'mod_delay.c' => {
33860        DelayEngine => 'off',
33861      },
33862
33863      'mod_sftp.c' => [
33864        "SFTPEngine on",
33865        "SFTPLog $log_file",
33866        "SFTPHostKey $rsa_host_key",
33867        "SFTPHostKey $dsa_host_key",
33868      ],
33869    },
33870  };
33871
33872  my ($port, $config_user, $config_group) = config_write($config_file, $config);
33873
33874  # Open pipes, for use between the parent and child processes.  Specifically,
33875  # the child will indicate when it's done with its test by writing a message
33876  # to the parent.
33877  my ($rfh, $wfh);
33878  unless (pipe($rfh, $wfh)) {
33879    die("Can't open pipe: $!");
33880  }
33881
33882  require Net::SSH2;
33883
33884  my $ex;
33885
33886  # Ignore SIGPIPE
33887  local $SIG{PIPE} = sub { };
33888
33889  # Fork child
33890  $self->handle_sigchld();
33891  defined(my $pid = fork()) or die("Can't fork: $!");
33892  if ($pid) {
33893    eval {
33894      my $ssh2 = Net::SSH2->new();
33895
33896      sleep(1);
33897
33898      unless ($ssh2->connect('127.0.0.1', $port)) {
33899        my ($err_code, $err_name, $err_str) = $ssh2->error();
33900        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
33901      }
33902
33903      unless ($ssh2->auth_password($user, $passwd)) {
33904        my ($err_code, $err_name, $err_str) = $ssh2->error();
33905        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
33906      }
33907
33908      my $sftp = $ssh2->sftp();
33909      unless ($sftp) {
33910        my ($err_code, $err_name, $err_str) = $ssh2->error();
33911        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
33912      }
33913
33914      my $fh = $sftp->open('test.txt', O_WRONLY|O_APPEND);
33915      if ($fh) {
33916        $fh = undef;
33917        die("OPEN test.txt succeeded unexpectedly");
33918      }
33919
33920      my ($err_code, $err_name) = $sftp->error();
33921      $sftp = undef;
33922      $ssh2->disconnect();
33923
33924      my $expected = 'SSH_FX_PERMISSION_DENIED';
33925      $self->assert($expected eq $err_name,
33926        test_msg("Expected '$expected', got '$err_name'"));
33927    };
33928
33929    if ($@) {
33930      $ex = $@;
33931    }
33932
33933    $wfh->print("done\n");
33934    $wfh->flush();
33935
33936  } else {
33937    eval { server_wait($config_file, $rfh) };
33938    if ($@) {
33939      warn($@);
33940      exit 1;
33941    }
33942
33943    exit 0;
33944  }
33945
33946  # Stop server
33947  server_stop($pid_file);
33948
33949  $self->assert_child_ok($pid);
33950
33951  if ($ex) {
33952    test_append_logfile($log_file, $ex);
33953    unlink($log_file);
33954
33955    die($ex);
33956  }
33957
33958  unlink($log_file);
33959}
33960
33961sub sftp_config_client_alive {
33962  my $self = shift;
33963  my $tmpdir = $self->{tmpdir};
33964
33965  my $config_file = "$tmpdir/sftp.conf";
33966  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
33967  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
33968
33969  my $log_file = test_get_logfile();
33970
33971  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
33972  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
33973
33974  my $user = 'proftpd';
33975  my $passwd = 'test';
33976  my $group = 'ftpd';
33977  my $home_dir = File::Spec->rel2abs($tmpdir);
33978  my $uid = 500;
33979  my $gid = 500;
33980
33981  # Make sure that, if we're running as root, that the home directory has
33982  # permissions/privs set for the account we create
33983  if ($< == 0) {
33984    unless (chmod(0755, $home_dir)) {
33985      die("Can't set perms on $home_dir to 0755: $!");
33986    }
33987
33988    unless (chown($uid, $gid, $home_dir)) {
33989      die("Can't set owner of $home_dir to $uid/$gid: $!");
33990    }
33991  }
33992
33993  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
33994    '/bin/bash');
33995  auth_group_write($auth_group_file, $group, $gid, $user);
33996
33997  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
33998  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
33999
34000  my $timeout_idle = 30;
34001
34002  my $client_alive_max = 5;
34003  my $client_alive_interval = 1;
34004
34005  my $config = {
34006    PidFile => $pid_file,
34007    ScoreboardFile => $scoreboard_file,
34008    SystemLog => $log_file,
34009    TraceLog => $log_file,
34010    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
34011
34012    AuthUserFile => $auth_user_file,
34013    AuthGroupFile => $auth_group_file,
34014    TimeoutIdle => $timeout_idle,
34015
34016    IfModules => {
34017      'mod_delay.c' => {
34018        DelayEngine => 'off',
34019      },
34020
34021      'mod_sftp.c' => [
34022        "SFTPEngine on",
34023        "SFTPLog $log_file",
34024        "SFTPHostKey $rsa_host_key",
34025        "SFTPHostKey $dsa_host_key",
34026
34027        "SFTPClientAlive $client_alive_max $client_alive_interval",
34028      ],
34029    },
34030  };
34031
34032  my ($port, $config_user, $config_group) = config_write($config_file, $config);
34033
34034  # Open pipes, for use between the parent and child processes.  Specifically,
34035  # the child will indicate when it's done with its test by writing a message
34036  # to the parent.
34037  my ($rfh, $wfh);
34038  unless (pipe($rfh, $wfh)) {
34039    die("Can't open pipe: $!");
34040  }
34041
34042  require Net::SSH2;
34043
34044  my $ex;
34045
34046  # Ignore SIGPIPE
34047  local $SIG{PIPE} = sub { };
34048
34049  # Fork child
34050  $self->handle_sigchld();
34051  defined(my $pid = fork()) or die("Can't fork: $!");
34052  if ($pid) {
34053    eval {
34054      my $ssh2 = Net::SSH2->new();
34055
34056      sleep(1);
34057
34058      unless ($ssh2->connect('127.0.0.1', $port)) {
34059        my ($err_code, $err_name, $err_str) = $ssh2->error();
34060        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
34061      }
34062
34063      unless ($ssh2->auth_password($user, $passwd)) {
34064        my ($err_code, $err_name, $err_str) = $ssh2->error();
34065        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
34066      }
34067
34068      my $sftp = $ssh2->sftp();
34069      unless ($sftp) {
34070        my ($err_code, $err_name, $err_str) = $ssh2->error();
34071        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
34072      }
34073
34074      # We have to tell Net::SSH2 to actually _do_ something, in order to have
34075      # it process any messages it may have received from mod_sftp, like
34076      # the client alive checks.
34077
34078      for (my $i = 0; $i < 10; $i++) {
34079        $sftp->realpath('.');
34080
34081        my $delay = $client_alive_interval + 1;
34082        sleep($delay);
34083      }
34084
34085      $sftp = undef;
34086      $ssh2->disconnect();
34087    };
34088
34089    if ($@) {
34090      $ex = $@;
34091    }
34092
34093    $wfh->print("done\n");
34094    $wfh->flush();
34095
34096  } else {
34097    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
34098    if ($@) {
34099      warn($@);
34100      exit 1;
34101    }
34102
34103    exit 0;
34104  }
34105
34106  # Stop server
34107  server_stop($pid_file);
34108
34109  $self->assert_child_ok($pid);
34110
34111  if ($ex) {
34112    test_append_logfile($log_file, $ex);
34113    unlink($log_file);
34114
34115    die($ex);
34116  }
34117
34118  unlink($log_file);
34119}
34120
34121sub sftp_config_client_match {
34122  my $self = shift;
34123  my $tmpdir = $self->{tmpdir};
34124
34125  my $config_file = "$tmpdir/sftp.conf";
34126  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
34127  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
34128
34129  my $log_file = test_get_logfile();
34130
34131  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
34132  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
34133
34134  my $user = 'proftpd';
34135  my $passwd = 'test';
34136  my $group = 'ftpd';
34137  my $home_dir = File::Spec->rel2abs($tmpdir);
34138  my $uid = 500;
34139  my $gid = 500;
34140
34141  # Make sure that, if we're running as root, that the home directory has
34142  # permissions/privs set for the account we create
34143  if ($< == 0) {
34144    unless (chmod(0755, $home_dir)) {
34145      die("Can't set perms on $home_dir to 0755: $!");
34146    }
34147
34148    unless (chown($uid, $gid, $home_dir)) {
34149      die("Can't set owner of $home_dir to $uid/$gid: $!");
34150    }
34151  }
34152
34153  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
34154    '/bin/bash');
34155  auth_group_write($auth_group_file, $group, $gid, $user);
34156
34157  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
34158  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
34159
34160  my $banner = 'SFTP_UnitTest (Perl)';
34161  my $banner_pattern = 'SFTP_UnitTest \\\\(Perl\\\\)';
34162
34163  my $config = {
34164    PidFile => $pid_file,
34165    ScoreboardFile => $scoreboard_file,
34166    SystemLog => $log_file,
34167    TraceLog => $log_file,
34168    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
34169
34170    AuthUserFile => $auth_user_file,
34171    AuthGroupFile => $auth_group_file,
34172
34173    IfModules => {
34174      'mod_delay.c' => {
34175        DelayEngine => 'off',
34176      },
34177
34178      'mod_sftp.c' => [
34179        "SFTPEngine on",
34180        "SFTPLog $log_file",
34181        "SFTPHostKey $rsa_host_key",
34182        "SFTPHostKey $dsa_host_key",
34183
34184        "SFTPClientMatch \"^$banner_pattern\$\" channelWindowSize 64MB sftpProtocolVersion 1-2",
34185      ],
34186    },
34187  };
34188
34189  my ($port, $config_user, $config_group) = config_write($config_file, $config);
34190
34191  # Open pipes, for use between the parent and child processes.  Specifically,
34192  # the child will indicate when it's done with its test by writing a message
34193  # to the parent.
34194  my ($rfh, $wfh);
34195  unless (pipe($rfh, $wfh)) {
34196    die("Can't open pipe: $!");
34197  }
34198
34199  require Net::SSH2;
34200
34201  my $ex;
34202
34203  # Ignore SIGPIPE
34204  local $SIG{PIPE} = sub { };
34205
34206  # Fork child
34207  $self->handle_sigchld();
34208  defined(my $pid = fork()) or die("Can't fork: $!");
34209  if ($pid) {
34210    eval {
34211      my $ssh2 = Net::SSH2->new();
34212      $ssh2->banner($banner);
34213
34214      sleep(1);
34215
34216      unless ($ssh2->connect('127.0.0.1', $port)) {
34217        my ($err_code, $err_name, $err_str) = $ssh2->error();
34218        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
34219      }
34220
34221      unless ($ssh2->auth_password($user, $passwd)) {
34222        my ($err_code, $err_name, $err_str) = $ssh2->error();
34223        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
34224      }
34225
34226      my $sftp = $ssh2->sftp();
34227      unless ($sftp) {
34228        my ($err_code, $err_name, $err_str) = $ssh2->error();
34229        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
34230      }
34231
34232      # We can't actually check whether our configured values are applied
34233      # via the Net::SSH2 methods (yet).  So we have to rely on the
34234      # generated TraceLog.
34235
34236      $sftp = undef;
34237      $ssh2->disconnect();
34238    };
34239
34240    if ($@) {
34241      $ex = $@;
34242    }
34243
34244    $wfh->print("done\n");
34245    $wfh->flush();
34246
34247  } else {
34248    eval { server_wait($config_file, $rfh) };
34249    if ($@) {
34250      warn($@);
34251      exit 1;
34252    }
34253
34254    exit 0;
34255  }
34256
34257  # Stop server
34258  server_stop($pid_file);
34259
34260  $self->assert_child_ok($pid);
34261
34262  if ($ex) {
34263    test_append_logfile($log_file, $ex);
34264    unlink($log_file);
34265
34266    die($ex);
34267  }
34268
34269  unlink($log_file);
34270}
34271
34272sub sftp_config_createhome {
34273  my $self = shift;
34274  my $tmpdir = $self->{tmpdir};
34275
34276  my $config_file = "$tmpdir/sftp.conf";
34277  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
34278  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
34279
34280  my $log_file = test_get_logfile();
34281
34282  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
34283  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
34284
34285  my $user = 'proftpd';
34286  my $passwd = 'test';
34287  my $group = 'ftpd';
34288  my $home_dir = File::Spec->rel2abs("$tmpdir/foo/bar");
34289  my $uid = 500;
34290  my $gid = 500;
34291
34292  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
34293    '/bin/bash');
34294  auth_group_write($auth_group_file, $group, $gid, $user);
34295
34296  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
34297  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
34298
34299  my $home_gid = 777;
34300
34301  my $config = {
34302    PidFile => $pid_file,
34303    ScoreboardFile => $scoreboard_file,
34304    SystemLog => $log_file,
34305    TraceLog => $log_file,
34306    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
34307
34308    AuthUserFile => $auth_user_file,
34309    AuthGroupFile => $auth_group_file,
34310
34311    CreateHome => "on 711 homegid $home_gid",
34312
34313    IfModules => {
34314      'mod_delay.c' => {
34315        DelayEngine => 'off',
34316      },
34317
34318      'mod_sftp.c' => [
34319        "SFTPEngine on",
34320        "SFTPLog $log_file",
34321        "SFTPHostKey $rsa_host_key",
34322        "SFTPHostKey $dsa_host_key",
34323      ],
34324    },
34325  };
34326
34327  my ($port, $config_user, $config_group) = config_write($config_file, $config);
34328
34329  # Open pipes, for use between the parent and child processes.  Specifically,
34330  # the child will indicate when it's done with its test by writing a message
34331  # to the parent.
34332  my ($rfh, $wfh);
34333  unless (pipe($rfh, $wfh)) {
34334    die("Can't open pipe: $!");
34335  }
34336
34337  require Net::SSH2;
34338
34339  my $ex;
34340
34341  # Ignore SIGPIPE
34342  local $SIG{PIPE} = sub { };
34343
34344  # Fork child
34345  $self->handle_sigchld();
34346  defined(my $pid = fork()) or die("Can't fork: $!");
34347  if ($pid) {
34348    eval {
34349      my $ssh2 = Net::SSH2->new();
34350
34351      sleep(1);
34352
34353      unless ($ssh2->connect('127.0.0.1', $port)) {
34354        my ($err_code, $err_name, $err_str) = $ssh2->error();
34355        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
34356      }
34357
34358      unless ($ssh2->auth_password($user, $passwd)) {
34359        my ($err_code, $err_name, $err_str) = $ssh2->error();
34360        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
34361      }
34362
34363      my $sftp = $ssh2->sftp();
34364      unless ($sftp) {
34365        my ($err_code, $err_name, $err_str) = $ssh2->error();
34366        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
34367      }
34368
34369      $sftp = undef;
34370      $ssh2->disconnect();
34371    };
34372
34373    if ($@) {
34374      $ex = $@;
34375    }
34376
34377    $wfh->print("done\n");
34378    $wfh->flush();
34379
34380  } else {
34381    eval { server_wait($config_file, $rfh) };
34382    if ($@) {
34383      warn($@);
34384      exit 1;
34385    }
34386
34387    exit 0;
34388  }
34389
34390  # Stop server
34391  server_stop($pid_file);
34392
34393  $self->assert_child_ok($pid);
34394
34395  # Check that the home directory exists, and that the parent directory
34396  # of $tmpdir/foo is owned by UID/GID root.
34397  $self->assert(-d $home_dir,
34398    test_msg("Expected $home_dir directory to exist"));
34399
34400  my ($uid_owner, $gid_owner) = (stat($home_dir))[4,5];
34401
34402  my $expected = $uid;
34403  $self->assert($expected == $uid_owner,
34404    test_msg("Expected $expected, got $uid_owner"));
34405
34406  $expected = $home_gid;
34407  $self->assert($expected == $gid_owner,
34408    test_msg("Expected $expected, got $gid_owner"));
34409
34410  if ($ex) {
34411    test_append_logfile($log_file, $ex);
34412    unlink($log_file);
34413
34414    die($ex);
34415  }
34416
34417  unlink($log_file);
34418}
34419
34420sub sftp_config_defaultchdir {
34421  my $self = shift;
34422  my $tmpdir = $self->{tmpdir};
34423
34424  my $config_file = "$tmpdir/sftp.conf";
34425  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
34426  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
34427
34428  my $log_file = test_get_logfile();
34429
34430  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
34431  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
34432
34433  my $user = 'proftpd';
34434  my $passwd = 'test';
34435  my $group = 'ftpd';
34436  my $home_dir = File::Spec->rel2abs($tmpdir);
34437  my $uid = 500;
34438  my $gid = 500;
34439
34440  my $sub_dir = File::Spec->rel2abs("$home_dir/public_sftp");
34441  mkpath($sub_dir);
34442
34443  my $test_file = File::Spec->rel2abs("$sub_dir/test.txt");
34444  if (open(my $fh, "> $test_file")) {
34445    close($fh);
34446
34447  } else {
34448    die("Can't write $test_file: $!");
34449  }
34450
34451  # Make sure that, if we're running as root, that the home directory has
34452  # permissions/privs set for the account we create
34453  if ($< == 0) {
34454    unless (chmod(0755, $home_dir, $sub_dir)) {
34455      die("Can't set perms on $home_dir, $sub_dir to 0755: $!");
34456    }
34457
34458    unless (chown($uid, $gid, $home_dir, $sub_dir)) {
34459      die("Can't set owner of $home_dir, $sub_dir to $uid/$gid: $!");
34460    }
34461  }
34462
34463  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
34464    '/bin/bash');
34465  auth_group_write($auth_group_file, $group, $gid, $user);
34466
34467  my $hidden_file = File::Spec->rel2abs("$tmpdir/.in.test.txt.");
34468  $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
34469
34470  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
34471  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
34472
34473  my $config = {
34474    PidFile => $pid_file,
34475    ScoreboardFile => $scoreboard_file,
34476    SystemLog => $log_file,
34477    TraceLog => $log_file,
34478    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
34479
34480    AuthUserFile => $auth_user_file,
34481    AuthGroupFile => $auth_group_file,
34482    DefaultChdir => '~/public_sftp',
34483
34484    IfModules => {
34485      'mod_delay.c' => {
34486        DelayEngine => 'off',
34487      },
34488
34489      'mod_sftp.c' => [
34490        "SFTPEngine on",
34491        "SFTPLog $log_file",
34492        "SFTPHostKey $rsa_host_key",
34493        "SFTPHostKey $dsa_host_key",
34494      ],
34495    },
34496  };
34497
34498  my ($port, $config_user, $config_group) = config_write($config_file, $config);
34499
34500  # Open pipes, for use between the parent and child processes.  Specifically,
34501  # the child will indicate when it's done with its test by writing a message
34502  # to the parent.
34503  my ($rfh, $wfh);
34504  unless (pipe($rfh, $wfh)) {
34505    die("Can't open pipe: $!");
34506  }
34507
34508  require Net::SSH2;
34509
34510  my $ex;
34511
34512  # Ignore SIGPIPE
34513  local $SIG{PIPE} = sub { };
34514
34515  # Fork child
34516  $self->handle_sigchld();
34517  defined(my $pid = fork()) or die("Can't fork: $!");
34518  if ($pid) {
34519    eval {
34520      my $ssh2 = Net::SSH2->new();
34521
34522      sleep(1);
34523
34524      unless ($ssh2->connect('127.0.0.1', $port)) {
34525        my ($err_code, $err_name, $err_str) = $ssh2->error();
34526        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
34527      }
34528
34529      unless ($ssh2->auth_password($user, $passwd)) {
34530        my ($err_code, $err_name, $err_str) = $ssh2->error();
34531        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
34532      }
34533
34534      my $sftp = $ssh2->sftp();
34535      unless ($sftp) {
34536        my ($err_code, $err_name, $err_str) = $ssh2->error();
34537        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
34538      }
34539
34540      my $dir = $sftp->opendir('.');
34541      unless ($dir) {
34542        my ($err_code, $err_name) = $sftp->error();
34543        die("Can't open directory '.': [$err_name] ($err_code)");
34544      }
34545
34546      my $res = {};
34547
34548      my $file = $dir->read();
34549      while ($file) {
34550        $res->{$file->{name}} = $file;
34551        $file = $dir->read();
34552      }
34553
34554      my $expected = {
34555        '.' => 1,
34556        '..' => 1,
34557        'test.txt' => 1,
34558      };
34559
34560      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
34561      $dir = undef;
34562
34563      # To close the SFTP channel, we have to explicitly destroy the object
34564      $sftp = undef;
34565
34566      $ssh2->disconnect();
34567
34568      my $ok = 1;
34569      my $mismatch;
34570
34571      my $seen = [];
34572      foreach my $name (keys(%$res)) {
34573        push(@$seen, $name);
34574
34575        unless (defined($expected->{$name})) {
34576          $mismatch = $name;
34577          $ok = 0;
34578          last;
34579        }
34580      }
34581
34582      unless ($ok) {
34583        die("Unexpected name '$mismatch' appeared in READDIR data")
34584      }
34585
34586      # Now remove from $expected all of the paths we saw; if there are
34587      # any entries remaining in $expected, something went wrong.
34588      foreach my $name (@$seen) {
34589        delete($expected->{$name});
34590      }
34591
34592      my $remaining = scalar(keys(%$expected));
34593      $self->assert(0 == $remaining,
34594        test_msg("Expected 0, got $remaining"));
34595    };
34596
34597    if ($@) {
34598      $ex = $@;
34599    }
34600
34601    $wfh->print("done\n");
34602    $wfh->flush();
34603
34604  } else {
34605    eval { server_wait($config_file, $rfh) };
34606    if ($@) {
34607      warn($@);
34608      exit 1;
34609    }
34610
34611    exit 0;
34612  }
34613
34614  # Stop server
34615  server_stop($pid_file);
34616
34617  $self->assert_child_ok($pid);
34618
34619  if ($ex) {
34620    test_append_logfile($log_file, $ex);
34621    unlink($log_file);
34622
34623    die($ex);
34624  }
34625
34626  unlink($log_file);
34627}
34628
34629sub sftp_config_deleteabortedstores {
34630  my $self = shift;
34631  my $tmpdir = $self->{tmpdir};
34632
34633  my $config_file = "$tmpdir/sftp.conf";
34634  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
34635  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
34636
34637  my $log_file = test_get_logfile();
34638
34639  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
34640  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
34641
34642  my $user = 'proftpd';
34643  my $passwd = 'test';
34644  my $group = 'ftpd';
34645  my $home_dir = File::Spec->rel2abs($tmpdir);
34646  my $uid = 500;
34647  my $gid = 500;
34648
34649  # Make sure that, if we're running as root, that the home directory has
34650  # permissions/privs set for the account we create
34651  if ($< == 0) {
34652    unless (chmod(0755, $home_dir)) {
34653      die("Can't set perms on $home_dir to 0755: $!");
34654    }
34655
34656    unless (chown($uid, $gid, $home_dir)) {
34657      die("Can't set owner of $home_dir to $uid/$gid: $!");
34658    }
34659  }
34660
34661  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
34662    '/bin/bash');
34663  auth_group_write($auth_group_file, $group, $gid, $user);
34664
34665  my $hidden_file = File::Spec->rel2abs("$tmpdir/.in.test.txt.");
34666  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
34667
34668  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
34669  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
34670
34671  my $config = {
34672    PidFile => $pid_file,
34673    ScoreboardFile => $scoreboard_file,
34674    SystemLog => $log_file,
34675    TraceLog => $log_file,
34676    Trace => 'DEFAULT:20 ssh2:20 sftp:20 scp:20',
34677
34678    AuthUserFile => $auth_user_file,
34679    AuthGroupFile => $auth_group_file,
34680
34681    HiddenStores => 'on',
34682    DeleteAbortedStores => 'on',
34683
34684    IfModules => {
34685      'mod_delay.c' => {
34686        DelayEngine => 'off',
34687      },
34688
34689      'mod_sftp.c' => [
34690        "SFTPEngine on",
34691        "SFTPLog $log_file",
34692        "SFTPHostKey $rsa_host_key",
34693        "SFTPHostKey $dsa_host_key",
34694      ],
34695    },
34696  };
34697
34698  my ($port, $config_user, $config_group) = config_write($config_file, $config);
34699
34700  # Open pipes, for use between the parent and child processes.  Specifically,
34701  # the child will indicate when it's done with its test by writing a message
34702  # to the parent.
34703  my ($rfh, $wfh);
34704  unless (pipe($rfh, $wfh)) {
34705    die("Can't open pipe: $!");
34706  }
34707
34708  require Net::SSH2;
34709
34710  my $ex;
34711
34712  # Ignore SIGPIPE
34713  local $SIG{PIPE} = sub { };
34714
34715  # Fork child
34716  $self->handle_sigchld();
34717  defined(my $pid = fork()) or die("Can't fork: $!");
34718  if ($pid) {
34719    eval {
34720      my $ssh2 = Net::SSH2->new();
34721
34722      sleep(1);
34723
34724      unless ($ssh2->connect('127.0.0.1', $port)) {
34725        my ($err_code, $err_name, $err_str) = $ssh2->error();
34726        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
34727      }
34728
34729      unless ($ssh2->auth_password($user, $passwd)) {
34730        my ($err_code, $err_name, $err_str) = $ssh2->error();
34731        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
34732      }
34733
34734      my $sftp = $ssh2->sftp();
34735      unless ($sftp) {
34736        my ($err_code, $err_name, $err_str) = $ssh2->error();
34737        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
34738      }
34739
34740      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
34741      unless ($fh) {
34742        my ($err_code, $err_name) = $sftp->error();
34743        die("Can't open test.txt: [$err_name] ($err_code)");
34744      }
34745
34746      # Check for the HiddenStores file
34747      unless (-f $hidden_file) {
34748        die("File $hidden_file does not exist as expected");
34749      }
34750
34751      print $fh "ABCD\n" x 32;
34752
34753      # Explicitly close the channel before we have closed the file, to
34754      # simulate an "aborted" transfer.
34755      $sftp = undef;
34756      $ssh2->disconnect();
34757
34758      # Give the server a little time to do its end-of-session thing.
34759      sleep(1);
34760    };
34761
34762    if ($@) {
34763      $ex = $@;
34764    }
34765
34766    $wfh->print("done\n");
34767    $wfh->flush();
34768
34769  } else {
34770    eval { server_wait($config_file, $rfh) };
34771    if ($@) {
34772      warn($@);
34773      exit 1;
34774    }
34775
34776    exit 0;
34777  }
34778
34779  if ($ex) {
34780    test_append_logfile($log_file, $ex);
34781    unlink($log_file);
34782
34783    die($ex);
34784  }
34785
34786  # Stop server
34787  server_stop($pid_file);
34788
34789  $self->assert_child_ok($pid);
34790
34791  # Check that the HiddenStores file is gone, and the requested
34792  # file does NOT exist.
34793
34794  $self->assert(!-f $hidden_file,
34795    test_msg("File $hidden_file exists unexpectedly"));
34796
34797  $self->assert(!-f $test_file,
34798    test_msg("File $test_file does not exist as expected"));
34799
34800  unlink($log_file);
34801}
34802
34803sub sftp_config_dirfakemode {
34804  my $self = shift;
34805  my $tmpdir = $self->{tmpdir};
34806
34807  my $config_file = "$tmpdir/sftp.conf";
34808  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
34809  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
34810
34811  my $log_file = test_get_logfile();
34812
34813  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
34814  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
34815
34816  my $user = 'proftpd';
34817  my $passwd = 'test';
34818  my $group = 'ftpd';
34819  my $home_dir = File::Spec->rel2abs($tmpdir);
34820  my $uid = 500;
34821  my $gid = 500;
34822
34823  # Make sure that, if we're running as root, that the home directory has
34824  # permissions/privs set for the account we create
34825  if ($< == 0) {
34826    unless (chmod(0755, $home_dir)) {
34827      die("Can't set perms on $home_dir to 0755: $!");
34828    }
34829
34830    unless (chown($uid, $gid, $home_dir)) {
34831      die("Can't set owner of $home_dir to $uid/$gid: $!");
34832    }
34833  }
34834
34835  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
34836    '/bin/bash');
34837  auth_group_write($auth_group_file, $group, $gid, $user);
34838
34839  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
34840  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
34841
34842  my $config = {
34843    PidFile => $pid_file,
34844    ScoreboardFile => $scoreboard_file,
34845    SystemLog => $log_file,
34846    TraceLog => $log_file,
34847    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
34848
34849    AuthUserFile => $auth_user_file,
34850    AuthGroupFile => $auth_group_file,
34851
34852    DirFakeMode => '0310',
34853
34854    IfModules => {
34855      'mod_delay.c' => {
34856        DelayEngine => 'off',
34857      },
34858
34859      'mod_sftp.c' => [
34860        "SFTPEngine on",
34861        "SFTPLog $log_file",
34862        "SFTPHostKey $rsa_host_key",
34863        "SFTPHostKey $dsa_host_key",
34864      ],
34865    },
34866  };
34867
34868  my ($port, $config_user, $config_group) = config_write($config_file, $config);
34869
34870  # Open pipes, for use between the parent and child processes.  Specifically,
34871  # the child will indicate when it's done with its test by writing a message
34872  # to the parent.
34873  my ($rfh, $wfh);
34874  unless (pipe($rfh, $wfh)) {
34875    die("Can't open pipe: $!");
34876  }
34877
34878  require Net::SSH2;
34879
34880  my $ex;
34881
34882  # Ignore SIGPIPE
34883  local $SIG{PIPE} = sub { };
34884
34885  # Fork child
34886  $self->handle_sigchld();
34887  defined(my $pid = fork()) or die("Can't fork: $!");
34888  if ($pid) {
34889    eval {
34890      my $ssh2 = Net::SSH2->new();
34891
34892      sleep(1);
34893
34894      unless ($ssh2->connect('127.0.0.1', $port)) {
34895        my ($err_code, $err_name, $err_str) = $ssh2->error();
34896        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
34897      }
34898
34899      unless ($ssh2->auth_password($user, $passwd)) {
34900        my ($err_code, $err_name, $err_str) = $ssh2->error();
34901        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
34902      }
34903
34904      my $sftp = $ssh2->sftp();
34905      unless ($sftp) {
34906        my ($err_code, $err_name, $err_str) = $ssh2->error();
34907        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
34908      }
34909
34910      my $dir = $sftp->opendir('.');
34911      unless ($dir) {
34912        my ($err_code, $err_name) = $sftp->error();
34913        die("Can't open directory '.': [$err_name] ($err_code)");
34914      }
34915
34916      my $res = {};
34917
34918      my $file = $dir->read();
34919      while ($file) {
34920        $res->{$file->{name}} = sprintf("%04o", $file->{mode} & 0777);
34921        $file = $dir->read();
34922      }
34923
34924      my $expected = {
34925        '.' => '0310',
34926        '..' => '0310',
34927        'sftp.conf' => '0310',
34928        'sftp.group' => '0310',
34929        'sftp.passwd' => '0310',
34930        'sftp.pid' => '0310',
34931        'sftp.scoreboard' => '0310',
34932        'sftp.scoreboard.lck' => '0310',
34933      };
34934
34935      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
34936      $dir = undef;
34937
34938      # To close the SFTP channel, we have to explicitly destroy the object
34939      $sftp = undef;
34940
34941      $ssh2->disconnect();
34942
34943      my $file_ok = 1;
34944      my $mode_ok = 1;
34945      my $mismatch;
34946
34947      my $seen = [];
34948      foreach my $name (keys(%$res)) {
34949        push(@$seen, $name);
34950
34951        unless (defined($expected->{$name})) {
34952          $mismatch = $name;
34953          $file_ok = 0;
34954          last;
34955        }
34956
34957        unless ($res->{$name} eq $expected->{$name}) {
34958          $mismatch = "$name: $res->{$name}";
34959          $mode_ok = 0;
34960          last;
34961        }
34962      }
34963
34964      unless ($file_ok) {
34965        die("Unexpected name '$mismatch' appeared in READDIR data")
34966      }
34967
34968      unless ($mode_ok) {
34969        die("Unexpected mode '$mismatch' appeared in READDIR data")
34970      }
34971
34972      # Now remove from $expected all of the paths we saw; if there are
34973      # any entries remaining in $expected, something went wrong.
34974      foreach my $name (@$seen) {
34975        delete($expected->{$name});
34976      }
34977
34978      my $remaining = scalar(keys(%$expected));
34979      $self->assert(0 == $remaining,
34980        test_msg("Expected 0, got $remaining"));
34981    };
34982
34983    if ($@) {
34984      $ex = $@;
34985    }
34986
34987    $wfh->print("done\n");
34988    $wfh->flush();
34989
34990  } else {
34991    eval { server_wait($config_file, $rfh) };
34992    if ($@) {
34993      warn($@);
34994      exit 1;
34995    }
34996
34997    exit 0;
34998  }
34999
35000  # Stop server
35001  server_stop($pid_file);
35002
35003  $self->assert_child_ok($pid);
35004
35005  if ($ex) {
35006    test_append_logfile($log_file, $ex);
35007    unlink($log_file);
35008
35009    die($ex);
35010  }
35011
35012  unlink($log_file);
35013}
35014
35015sub sftp_config_hiddenstores {
35016  my $self = shift;
35017  my $tmpdir = $self->{tmpdir};
35018
35019  my $config_file = "$tmpdir/sftp.conf";
35020  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
35021  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
35022
35023  my $log_file = test_get_logfile();
35024
35025  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
35026  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
35027
35028  my $user = 'proftpd';
35029  my $passwd = 'test';
35030  my $group = 'ftpd';
35031  my $home_dir = File::Spec->rel2abs($tmpdir);
35032  my $uid = 500;
35033  my $gid = 500;
35034
35035  # Make sure that, if we're running as root, that the home directory has
35036  # permissions/privs set for the account we create
35037  if ($< == 0) {
35038    unless (chmod(0755, $home_dir)) {
35039      die("Can't set perms on $home_dir to 0755: $!");
35040    }
35041
35042    unless (chown($uid, $gid, $home_dir)) {
35043      die("Can't set owner of $home_dir to $uid/$gid: $!");
35044    }
35045  }
35046
35047  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
35048    '/bin/bash');
35049  auth_group_write($auth_group_file, $group, $gid, $user);
35050
35051  my $hidden_file = File::Spec->rel2abs("$tmpdir/.in.test.txt.");
35052  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
35053
35054  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
35055  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
35056
35057  my $config = {
35058    PidFile => $pid_file,
35059    ScoreboardFile => $scoreboard_file,
35060    SystemLog => $log_file,
35061    TraceLog => $log_file,
35062    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
35063
35064    AuthUserFile => $auth_user_file,
35065    AuthGroupFile => $auth_group_file,
35066
35067    HiddenStores => 'on',
35068
35069    IfModules => {
35070      'mod_delay.c' => {
35071        DelayEngine => 'off',
35072      },
35073
35074      'mod_sftp.c' => [
35075        "SFTPEngine on",
35076        "SFTPLog $log_file",
35077        "SFTPHostKey $rsa_host_key",
35078        "SFTPHostKey $dsa_host_key",
35079      ],
35080    },
35081  };
35082
35083  my ($port, $config_user, $config_group) = config_write($config_file, $config);
35084
35085  # Open pipes, for use between the parent and child processes.  Specifically,
35086  # the child will indicate when it's done with its test by writing a message
35087  # to the parent.
35088  my ($rfh, $wfh);
35089  unless (pipe($rfh, $wfh)) {
35090    die("Can't open pipe: $!");
35091  }
35092
35093  require Net::SSH2;
35094
35095  my $ex;
35096
35097  # Ignore SIGPIPE
35098  local $SIG{PIPE} = sub { };
35099
35100  # Fork child
35101  $self->handle_sigchld();
35102  defined(my $pid = fork()) or die("Can't fork: $!");
35103  if ($pid) {
35104    eval {
35105      my $ssh2 = Net::SSH2->new();
35106
35107      sleep(1);
35108
35109      unless ($ssh2->connect('127.0.0.1', $port)) {
35110        my ($err_code, $err_name, $err_str) = $ssh2->error();
35111        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
35112      }
35113
35114      unless ($ssh2->auth_password($user, $passwd)) {
35115        my ($err_code, $err_name, $err_str) = $ssh2->error();
35116        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
35117      }
35118
35119      my $sftp = $ssh2->sftp();
35120      unless ($sftp) {
35121        my ($err_code, $err_name, $err_str) = $ssh2->error();
35122        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
35123      }
35124
35125      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
35126      unless ($fh) {
35127        my ($err_code, $err_name) = $sftp->error();
35128        die("Can't open test.txt: [$err_name] ($err_code)");
35129      }
35130
35131      # Check for the HiddenStores file
35132      unless (-f $hidden_file) {
35133        die("File $hidden_file does not exist as expected");
35134      }
35135
35136      print $fh "ABCD\n" x 32;
35137
35138      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
35139      $fh = undef;
35140
35141      # To close the SFTP channel, we have to explicitly destroy the object
35142      $sftp = undef;
35143
35144      $ssh2->disconnect();
35145
35146      # Check that the HiddenStores file is gone, and the requested
35147      # file exists.
35148
35149      if (-f $hidden_file) {
35150        die("File $hidden_file exists unexpectedly");
35151      }
35152
35153      unless (-f $test_file) {
35154        die("File $test_file does not exist as expected");
35155      }
35156    };
35157
35158    if ($@) {
35159      $ex = $@;
35160    }
35161
35162    $wfh->print("done\n");
35163    $wfh->flush();
35164
35165  } else {
35166    eval { server_wait($config_file, $rfh) };
35167    if ($@) {
35168      warn($@);
35169      exit 1;
35170    }
35171
35172    exit 0;
35173  }
35174
35175  # Stop server
35176  server_stop($pid_file);
35177
35178  $self->assert_child_ok($pid);
35179
35180  if ($ex) {
35181    test_append_logfile($log_file, $ex);
35182    unlink($log_file);
35183
35184    die($ex);
35185  }
35186
35187  unlink($log_file);
35188}
35189
35190sub sftp_config_hidefiles_abs_path {
35191  my $self = shift;
35192  my $tmpdir = $self->{tmpdir};
35193
35194  my $config_file = "$tmpdir/sftp.conf";
35195  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
35196  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
35197
35198  my $log_file = test_get_logfile();
35199
35200  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
35201  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
35202
35203  my $user = 'proftpd';
35204  my $passwd = 'test';
35205  my $group = 'ftpd';
35206  my $home_dir = File::Spec->rel2abs($tmpdir);
35207  my $uid = 500;
35208  my $gid = 500;
35209
35210  # Make sure that, if we're running as root, that the home directory has
35211  # permissions/privs set for the account we create
35212  if ($< == 0) {
35213    unless (chmod(0755, $home_dir)) {
35214      die("Can't set perms on $home_dir to 0755: $!");
35215    }
35216
35217    unless (chown($uid, $gid, $home_dir)) {
35218      die("Can't set owner of $home_dir to $uid/$gid: $!");
35219    }
35220  }
35221
35222  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
35223    '/bin/bash');
35224  auth_group_write($auth_group_file, $group, $gid, $user);
35225
35226  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
35227  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
35228
35229  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
35230  if (open(my $fh, "> $test_file")) {
35231    close($fh);
35232
35233  } else {
35234    die("Can't open $test_file: $!");
35235  }
35236
35237  # Make the perms on the file such that the user can't read it
35238  unless (chmod(0311, $test_file)) {
35239    die("Can't chmod $test_file: $!");
35240  }
35241
35242  my $config = {
35243    PidFile => $pid_file,
35244    ScoreboardFile => $scoreboard_file,
35245    SystemLog => $log_file,
35246    TraceLog => $log_file,
35247    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
35248
35249    AuthUserFile => $auth_user_file,
35250    AuthGroupFile => $auth_group_file,
35251
35252    Directory => {
35253      '/' => {
35254        HideFiles => '!\.txt$',
35255      },
35256    },
35257
35258    IfModules => {
35259      'mod_delay.c' => {
35260        DelayEngine => 'off',
35261      },
35262
35263      'mod_sftp.c' => [
35264        "SFTPEngine on",
35265        "SFTPLog $log_file",
35266        "SFTPHostKey $rsa_host_key",
35267        "SFTPHostKey $dsa_host_key",
35268      ],
35269    },
35270  };
35271
35272  my ($port, $config_user, $config_group) = config_write($config_file, $config);
35273
35274  # Open pipes, for use between the parent and child processes.  Specifically,
35275  # the child will indicate when it's done with its test by writing a message
35276  # to the parent.
35277  my ($rfh, $wfh);
35278  unless (pipe($rfh, $wfh)) {
35279    die("Can't open pipe: $!");
35280  }
35281
35282  require Net::SSH2;
35283
35284  my $ex;
35285
35286  # Ignore SIGPIPE
35287  local $SIG{PIPE} = sub { };
35288
35289  # Fork child
35290  $self->handle_sigchld();
35291  defined(my $pid = fork()) or die("Can't fork: $!");
35292  if ($pid) {
35293    eval {
35294      my $ssh2 = Net::SSH2->new();
35295
35296      sleep(1);
35297
35298      unless ($ssh2->connect('127.0.0.1', $port)) {
35299        my ($err_code, $err_name, $err_str) = $ssh2->error();
35300        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
35301      }
35302
35303      unless ($ssh2->auth_password($user, $passwd)) {
35304        my ($err_code, $err_name, $err_str) = $ssh2->error();
35305        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
35306      }
35307
35308      my $sftp = $ssh2->sftp();
35309      unless ($sftp) {
35310        my ($err_code, $err_name, $err_str) = $ssh2->error();
35311        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
35312      }
35313
35314      # Issue a READDIR.  Due to HideFiles, we should only see
35315      # the 'test.txt' file in the list.
35316
35317      my $dir = $sftp->opendir('.');
35318      unless ($dir) {
35319        my ($err_code, $err_name) = $sftp->error();
35320        die("Can't open directory '.': [$err_name] ($err_code)");
35321      }
35322
35323      my $res = {};
35324
35325      my $file = $dir->read();
35326      while ($file) {
35327        $res->{$file->{name}} = $file;
35328        $file = $dir->read();
35329      }
35330
35331      my $expected = {
35332        'test.txt' => 1,
35333      };
35334
35335      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
35336      $dir = undef;
35337
35338      # To close the SFTP channel, we have to explicitly destroy the object
35339      $sftp = undef;
35340
35341      $ssh2->disconnect();
35342
35343      my $ok = 1;
35344      my $mismatch;
35345
35346      my $seen = [];
35347      foreach my $name (keys(%$res)) {
35348        push(@$seen, $name);
35349
35350        unless (defined($expected->{$name})) {
35351          $mismatch = $name;
35352          $ok = 0;
35353          last;
35354        }
35355      }
35356
35357      unless ($ok) {
35358        die("Unexpected name '$mismatch' appeared in READDIR data")
35359      }
35360
35361      # Now remove from $expected all of the paths we saw; if there are
35362      # any entries remaining in $expected, something went wrong.
35363      foreach my $name (@$seen) {
35364        delete($expected->{$name});
35365      }
35366
35367      my $remaining = scalar(keys(%$expected));
35368      $self->assert(0 == $remaining,
35369        test_msg("Expected 0, got $remaining"));
35370    };
35371
35372    if ($@) {
35373      $ex = $@;
35374    }
35375
35376    $wfh->print("done\n");
35377    $wfh->flush();
35378
35379  } else {
35380    eval { server_wait($config_file, $rfh) };
35381    if ($@) {
35382      warn($@);
35383      exit 1;
35384    }
35385
35386    exit 0;
35387  }
35388
35389  # Stop server
35390  server_stop($pid_file);
35391
35392  $self->assert_child_ok($pid);
35393
35394  if ($ex) {
35395    test_append_logfile($log_file, $ex);
35396    unlink($log_file);
35397
35398    die($ex);
35399  }
35400
35401  unlink($log_file);
35402}
35403
35404sub sftp_config_hidefiles_deferred_path_bug3470 {
35405  my $self = shift;
35406  my $tmpdir = $self->{tmpdir};
35407
35408  my $config_file = "$tmpdir/sftp.conf";
35409  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
35410  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
35411
35412  my $log_file = test_get_logfile();
35413
35414  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
35415  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
35416
35417  my $user = 'proftpd';
35418  my $passwd = 'test';
35419  my $group = 'ftpd';
35420  my $home_dir = File::Spec->rel2abs($tmpdir);
35421  my $uid = 500;
35422  my $gid = 500;
35423
35424  # Make sure that, if we're running as root, that the home directory has
35425  # permissions/privs set for the account we create
35426  if ($< == 0) {
35427    unless (chmod(0755, $home_dir)) {
35428      die("Can't set perms on $home_dir to 0755: $!");
35429    }
35430
35431    unless (chown($uid, $gid, $home_dir)) {
35432      die("Can't set owner of $home_dir to $uid/$gid: $!");
35433    }
35434  }
35435
35436  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
35437    '/bin/bash');
35438  auth_group_write($auth_group_file, $group, $gid, $user);
35439
35440  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
35441  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
35442
35443  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
35444  if (open(my $fh, "> $test_file")) {
35445    close($fh);
35446
35447  } else {
35448    die("Can't open $test_file: $!");
35449  }
35450
35451  # Make the perms on the file such that the user can't read it
35452  unless (chmod(0311, $test_file)) {
35453    die("Can't chmod $test_file: $!");
35454  }
35455
35456  my $config = {
35457    PidFile => $pid_file,
35458    ScoreboardFile => $scoreboard_file,
35459    SystemLog => $log_file,
35460    TraceLog => $log_file,
35461    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20 directory:20',
35462
35463    AuthUserFile => $auth_user_file,
35464    AuthGroupFile => $auth_group_file,
35465
35466    Directory => {
35467      '~' => {
35468        HideFiles => '^(\.|sftp)',
35469      },
35470    },
35471
35472    IfModules => {
35473      'mod_delay.c' => {
35474        DelayEngine => 'off',
35475      },
35476
35477      'mod_sftp.c' => [
35478        "SFTPEngine on",
35479        "SFTPLog $log_file",
35480        "SFTPHostKey $rsa_host_key",
35481        "SFTPHostKey $dsa_host_key",
35482      ],
35483    },
35484  };
35485
35486  my ($port, $config_user, $config_group) = config_write($config_file, $config);
35487
35488  # Open pipes, for use between the parent and child processes.  Specifically,
35489  # the child will indicate when it's done with its test by writing a message
35490  # to the parent.
35491  my ($rfh, $wfh);
35492  unless (pipe($rfh, $wfh)) {
35493    die("Can't open pipe: $!");
35494  }
35495
35496  require Net::SSH2;
35497
35498  my $ex;
35499
35500  # Ignore SIGPIPE
35501  local $SIG{PIPE} = sub { };
35502
35503  # Fork child
35504  $self->handle_sigchld();
35505  defined(my $pid = fork()) or die("Can't fork: $!");
35506  if ($pid) {
35507    eval {
35508      my $ssh2 = Net::SSH2->new();
35509
35510      sleep(1);
35511
35512      unless ($ssh2->connect('127.0.0.1', $port)) {
35513        my ($err_code, $err_name, $err_str) = $ssh2->error();
35514        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
35515      }
35516
35517      unless ($ssh2->auth_password($user, $passwd)) {
35518        my ($err_code, $err_name, $err_str) = $ssh2->error();
35519        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
35520      }
35521
35522      my $sftp = $ssh2->sftp();
35523      unless ($sftp) {
35524        my ($err_code, $err_name, $err_str) = $ssh2->error();
35525        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
35526      }
35527
35528      # Issue a READDIR.  Due to HideFiles, we should only see
35529      # the 'test.txt' file in the list.
35530
35531      my $dir = $sftp->opendir('.');
35532      unless ($dir) {
35533        my ($err_code, $err_name) = $sftp->error();
35534        die("Can't open directory '.': [$err_name] ($err_code)");
35535      }
35536
35537      my $res = {};
35538
35539      my $file = $dir->read();
35540      while ($file) {
35541        $res->{$file->{name}} = $file;
35542        $file = $dir->read();
35543      }
35544
35545      my $expected = {
35546        'test.txt' => 1,
35547      };
35548
35549      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
35550      $dir = undef;
35551
35552      # To close the SFTP channel, we have to explicitly destroy the object
35553      $sftp = undef;
35554
35555      $ssh2->disconnect();
35556
35557      my $ok = 1;
35558      my $mismatch;
35559
35560      my $seen = [];
35561      foreach my $name (keys(%$res)) {
35562        push(@$seen, $name);
35563
35564        unless (defined($expected->{$name})) {
35565          $mismatch = $name;
35566          $ok = 0;
35567          last;
35568        }
35569      }
35570
35571      unless ($ok) {
35572        die("Unexpected name '$mismatch' appeared in READDIR data")
35573      }
35574
35575      # Now remove from $expected all of the paths we saw; if there are
35576      # any entries remaining in $expected, something went wrong.
35577      foreach my $name (@$seen) {
35578        delete($expected->{$name});
35579      }
35580
35581      my $remaining = scalar(keys(%$expected));
35582      $self->assert(0 == $remaining,
35583        test_msg("Expected 0, got $remaining"));
35584    };
35585
35586    if ($@) {
35587      $ex = $@;
35588    }
35589
35590    $wfh->print("done\n");
35591    $wfh->flush();
35592
35593  } else {
35594    eval { server_wait($config_file, $rfh) };
35595    if ($@) {
35596      warn($@);
35597      exit 1;
35598    }
35599
35600    exit 0;
35601  }
35602
35603  # Stop server
35604  server_stop($pid_file);
35605
35606  $self->assert_child_ok($pid);
35607
35608  if ($ex) {
35609    test_append_logfile($log_file, $ex);
35610    unlink($log_file);
35611
35612    die($ex);
35613  }
35614
35615  unlink($log_file);
35616}
35617
35618sub sftp_config_hidefiles_deferred_path_chroot_bug3470 {
35619  my $self = shift;
35620  my $tmpdir = $self->{tmpdir};
35621
35622  my $config_file = "$tmpdir/sftp.conf";
35623  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
35624  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
35625
35626  my $log_file = test_get_logfile();
35627
35628  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
35629  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
35630
35631  my $user = 'proftpd';
35632  my $passwd = 'test';
35633  my $group = 'ftpd';
35634  my $home_dir = File::Spec->rel2abs($tmpdir);
35635  my $uid = 500;
35636  my $gid = 500;
35637
35638  # Make sure that, if we're running as root, that the home directory has
35639  # permissions/privs set for the account we create
35640  if ($< == 0) {
35641    unless (chmod(0755, $home_dir)) {
35642      die("Can't set perms on $home_dir to 0755: $!");
35643    }
35644
35645    unless (chown($uid, $gid, $home_dir)) {
35646      die("Can't set owner of $home_dir to $uid/$gid: $!");
35647    }
35648  }
35649
35650  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
35651    '/bin/bash');
35652  auth_group_write($auth_group_file, $group, $gid, $user);
35653
35654  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
35655  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
35656
35657  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
35658  if (open(my $fh, "> $test_file")) {
35659    close($fh);
35660
35661  } else {
35662    die("Can't open $test_file: $!");
35663  }
35664
35665  # Make the perms on the file such that the user can't read it
35666  unless (chmod(0311, $test_file)) {
35667    die("Can't chmod $test_file: $!");
35668  }
35669
35670  my $config = {
35671    PidFile => $pid_file,
35672    ScoreboardFile => $scoreboard_file,
35673    SystemLog => $log_file,
35674    TraceLog => $log_file,
35675    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20 directory:20',
35676
35677    AuthUserFile => $auth_user_file,
35678    AuthGroupFile => $auth_group_file,
35679    DefaultRoot => '~',
35680
35681    Directory => {
35682      '~' => {
35683        HideFiles => '^(\.|sftp)',
35684      },
35685    },
35686
35687    IfModules => {
35688      'mod_delay.c' => {
35689        DelayEngine => 'off',
35690      },
35691
35692      'mod_sftp.c' => [
35693        "SFTPEngine on",
35694        "SFTPLog $log_file",
35695        "SFTPHostKey $rsa_host_key",
35696        "SFTPHostKey $dsa_host_key",
35697      ],
35698    },
35699  };
35700
35701  my ($port, $config_user, $config_group) = config_write($config_file, $config);
35702
35703  # Open pipes, for use between the parent and child processes.  Specifically,
35704  # the child will indicate when it's done with its test by writing a message
35705  # to the parent.
35706  my ($rfh, $wfh);
35707  unless (pipe($rfh, $wfh)) {
35708    die("Can't open pipe: $!");
35709  }
35710
35711  require Net::SSH2;
35712
35713  my $ex;
35714
35715  # Ignore SIGPIPE
35716  local $SIG{PIPE} = sub { };
35717
35718  # Fork child
35719  $self->handle_sigchld();
35720  defined(my $pid = fork()) or die("Can't fork: $!");
35721  if ($pid) {
35722    eval {
35723      my $ssh2 = Net::SSH2->new();
35724
35725      sleep(1);
35726
35727      unless ($ssh2->connect('127.0.0.1', $port)) {
35728        my ($err_code, $err_name, $err_str) = $ssh2->error();
35729        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
35730      }
35731
35732      unless ($ssh2->auth_password($user, $passwd)) {
35733        my ($err_code, $err_name, $err_str) = $ssh2->error();
35734        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
35735      }
35736
35737      my $sftp = $ssh2->sftp();
35738      unless ($sftp) {
35739        my ($err_code, $err_name, $err_str) = $ssh2->error();
35740        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
35741      }
35742
35743      # Issue a READDIR.  Due to HideFiles, we should only see
35744      # the 'test.txt' file in the list.
35745
35746      my $dir = $sftp->opendir('.');
35747      unless ($dir) {
35748        my ($err_code, $err_name) = $sftp->error();
35749        die("Can't open directory '.': [$err_name] ($err_code)");
35750      }
35751
35752      my $res = {};
35753
35754      my $file = $dir->read();
35755      while ($file) {
35756        $res->{$file->{name}} = $file;
35757        $file = $dir->read();
35758      }
35759
35760      my $expected = {
35761        'test.txt' => 1,
35762      };
35763
35764      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
35765      $dir = undef;
35766
35767      # To close the SFTP channel, we have to explicitly destroy the object
35768      $sftp = undef;
35769
35770      $ssh2->disconnect();
35771
35772      my $ok = 1;
35773      my $mismatch;
35774
35775      my $seen = [];
35776      foreach my $name (keys(%$res)) {
35777        push(@$seen, $name);
35778
35779        unless (defined($expected->{$name})) {
35780          $mismatch = $name;
35781          $ok = 0;
35782          last;
35783        }
35784      }
35785
35786      unless ($ok) {
35787        die("Unexpected name '$mismatch' appeared in READDIR data")
35788      }
35789
35790      # Now remove from $expected all of the paths we saw; if there are
35791      # any entries remaining in $expected, something went wrong.
35792      foreach my $name (@$seen) {
35793        delete($expected->{$name});
35794      }
35795
35796      my $remaining = scalar(keys(%$expected));
35797      $self->assert(0 == $remaining,
35798        test_msg("Expected 0, got $remaining"));
35799    };
35800
35801    if ($@) {
35802      $ex = $@;
35803    }
35804
35805    $wfh->print("done\n");
35806    $wfh->flush();
35807
35808  } else {
35809    eval { server_wait($config_file, $rfh) };
35810    if ($@) {
35811      warn($@);
35812      exit 1;
35813    }
35814
35815    exit 0;
35816  }
35817
35818  # Stop server
35819  server_stop($pid_file);
35820
35821  $self->assert_child_ok($pid);
35822
35823  if ($ex) {
35824    test_append_logfile($log_file, $ex);
35825    unlink($log_file);
35826
35827    die($ex);
35828  }
35829
35830  unlink($log_file);
35831}
35832
35833sub sftp_config_hidefiles_symlink_bug3924 {
35834  my $self = shift;
35835  my $tmpdir = $self->{tmpdir};
35836
35837  my $config_file = "$tmpdir/sftp.conf";
35838  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
35839  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
35840
35841  my $log_file = test_get_logfile();
35842
35843  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
35844  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
35845
35846  my $user = 'proftpd';
35847  my $passwd = 'test';
35848  my $group = 'ftpd';
35849  my $home_dir = File::Spec->rel2abs($tmpdir);
35850  my $uid = 500;
35851  my $gid = 500;
35852
35853  my $sub_dir = File::Spec->rel2abs("$tmpdir/foobar");
35854  mkpath($sub_dir);
35855
35856  my $test_symlink = File::Spec->rel2abs("$tmpdir/foobar2");
35857
35858  my $cwd = getcwd();
35859  unless (chdir($tmpdir)) {
35860    die("Can't chdir to $tmpdir: $!");
35861  }
35862
35863  unless (symlink('/', $test_symlink)) {
35864    die("Can't symlink '/' to '$test_symlink': $!");
35865  }
35866
35867  unless (chdir($cwd)) {
35868    die("Can't chdir to $cwd: $!");
35869  }
35870
35871  # Make sure that, if we're running as root, that the home directory has
35872  # permissions/privs set for the account we create
35873  if ($< == 0) {
35874    unless (chmod(0755, $home_dir)) {
35875      die("Can't set perms on $home_dir to 0755: $!");
35876    }
35877
35878    unless (chown($uid, $gid, $home_dir)) {
35879      die("Can't set owner of $home_dir to $uid/$gid: $!");
35880    }
35881  }
35882
35883  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
35884    '/bin/bash');
35885  auth_group_write($auth_group_file, $group, $gid, $user);
35886
35887  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
35888  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
35889
35890  my $config = {
35891    PidFile => $pid_file,
35892    ScoreboardFile => $scoreboard_file,
35893    SystemLog => $log_file,
35894    TraceLog => $log_file,
35895    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
35896
35897    AuthUserFile => $auth_user_file,
35898    AuthGroupFile => $auth_group_file,
35899
35900    Directory => {
35901      '/' => {
35902        HideFiles => 'foobar',
35903      },
35904    },
35905
35906    IfModules => {
35907      'mod_delay.c' => {
35908        DelayEngine => 'off',
35909      },
35910
35911      'mod_sftp.c' => [
35912        "SFTPEngine on",
35913        "SFTPLog $log_file",
35914        "SFTPHostKey $rsa_host_key",
35915        "SFTPHostKey $dsa_host_key",
35916      ],
35917    },
35918  };
35919
35920  my ($port, $config_user, $config_group) = config_write($config_file, $config);
35921
35922  # Open pipes, for use between the parent and child processes.  Specifically,
35923  # the child will indicate when it's done with its test by writing a message
35924  # to the parent.
35925  my ($rfh, $wfh);
35926  unless (pipe($rfh, $wfh)) {
35927    die("Can't open pipe: $!");
35928  }
35929
35930  require Net::SSH2;
35931
35932  my $ex;
35933
35934  # Ignore SIGPIPE
35935  local $SIG{PIPE} = sub { };
35936
35937  # Fork child
35938  $self->handle_sigchld();
35939  defined(my $pid = fork()) or die("Can't fork: $!");
35940  if ($pid) {
35941    eval {
35942      my $ssh2 = Net::SSH2->new();
35943
35944      sleep(1);
35945
35946      unless ($ssh2->connect('127.0.0.1', $port)) {
35947        my ($err_code, $err_name, $err_str) = $ssh2->error();
35948        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
35949      }
35950
35951      unless ($ssh2->auth_password($user, $passwd)) {
35952        my ($err_code, $err_name, $err_str) = $ssh2->error();
35953        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
35954      }
35955
35956      my $sftp = $ssh2->sftp();
35957      unless ($sftp) {
35958        my ($err_code, $err_name, $err_str) = $ssh2->error();
35959        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
35960      }
35961
35962      my $dir = $sftp->opendir('.');
35963      unless ($dir) {
35964        my ($err_code, $err_name) = $sftp->error();
35965        die("Can't open directory '.': [$err_name] ($err_code)");
35966      }
35967
35968      my $res = {};
35969
35970      my $file = $dir->read();
35971      while ($file) {
35972        $res->{$file->{name}} = $file;
35973        $file = $dir->read();
35974      }
35975
35976      my $expected = {
35977        '.' => 1,
35978        '..' => 1,
35979        'sftp.conf' => 1,
35980        'sftp.passwd' => 1,
35981        'sftp.group' => 1,
35982        'sftp.pid' => 1,
35983        'sftp.scoreboard' => 1,
35984        'sftp.scoreboard.lck' => 1,
35985      };
35986
35987      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
35988      $dir = undef;
35989
35990      # To close the SFTP channel, we have to explicitly destroy the object
35991      $sftp = undef;
35992
35993      $ssh2->disconnect();
35994
35995      my $ok = 1;
35996      my $mismatch;
35997
35998      my $seen = [];
35999      foreach my $name (keys(%$res)) {
36000        push(@$seen, $name);
36001
36002        unless (defined($expected->{$name})) {
36003          $mismatch = $name;
36004          $ok = 0;
36005          last;
36006        }
36007      }
36008
36009      unless ($ok) {
36010        die("Unexpected name '$mismatch' appeared in READDIR data")
36011      }
36012
36013      # Now remove from $expected all of the paths we saw; if there are
36014      # any entries remaining in $expected, something went wrong.
36015      foreach my $name (@$seen) {
36016        delete($expected->{$name});
36017      }
36018
36019      my $remaining = scalar(keys(%$expected));
36020      $self->assert(0 == $remaining,
36021        test_msg("Expected 0, got $remaining"));
36022    };
36023
36024    if ($@) {
36025      $ex = $@;
36026    }
36027
36028    $wfh->print("done\n");
36029    $wfh->flush();
36030
36031  } else {
36032    eval { server_wait($config_file, $rfh) };
36033    if ($@) {
36034      warn($@);
36035      exit 1;
36036    }
36037
36038    exit 0;
36039  }
36040
36041  # Stop server
36042  server_stop($pid_file);
36043
36044  $self->assert_child_ok($pid);
36045
36046  if ($ex) {
36047    test_append_logfile($log_file, $ex);
36048    unlink($log_file);
36049
36050    die($ex);
36051  }
36052
36053  unlink($log_file);
36054}
36055
36056sub sftp_config_hidenoaccess {
36057  my $self = shift;
36058  my $tmpdir = $self->{tmpdir};
36059
36060  my $config_file = "$tmpdir/sftp.conf";
36061  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
36062  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
36063
36064  my $log_file = test_get_logfile();
36065
36066  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
36067  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
36068
36069  my $user = 'proftpd';
36070  my $passwd = 'test';
36071  my $group = 'ftpd';
36072  my $home_dir = File::Spec->rel2abs($tmpdir);
36073  my $uid = 500;
36074  my $gid = 500;
36075
36076  # Make sure that, if we're running as root, that the home directory has
36077  # permissions/privs set for the account we create
36078  if ($< == 0) {
36079    unless (chmod(0755, $home_dir)) {
36080      die("Can't set perms on $home_dir to 0755: $!");
36081    }
36082
36083    unless (chown($uid, $gid, $home_dir)) {
36084      die("Can't set owner of $home_dir to $uid/$gid: $!");
36085    }
36086  }
36087
36088  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
36089    '/bin/bash');
36090  auth_group_write($auth_group_file, $group, $gid, $user);
36091
36092  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
36093  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
36094
36095  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
36096  if (open(my $fh, "> $test_file")) {
36097    close($fh);
36098
36099  } else {
36100    die("Can't open $test_file: $!");
36101  }
36102
36103  # Make the perms on the file such that the user can't read it
36104  unless (chmod(0311, $test_file)) {
36105    die("Can't chmod $test_file: $!");
36106  }
36107
36108  my $config = {
36109    PidFile => $pid_file,
36110    ScoreboardFile => $scoreboard_file,
36111    SystemLog => $log_file,
36112    TraceLog => $log_file,
36113    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
36114
36115    AuthUserFile => $auth_user_file,
36116    AuthGroupFile => $auth_group_file,
36117
36118    Directory => {
36119      '~' => {
36120        Limit => {
36121          DIRS => {
36122            IgnoreHidden => 'on',
36123          },
36124        },
36125
36126        HideNoAccess => 'on',
36127      },
36128    },
36129
36130    IfModules => {
36131      'mod_delay.c' => {
36132        DelayEngine => 'off',
36133      },
36134
36135      'mod_sftp.c' => [
36136        "SFTPEngine on",
36137        "SFTPLog $log_file",
36138        "SFTPHostKey $rsa_host_key",
36139        "SFTPHostKey $dsa_host_key",
36140
36141        "SFTPOptions IgnoreSFTPUploadPerms",
36142      ],
36143    },
36144  };
36145
36146  my ($port, $config_user, $config_group) = config_write($config_file, $config);
36147
36148  # Open pipes, for use between the parent and child processes.  Specifically,
36149  # the child will indicate when it's done with its test by writing a message
36150  # to the parent.
36151  my ($rfh, $wfh);
36152  unless (pipe($rfh, $wfh)) {
36153    die("Can't open pipe: $!");
36154  }
36155
36156  require Net::SSH2;
36157
36158  my $ex;
36159
36160  # Ignore SIGPIPE
36161  local $SIG{PIPE} = sub { };
36162
36163  # Fork child
36164  $self->handle_sigchld();
36165  defined(my $pid = fork()) or die("Can't fork: $!");
36166  if ($pid) {
36167    eval {
36168      my $ssh2 = Net::SSH2->new();
36169
36170      sleep(1);
36171
36172      unless ($ssh2->connect('127.0.0.1', $port)) {
36173        my ($err_code, $err_name, $err_str) = $ssh2->error();
36174        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36175      }
36176
36177      unless ($ssh2->auth_password($user, $passwd)) {
36178        my ($err_code, $err_name, $err_str) = $ssh2->error();
36179        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
36180      }
36181
36182      my $sftp = $ssh2->sftp();
36183      unless ($sftp) {
36184        my ($err_code, $err_name, $err_str) = $ssh2->error();
36185        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
36186      }
36187
36188      # Issue a READDIR.  Due to the "HideNoAccess on", we should not see
36189      # the 'test.txt' file in the list.
36190
36191      my $dir = $sftp->opendir('.');
36192      unless ($dir) {
36193        my ($err_code, $err_name) = $sftp->error();
36194        die("Can't open directory '.': [$err_name] ($err_code)");
36195      }
36196
36197      my $res = {};
36198
36199      my $file = $dir->read();
36200      while ($file) {
36201        $res->{$file->{name}} = $file;
36202        $file = $dir->read();
36203      }
36204
36205      my $expected = {
36206        '.' => 1,
36207        '..' => 1,
36208        'sftp.conf' => 1,
36209        'sftp.group' => 1,
36210        'sftp.passwd' => 1,
36211        'sftp.pid' => 1,
36212        'sftp.scoreboard' => 1,
36213        'sftp.scoreboard.lck' => 1,
36214      };
36215
36216      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
36217      $dir = undef;
36218
36219      # To close the SFTP channel, we have to explicitly destroy the object
36220      $sftp = undef;
36221
36222      $ssh2->disconnect();
36223
36224      my $ok = 1;
36225      my $mismatch;
36226
36227      my $seen = [];
36228      foreach my $name (keys(%$res)) {
36229        push(@$seen, $name);
36230
36231        unless (defined($expected->{$name})) {
36232          $mismatch = $name;
36233          $ok = 0;
36234          last;
36235        }
36236      }
36237
36238      unless ($ok) {
36239        die("Unexpected name '$mismatch' appeared in READDIR data")
36240      }
36241
36242      # Now remove from $expected all of the paths we saw; if there are
36243      # any entries remaining in $expected, something went wrong.
36244      foreach my $name (@$seen) {
36245        delete($expected->{$name});
36246      }
36247
36248      my $remaining = scalar(keys(%$expected));
36249      $self->assert(0 == $remaining,
36250        test_msg("Expected 0, got $remaining"));
36251    };
36252
36253    if ($@) {
36254      $ex = $@;
36255    }
36256
36257    $wfh->print("done\n");
36258    $wfh->flush();
36259
36260  } else {
36261    eval { server_wait($config_file, $rfh) };
36262    if ($@) {
36263      warn($@);
36264      exit 1;
36265    }
36266
36267    exit 0;
36268  }
36269
36270  # Stop server
36271  server_stop($pid_file);
36272
36273  $self->assert_child_ok($pid);
36274
36275  if ($ex) {
36276    test_append_logfile($log_file, $ex);
36277    unlink($log_file);
36278
36279    die($ex);
36280  }
36281
36282  unlink($log_file);
36283}
36284
36285sub sftp_config_max_clients_per_host_bug3630 {
36286  my $self = shift;
36287  my $tmpdir = $self->{tmpdir};
36288
36289  my $config_file = "$tmpdir/sftp.conf";
36290  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
36291  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
36292
36293  my $log_file = test_get_logfile();
36294
36295  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
36296  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
36297
36298  my $user = 'proftpd';
36299  my $passwd = 'test';
36300  my $group = 'ftpd';
36301  my $home_dir = File::Spec->rel2abs($tmpdir);
36302  my $uid = 500;
36303  my $gid = 500;
36304
36305  # Make sure that, if we're running as root, that the home directory has
36306  # permissions/privs set for the account we create
36307  if ($< == 0) {
36308    unless (chmod(0755, $home_dir)) {
36309      die("Can't set perms on $home_dir to 0755: $!");
36310    }
36311
36312    unless (chown($uid, $gid, $home_dir)) {
36313      die("Can't set owner of $home_dir to $uid/$gid: $!");
36314    }
36315  }
36316
36317  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
36318    '/bin/bash');
36319  auth_group_write($auth_group_file, $group, $gid, $user);
36320
36321  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
36322  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
36323
36324  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
36325
36326  my $max_clients_per_host = 1;
36327
36328  my $config = {
36329    PidFile => $pid_file,
36330    ScoreboardFile => $scoreboard_file,
36331    SystemLog => $log_file,
36332    TraceLog => $log_file,
36333    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
36334
36335    AuthUserFile => $auth_user_file,
36336    AuthGroupFile => $auth_group_file,
36337    MaxClientsPerHost => $max_clients_per_host,
36338
36339    IfModules => {
36340      'mod_delay.c' => {
36341        DelayEngine => 'off',
36342      },
36343    },
36344  };
36345
36346  my ($port, $config_user, $config_group) = config_write($config_file, $config);
36347
36348  if (open(my $fh, ">> $config_file")) {
36349    my $sftp_port = $port + 2;
36350
36351    print $fh <<EOC;
36352<IfModule mod_sftp.c>
36353 <VirtualHost 0.0.0.0>
36354    SFTPEngine on
36355    SFTPLog $log_file
36356    SFTPHostKey $rsa_host_key
36357    SFTPHostKey $dsa_host_key
36358
36359    Port $sftp_port
36360  </VirtualHost>
36361</IfModule>
36362EOC
36363    unless (close($fh)) {
36364      die("Can't write $config_file: $!");
36365    }
36366
36367  } else {
36368    die("Can't open $config_file: $!");
36369  }
36370
36371  # Open pipes, for use between the parent and child processes.  Specifically,
36372  # the child will indicate when it's done with its test by writing a message
36373  # to the parent.
36374  my ($rfh, $wfh);
36375  unless (pipe($rfh, $wfh)) {
36376    die("Can't open pipe: $!");
36377  }
36378
36379  my $ex;
36380
36381  # Fork child
36382  $self->handle_sigchld();
36383  defined(my $pid = fork()) or die("Can't fork: $!");
36384  if ($pid) {
36385    eval {
36386      # First client should be able to connect and log in...
36387      my $client1 = ProFTPD::TestSuite::FTP->new('127.0.0.1', $port);
36388      $client1->login($user, $passwd);
36389
36390      # ...but the second client should be able to connect, but not login.
36391      my $client2 = ProFTPD::TestSuite::FTP->new('127.0.0.1', $port);
36392
36393      eval { $client2->login($user, $passwd) };
36394      unless ($@) {
36395        die("Login succeeded unexpectedly");
36396      }
36397
36398      my $resp_code = $client2->response_code();
36399
36400      my $expected = 530;
36401      $self->assert($expected == $resp_code,
36402        test_msg("Expected $expected, got $resp_code"));
36403
36404      $client1->quit();
36405    };
36406
36407    if ($@) {
36408      $ex = $@;
36409    }
36410
36411    $wfh->print("done\n");
36412    $wfh->flush();
36413
36414  } else {
36415    eval { server_wait($config_file, $rfh) };
36416    if ($@) {
36417      warn($@);
36418      exit 1;
36419    }
36420
36421    exit 0;
36422  }
36423
36424  # Stop server
36425  server_stop($pid_file);
36426
36427  $self->assert_child_ok($pid);
36428
36429  if ($ex) {
36430    test_append_logfile($log_file, $ex);
36431    unlink($log_file);
36432
36433    die($ex);
36434  }
36435
36436  unlink($log_file);
36437}
36438
36439sub sftp_config_max_login_attempts_via_password {
36440  my $self = shift;
36441  my $tmpdir = $self->{tmpdir};
36442  my $setup = test_setup($tmpdir, 'sftp');
36443
36444  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
36445  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
36446
36447  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
36448  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
36449
36450  my $config = {
36451    PidFile => $setup->{pid_file},
36452    ScoreboardFile => $setup->{scoreboard_file},
36453    SystemLog => $setup->{log_file},
36454    TraceLog => $setup->{log_file},
36455    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
36456
36457    AuthUserFile => $setup->{auth_user_file},
36458    AuthGroupFile => $setup->{auth_group_file},
36459    MaxLoginAttempts => 1,
36460
36461    IfModules => {
36462      'mod_delay.c' => {
36463        DelayEngine => 'off',
36464      },
36465
36466      'mod_sftp.c' => [
36467        "SFTPEngine on",
36468        "SFTPLog $setup->{log_file}",
36469        "SFTPHostKey $rsa_host_key",
36470        "SFTPHostKey $dsa_host_key",
36471      ],
36472    },
36473  };
36474
36475  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
36476    $config);
36477
36478  # Open pipes, for use between the parent and child processes.  Specifically,
36479  # the child will indicate when it's done with its test by writing a message
36480  # to the parent.
36481  my ($rfh, $wfh);
36482  unless (pipe($rfh, $wfh)) {
36483    die("Can't open pipe: $!");
36484  }
36485
36486  require Net::SSH2;
36487
36488  my $ex;
36489
36490  # Ignore SIGPIPE
36491  local $SIG{PIPE} = sub { };
36492
36493  # Fork child
36494  $self->handle_sigchld();
36495  defined(my $pid = fork()) or die("Can't fork: $!");
36496  if ($pid) {
36497    eval {
36498      sleep(1);
36499
36500      my $ssh2 = Net::SSH2->new();
36501
36502      unless ($ssh2->connect('127.0.0.1', $port)) {
36503        my ($err_code, $err_name, $err_str) = $ssh2->error();
36504        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36505      }
36506
36507      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
36508        my ($err_code, $err_name, $err_str) = $ssh2->error();
36509        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
36510      }
36511
36512      $ssh2->disconnect();
36513
36514      # Now connect again, try to authenticate via 'publickey', which should
36515      # fail, and then again via 'password', which should also fail, since
36516      # it exceeds the MaxLoginAttempts of 1.
36517
36518      $ssh2 = Net::SSH2->new();
36519      unless ($ssh2->connect('127.0.0.1', $port)) {
36520        my ($err_code, $err_name, $err_str) = $ssh2->error();
36521        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36522      }
36523
36524      if ($ssh2->auth_publickey($setup->{user}, $rsa_pub_key, $rsa_priv_key)) {
36525        die("Publickey auth succeeded unexpectedly");
36526      }
36527
36528      if ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
36529        die("Password auth succeeded unexpectedly");
36530      }
36531    };
36532    if ($@) {
36533      $ex = $@;
36534    }
36535
36536    $wfh->print("done\n");
36537    $wfh->flush();
36538
36539  } else {
36540    eval { server_wait($setup->{config_file}, $rfh) };
36541    if ($@) {
36542      warn($@);
36543      exit 1;
36544    }
36545
36546    exit 0;
36547  }
36548
36549  # Stop server
36550  server_stop($setup->{pid_file});
36551  $self->assert_child_ok($pid);
36552
36553  eval {
36554    if (open(my $fh, "< $setup->{log_file}")) {
36555      my $seen = 0;
36556
36557      while (my $line = <$fh>) {
36558        chomp($line);
36559
36560        if ($ENV{TEST_VERBOSE}) {
36561          print STDERR "# $line\n";
36562        }
36563
36564        if ($line =~ /dispatching LOG_CMD_ERR command .*PASS.* to mod_auth$/) {
36565          $seen++;
36566        }
36567      }
36568
36569      close($fh);
36570
36571      my $expected = 1;
36572      $self->assert($seen == $expected,
36573        test_msg("Expected $expected LOG_CMD_ERR PASS messages, saw $seen"));
36574
36575    } else {
36576      die("Can't read $setup->{log_file}: $!");
36577    }
36578  };
36579  if ($@) {
36580    $ex = $@;
36581  }
36582
36583  test_cleanup($setup->{log_file}, $ex);
36584}
36585
36586sub sftp_config_max_login_attempts_via_publickey {
36587  my $self = shift;
36588  my $tmpdir = $self->{tmpdir};
36589  my $setup = test_setup($tmpdir, 'sftp');
36590
36591  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
36592  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
36593
36594  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
36595  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
36596  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
36597
36598  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
36599  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
36600    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
36601  }
36602
36603  my $config = {
36604    PidFile => $setup->{pid_file},
36605    ScoreboardFile => $setup->{scoreboard_file},
36606    SystemLog => $setup->{log_file},
36607    TraceLog => $setup->{log_file},
36608    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
36609
36610    AuthUserFile => $setup->{auth_user_file},
36611    AuthGroupFile => $setup->{auth_group_file},
36612    MaxLoginAttempts => 1,
36613
36614    IfModules => {
36615      'mod_delay.c' => {
36616        DelayEngine => 'off',
36617      },
36618
36619      'mod_sftp.c' => [
36620        "SFTPEngine on",
36621        "SFTPLog $setup->{log_file}",
36622        "SFTPHostKey $rsa_host_key",
36623        "SFTPHostKey $dsa_host_key",
36624        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
36625      ],
36626    },
36627  };
36628
36629  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
36630    $config);
36631
36632  # Open pipes, for use between the parent and child processes.  Specifically,
36633  # the child will indicate when it's done with its test by writing a message
36634  # to the parent.
36635  my ($rfh, $wfh);
36636  unless (pipe($rfh, $wfh)) {
36637    die("Can't open pipe: $!");
36638  }
36639
36640  require Net::SSH2;
36641
36642  my $ex;
36643
36644  # Ignore SIGPIPE
36645  local $SIG{PIPE} = sub { };
36646
36647  # Fork child
36648  $self->handle_sigchld();
36649  defined(my $pid = fork()) or die("Can't fork: $!");
36650  if ($pid) {
36651    eval {
36652      sleep(1);
36653
36654      my $ssh2 = Net::SSH2->new();
36655      unless ($ssh2->connect('127.0.0.1', $port)) {
36656        my ($err_code, $err_name, $err_str) = $ssh2->error();
36657        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36658      }
36659
36660      unless ($ssh2->auth_publickey($setup->{user}, $rsa_pub_key, $rsa_priv_key)) {
36661        my ($err_code, $err_name, $err_str) = $ssh2->error();
36662        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
36663      }
36664
36665      $ssh2->disconnect();
36666
36667      # Now connect again, try to authenticate via 'password', which should
36668      # fail, and then again via 'publickey', which should also fail, since
36669      # it exceeds the MaxLoginAttempts of 1.
36670
36671      $ssh2 = Net::SSH2->new();
36672      unless ($ssh2->connect('127.0.0.1', $port)) {
36673        my ($err_code, $err_name, $err_str) = $ssh2->error();
36674        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36675      }
36676
36677      if ($ssh2->auth_password($setup->{user}, 'foobar')) {
36678        die("Password auth succeeded unexpectedly");
36679      }
36680
36681      if ($ssh2->auth_publickey($setup->{user}, $rsa_pub_key, $rsa_priv_key)) {
36682        die("Publickey auth succeeded unexpectedly");
36683      }
36684    };
36685    if ($@) {
36686      $ex = $@;
36687    }
36688
36689    $wfh->print("done\n");
36690    $wfh->flush();
36691
36692  } else {
36693    eval { server_wait($setup->{config_file}, $rfh) };
36694    if ($@) {
36695      warn($@);
36696      exit 1;
36697    }
36698
36699    exit 0;
36700  }
36701
36702  # Stop server
36703  server_stop($setup->{pid_file});
36704  $self->assert_child_ok($pid);
36705
36706  eval {
36707    if (open(my $fh, "< $setup->{log_file}")) {
36708      my $seen = 0;
36709
36710      while (my $line = <$fh>) {
36711        chomp($line);
36712
36713        if ($ENV{TEST_VERBOSE}) {
36714          print STDERR "# $line\n";
36715        }
36716
36717        if ($line =~ /dispatching LOG_CMD_ERR command .*PASS.* to mod_auth$/) {
36718          $seen++;
36719        }
36720      }
36721
36722      close($fh);
36723
36724      my $expected = 1;
36725      $self->assert($seen == $expected,
36726        test_msg("Expected $expected LOG_CMD_ERR PASS messages, saw $seen"));
36727
36728    } else {
36729      die("Can't read $setup->{log_file}: $!");
36730    }
36731  };
36732  if ($@) {
36733    $ex = $@;
36734  }
36735
36736  test_cleanup($setup->{log_file}, $ex);
36737}
36738
36739sub sftp_config_max_login_attempts_none_bug4087 {
36740  my $self = shift;
36741  my $tmpdir = $self->{tmpdir};
36742
36743  my $config_file = "$tmpdir/sftp.conf";
36744  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
36745  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
36746
36747  my $log_file = test_get_logfile();
36748
36749  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
36750  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
36751
36752  my $user = 'proftpd';
36753  my $passwd = 'test';
36754  my $group = 'ftpd';
36755  my $home_dir = File::Spec->rel2abs($tmpdir);
36756  my $uid = 500;
36757  my $gid = 500;
36758
36759  # Make sure that, if we're running as root, that the home directory has
36760  # permissions/privs set for the account we create
36761  if ($< == 0) {
36762    unless (chmod(0755, $home_dir)) {
36763      die("Can't set perms on $home_dir to 0755: $!");
36764    }
36765
36766    unless (chown($uid, $gid, $home_dir)) {
36767      die("Can't set owner of $home_dir to $uid/$gid: $!");
36768    }
36769  }
36770
36771  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
36772    '/bin/bash');
36773  auth_group_write($auth_group_file, $group, $gid, $user);
36774
36775  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
36776  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
36777
36778  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
36779  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
36780
36781  my $config = {
36782    PidFile => $pid_file,
36783    ScoreboardFile => $scoreboard_file,
36784    SystemLog => $log_file,
36785    TraceLog => $log_file,
36786    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
36787
36788    AuthUserFile => $auth_user_file,
36789    AuthGroupFile => $auth_group_file,
36790    MaxLoginAttempts => 'none',
36791
36792    IfModules => {
36793      'mod_delay.c' => {
36794        DelayEngine => 'off',
36795      },
36796
36797      'mod_sftp.c' => [
36798        "SFTPEngine on",
36799        "SFTPLog $log_file",
36800        "SFTPHostKey $rsa_host_key",
36801        "SFTPHostKey $dsa_host_key",
36802      ],
36803    },
36804  };
36805
36806  my ($port, $config_user, $config_group) = config_write($config_file, $config);
36807
36808  # Open pipes, for use between the parent and child processes.  Specifically,
36809  # the child will indicate when it's done with its test by writing a message
36810  # to the parent.
36811  my ($rfh, $wfh);
36812  unless (pipe($rfh, $wfh)) {
36813    die("Can't open pipe: $!");
36814  }
36815
36816  require Net::SSH2;
36817
36818  my $ex;
36819
36820  # Ignore SIGPIPE
36821  local $SIG{PIPE} = sub { };
36822
36823  # Fork child
36824  $self->handle_sigchld();
36825  defined(my $pid = fork()) or die("Can't fork: $!");
36826  if ($pid) {
36827    eval {
36828      my $ssh2 = Net::SSH2->new();
36829
36830      sleep(1);
36831
36832      unless ($ssh2->connect('127.0.0.1', $port)) {
36833        my ($err_code, $err_name, $err_str) = $ssh2->error();
36834        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36835      }
36836
36837      unless ($ssh2->auth_password($user, $passwd)) {
36838        my ($err_code, $err_name, $err_str) = $ssh2->error();
36839        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
36840      }
36841
36842      $ssh2->disconnect();
36843
36844      # Now connect again, try to authenticate via 'publickey', which should
36845      # fail, and then again via 'password', which should succeed, since
36846      # we've disabled MaxLoginAttempts using "none".
36847
36848      $ssh2 = Net::SSH2->new();
36849      unless ($ssh2->connect('127.0.0.1', $port)) {
36850        my ($err_code, $err_name, $err_str) = $ssh2->error();
36851        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36852      }
36853
36854      if ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
36855        die("Publickey auth succeeded unexpectedly");
36856      }
36857
36858      unless ($ssh2->auth_password($user, $passwd)) {
36859        my ($err_code, $err_name, $err_str) = $ssh2->error();
36860        die("Can't login to SSH2 server (2nd attempt): [$err_name] ($err_code) $err_str");
36861      }
36862
36863      $ssh2->disconnect();
36864    };
36865
36866    if ($@) {
36867      $ex = $@;
36868    }
36869
36870    $wfh->print("done\n");
36871    $wfh->flush();
36872
36873  } else {
36874    eval { server_wait($config_file, $rfh) };
36875    if ($@) {
36876      warn($@);
36877      exit 1;
36878    }
36879
36880    exit 0;
36881  }
36882
36883  # Stop server
36884  server_stop($pid_file);
36885
36886  $self->assert_child_ok($pid);
36887
36888  if ($ex) {
36889    test_append_logfile($log_file, $ex);
36890    unlink($log_file);
36891
36892    die($ex);
36893  }
36894
36895  unlink($log_file);
36896}
36897
36898sub sftp_config_pathdenyfilter_file {
36899  my $self = shift;
36900  my $tmpdir = $self->{tmpdir};
36901
36902  my $config_file = "$tmpdir/sftp.conf";
36903  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
36904  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
36905
36906  my $log_file = test_get_logfile();
36907
36908  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
36909  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
36910
36911  my $user = 'proftpd';
36912  my $passwd = 'test';
36913  my $group = 'ftpd';
36914  my $home_dir = File::Spec->rel2abs($tmpdir);
36915  my $uid = 500;
36916  my $gid = 500;
36917
36918  # Make sure that, if we're running as root, that the home directory has
36919  # permissions/privs set for the account we create
36920  if ($< == 0) {
36921    unless (chmod(0755, $home_dir)) {
36922      die("Can't set perms on $home_dir to 0755: $!");
36923    }
36924
36925    unless (chown($uid, $gid, $home_dir)) {
36926      die("Can't set owner of $home_dir to $uid/$gid: $!");
36927    }
36928  }
36929
36930  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
36931    '/bin/bash');
36932  auth_group_write($auth_group_file, $group, $gid, $user);
36933
36934  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
36935  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
36936
36937  my $test_file = File::Spec->rel2abs("$home_dir/test.ext");
36938
36939  my $config = {
36940    PidFile => $pid_file,
36941    ScoreboardFile => $scoreboard_file,
36942    SystemLog => $log_file,
36943    TraceLog => $log_file,
36944    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
36945
36946    AuthUserFile => $auth_user_file,
36947    AuthGroupFile => $auth_group_file,
36948
36949    PathDenyFilter => '\.ext$',
36950
36951    IfModules => {
36952      'mod_delay.c' => {
36953        DelayEngine => 'off',
36954      },
36955
36956      'mod_sftp.c' => [
36957        "SFTPEngine on",
36958        "SFTPLog $log_file",
36959        "SFTPHostKey $rsa_host_key",
36960        "SFTPHostKey $dsa_host_key",
36961      ],
36962    },
36963  };
36964
36965  my ($port, $config_user, $config_group) = config_write($config_file, $config);
36966
36967  # Open pipes, for use between the parent and child processes.  Specifically,
36968  # the child will indicate when it's done with its test by writing a message
36969  # to the parent.
36970  my ($rfh, $wfh);
36971  unless (pipe($rfh, $wfh)) {
36972    die("Can't open pipe: $!");
36973  }
36974
36975  require Net::SSH2;
36976
36977  my $ex;
36978
36979  # Ignore SIGPIPE
36980  local $SIG{PIPE} = sub { };
36981
36982  # Fork child
36983  $self->handle_sigchld();
36984  defined(my $pid = fork()) or die("Can't fork: $!");
36985  if ($pid) {
36986    eval {
36987      my $ssh2 = Net::SSH2->new();
36988
36989      sleep(1);
36990
36991      unless ($ssh2->connect('127.0.0.1', $port)) {
36992        my ($err_code, $err_name, $err_str) = $ssh2->error();
36993        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
36994      }
36995
36996      unless ($ssh2->auth_password($user, $passwd)) {
36997        my ($err_code, $err_name, $err_str) = $ssh2->error();
36998        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
36999      }
37000
37001      my $sftp = $ssh2->sftp();
37002      unless ($sftp) {
37003        my ($err_code, $err_name, $err_str) = $ssh2->error();
37004        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
37005      }
37006
37007      my $fh = $sftp->open('test.ext', O_WRONLY|O_CREAT|O_TRUNC, 664);
37008      if ($fh) {
37009        die("OPEN test.ext succeeded unexpectedly");
37010      }
37011
37012      my ($err_code, $err_name) = $sftp->error();
37013
37014      my $expected = 'SSH_FX_PERMISSION_DENIED';
37015      $self->assert($expected eq $err_name,
37016        test_msg("Expected '$expected', got '$err_name'"));
37017
37018      $sftp = undef;
37019      $ssh2->disconnect();
37020
37021      $self->assert(!-f $test_file,
37022        test_msg("File $test_file exists unexpectedly"));
37023    };
37024
37025    if ($@) {
37026      $ex = $@;
37027    }
37028
37029    $wfh->print("done\n");
37030    $wfh->flush();
37031
37032  } else {
37033    eval { server_wait($config_file, $rfh) };
37034    if ($@) {
37035      warn($@);
37036      exit 1;
37037    }
37038
37039    exit 0;
37040  }
37041
37042  # Stop server
37043  server_stop($pid_file);
37044
37045  $self->assert_child_ok($pid);
37046
37047  if ($ex) {
37048    test_append_logfile($log_file, $ex);
37049    unlink($log_file);
37050
37051    die($ex);
37052  }
37053
37054  unlink($log_file);
37055}
37056
37057sub sftp_config_pathdenyfilter_dir {
37058  my $self = shift;
37059  my $tmpdir = $self->{tmpdir};
37060
37061  my $config_file = "$tmpdir/sftp.conf";
37062  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
37063  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
37064
37065  my $log_file = test_get_logfile();
37066
37067  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
37068  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
37069
37070  my $user = 'proftpd';
37071  my $passwd = 'test';
37072  my $group = 'ftpd';
37073  my $home_dir = File::Spec->rel2abs($tmpdir);
37074  my $uid = 500;
37075  my $gid = 500;
37076
37077  # Make sure that, if we're running as root, that the home directory has
37078  # permissions/privs set for the account we create
37079  if ($< == 0) {
37080    unless (chmod(0755, $home_dir)) {
37081      die("Can't set perms on $home_dir to 0755: $!");
37082    }
37083
37084    unless (chown($uid, $gid, $home_dir)) {
37085      die("Can't set owner of $home_dir to $uid/$gid: $!");
37086    }
37087  }
37088
37089  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
37090    '/bin/bash');
37091  auth_group_write($auth_group_file, $group, $gid, $user);
37092
37093  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
37094  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
37095
37096  my $test_dir = File::Spec->rel2abs("$home_dir/sub.dir");
37097
37098  my $config = {
37099    PidFile => $pid_file,
37100    ScoreboardFile => $scoreboard_file,
37101    SystemLog => $log_file,
37102    TraceLog => $log_file,
37103    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
37104
37105    AuthUserFile => $auth_user_file,
37106    AuthGroupFile => $auth_group_file,
37107
37108    PathDenyFilter => '\.dir$',
37109
37110    IfModules => {
37111      'mod_delay.c' => {
37112        DelayEngine => 'off',
37113      },
37114
37115      'mod_sftp.c' => [
37116        "SFTPEngine on",
37117        "SFTPLog $log_file",
37118        "SFTPHostKey $rsa_host_key",
37119        "SFTPHostKey $dsa_host_key",
37120      ],
37121    },
37122  };
37123
37124  my ($port, $config_user, $config_group) = config_write($config_file, $config);
37125
37126  # Open pipes, for use between the parent and child processes.  Specifically,
37127  # the child will indicate when it's done with its test by writing a message
37128  # to the parent.
37129  my ($rfh, $wfh);
37130  unless (pipe($rfh, $wfh)) {
37131    die("Can't open pipe: $!");
37132  }
37133
37134  require Net::SSH2;
37135
37136  my $ex;
37137
37138  # Ignore SIGPIPE
37139  local $SIG{PIPE} = sub { };
37140
37141  # Fork child
37142  $self->handle_sigchld();
37143  defined(my $pid = fork()) or die("Can't fork: $!");
37144  if ($pid) {
37145    eval {
37146      my $ssh2 = Net::SSH2->new();
37147
37148      sleep(1);
37149
37150      unless ($ssh2->connect('127.0.0.1', $port)) {
37151        my ($err_code, $err_name, $err_str) = $ssh2->error();
37152        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37153      }
37154
37155      unless ($ssh2->auth_password($user, $passwd)) {
37156        my ($err_code, $err_name, $err_str) = $ssh2->error();
37157        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
37158      }
37159
37160      my $sftp = $ssh2->sftp();
37161      unless ($sftp) {
37162        my ($err_code, $err_name, $err_str) = $ssh2->error();
37163        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
37164      }
37165
37166      my $res = $sftp->mkdir('sub.dir');
37167      if ($res) {
37168        die("MKDIR sub.dir succeeded unexpectedly");
37169      }
37170
37171      my ($err_code, $err_name) = $sftp->error();
37172
37173      my $expected = 'SSH_FX_PERMISSION_DENIED';
37174      $self->assert($expected eq $err_name,
37175        test_msg("Expected '$expected', got '$err_name'"));
37176
37177      $sftp = undef;
37178      $ssh2->disconnect();
37179
37180      $self->assert(!-d $test_dir,
37181        test_msg("Directory $test_dir exists unexpectedly"));
37182    };
37183
37184    if ($@) {
37185      $ex = $@;
37186    }
37187
37188    $wfh->print("done\n");
37189    $wfh->flush();
37190
37191  } else {
37192    eval { server_wait($config_file, $rfh) };
37193    if ($@) {
37194      warn($@);
37195      exit 1;
37196    }
37197
37198    exit 0;
37199  }
37200
37201  # Stop server
37202  server_stop($pid_file);
37203
37204  $self->assert_child_ok($pid);
37205
37206  if ($ex) {
37207    test_append_logfile($log_file, $ex);
37208    unlink($log_file);
37209
37210    die($ex);
37211  }
37212
37213  unlink($log_file);
37214}
37215
37216sub sftp_config_rekey_short_timeout_failed {
37217  my $self = shift;
37218  my $tmpdir = $self->{tmpdir};
37219
37220  my $config_file = "$tmpdir/sftp.conf";
37221  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
37222  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
37223
37224  my $log_file = test_get_logfile();
37225
37226  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
37227  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
37228
37229  my $user = 'proftpd';
37230  my $passwd = 'test';
37231  my $group = 'ftpd';
37232  my $home_dir = File::Spec->rel2abs($tmpdir);
37233  my $uid = 500;
37234  my $gid = 500;
37235
37236  # Make sure that, if we're running as root, that the home directory has
37237  # permissions/privs set for the account we create
37238  if ($< == 0) {
37239    unless (chmod(0755, $home_dir)) {
37240      die("Can't set perms on $home_dir to 0755: $!");
37241    }
37242
37243    unless (chown($uid, $gid, $home_dir)) {
37244      die("Can't set owner of $home_dir to $uid/$gid: $!");
37245    }
37246  }
37247
37248  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
37249  if (open(my $fh, "> $test_file")) {
37250    print $fh "ABCD" x (1024 * 1024);
37251
37252    unless (close($fh)) {
37253      die("Can't write $test_file: $!");
37254    }
37255
37256  } else {
37257    die("Can't open $test_file: $!");
37258  }
37259
37260  my $test_sz = (stat($test_file))[7];
37261
37262  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
37263    '/bin/bash');
37264  auth_group_write($auth_group_file, $group, $gid, $user);
37265
37266  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
37267  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
37268
37269  my $timeout_idle = 20;
37270
37271  my $config = {
37272    PidFile => $pid_file,
37273    ScoreboardFile => $scoreboard_file,
37274    SystemLog => $log_file,
37275    TraceLog => $log_file,
37276    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
37277
37278    AuthUserFile => $auth_user_file,
37279    AuthGroupFile => $auth_group_file,
37280    TimeoutIdle => $timeout_idle,
37281
37282    IfModules => {
37283      'mod_delay.c' => {
37284        DelayEngine => 'off',
37285      },
37286
37287      'mod_sftp.c' => [
37288        "SFTPEngine on",
37289        "SFTPLog $log_file",
37290        "SFTPHostKey $rsa_host_key",
37291        "SFTPHostKey $dsa_host_key",
37292
37293        "SFTPRekey required 3600 1 1",
37294      ],
37295    },
37296  };
37297
37298  my ($port, $config_user, $config_group) = config_write($config_file, $config);
37299
37300  # Open pipes, for use between the parent and child processes.  Specifically,
37301  # the child will indicate when it's done with its test by writing a message
37302  # to the parent.
37303  my ($rfh, $wfh);
37304  unless (pipe($rfh, $wfh)) {
37305    die("Can't open pipe: $!");
37306  }
37307
37308  require Net::SSH2;
37309
37310  my $ex;
37311
37312  # Ignore SIGPIPE
37313  local $SIG{PIPE} = sub { };
37314
37315  # Fork child
37316  $self->handle_sigchld();
37317  defined(my $pid = fork()) or die("Can't fork: $!");
37318  if ($pid) {
37319    eval {
37320      my $ssh2 = Net::SSH2->new();
37321
37322      sleep(1);
37323
37324      unless ($ssh2->connect('127.0.0.1', $port)) {
37325        my ($err_code, $err_name, $err_str) = $ssh2->error();
37326        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37327      }
37328
37329      unless ($ssh2->auth_password($user, $passwd)) {
37330        my ($err_code, $err_name, $err_str) = $ssh2->error();
37331        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
37332      }
37333
37334      my $sftp = $ssh2->sftp();
37335      unless ($sftp) {
37336        my ($err_code, $err_name, $err_str) = $ssh2->error();
37337        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
37338      }
37339
37340      my $fh = $sftp->open('test.txt', O_RDONLY);
37341      unless ($fh) {
37342        my ($err_code, $err_name) = $sftp->error();
37343        die("Can't open test.txt: [$err_name] ($err_code)");
37344      }
37345
37346      my $buf;
37347      my $size = 0;
37348      my $buflen = (1024 * 250);
37349
37350      my $res = $fh->read($buf, $buflen);
37351      while ($res) {
37352        $size += $res;
37353        sleep(1);
37354
37355        $res = $fh->read($buf, $buflen);
37356      }
37357
37358      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
37359      $fh = undef;
37360
37361      # To close the SFTP channel, we have to explicitly destroy the object
37362      $sftp = undef;
37363
37364      $ssh2->disconnect();
37365
37366      # The only way we really have, given Net::SSH2's API, to detect
37367      # whether the server disconnected us in mid-download is to check the
37368      # number of bytes we downloaded, to see if it's the full size.
37369      #
37370      # With such a short rekey timeout (1 sec), it's not expected that we
37371      # have all of the bytes.
37372      $self->assert($test_sz != $size,
37373        test_msg("Expected !$test_sz, got $size"));
37374    };
37375
37376    if ($@) {
37377      $ex = $@;
37378    }
37379
37380    $wfh->print("done\n");
37381    $wfh->flush();
37382
37383  } else {
37384    eval { server_wait($config_file, $rfh, $timeout_idle + 3) };
37385    if ($@) {
37386      warn($@);
37387      exit 1;
37388    }
37389
37390    exit 0;
37391  }
37392
37393  # Stop server
37394  server_stop($pid_file);
37395
37396  $self->assert_child_ok($pid);
37397
37398  if ($ex) {
37399    test_append_logfile($log_file, $ex);
37400    unlink($log_file);
37401
37402    die($ex);
37403  }
37404
37405  unlink($log_file);
37406}
37407
37408sub sftp_config_rekey_long_timeout_ok {
37409  my $self = shift;
37410  my $tmpdir = $self->{tmpdir};
37411
37412  my $config_file = "$tmpdir/sftp.conf";
37413  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
37414  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
37415
37416  my $log_file = test_get_logfile();
37417
37418  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
37419  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
37420
37421  my $user = 'proftpd';
37422  my $passwd = 'test';
37423  my $group = 'ftpd';
37424  my $home_dir = File::Spec->rel2abs($tmpdir);
37425  my $uid = 500;
37426  my $gid = 500;
37427
37428  # Make sure that, if we're running as root, that the home directory has
37429  # permissions/privs set for the account we create
37430  if ($< == 0) {
37431    unless (chmod(0755, $home_dir)) {
37432      die("Can't set perms on $home_dir to 0755: $!");
37433    }
37434
37435    unless (chown($uid, $gid, $home_dir)) {
37436      die("Can't set owner of $home_dir to $uid/$gid: $!");
37437    }
37438  }
37439
37440  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
37441  if (open(my $fh, "> $test_file")) {
37442    print $fh "ABCD" x (1024 * 1024);
37443
37444    unless (close($fh)) {
37445      die("Can't write $test_file: $!");
37446    }
37447
37448  } else {
37449    die("Can't open $test_file: $!");
37450  }
37451
37452  my $test_sz = (stat($test_file))[7];
37453
37454  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
37455    '/bin/bash');
37456  auth_group_write($auth_group_file, $group, $gid, $user);
37457
37458  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
37459  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
37460
37461  my $timeout_idle = 20;
37462
37463  my $config = {
37464    PidFile => $pid_file,
37465    ScoreboardFile => $scoreboard_file,
37466    SystemLog => $log_file,
37467    TraceLog => $log_file,
37468    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
37469
37470    AuthUserFile => $auth_user_file,
37471    AuthGroupFile => $auth_group_file,
37472    TimeoutIdle => $timeout_idle,
37473
37474    IfModules => {
37475      'mod_delay.c' => {
37476        DelayEngine => 'off',
37477      },
37478
37479      'mod_sftp.c' => [
37480        "SFTPEngine on",
37481        "SFTPLog $log_file",
37482        "SFTPHostKey $rsa_host_key",
37483        "SFTPHostKey $dsa_host_key",
37484
37485        "SFTPRekey required 3600 1 15",
37486      ],
37487    },
37488  };
37489
37490  my ($port, $config_user, $config_group) = config_write($config_file, $config);
37491
37492  # Open pipes, for use between the parent and child processes.  Specifically,
37493  # the child will indicate when it's done with its test by writing a message
37494  # to the parent.
37495  my ($rfh, $wfh);
37496  unless (pipe($rfh, $wfh)) {
37497    die("Can't open pipe: $!");
37498  }
37499
37500  require Net::SSH2;
37501
37502  my $ex;
37503
37504  # Ignore SIGPIPE
37505  local $SIG{PIPE} = sub { };
37506
37507  # Fork child
37508  $self->handle_sigchld();
37509  defined(my $pid = fork()) or die("Can't fork: $!");
37510  if ($pid) {
37511    eval {
37512      my $ssh2 = Net::SSH2->new();
37513
37514      sleep(1);
37515
37516      unless ($ssh2->connect('127.0.0.1', $port)) {
37517        my ($err_code, $err_name, $err_str) = $ssh2->error();
37518        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37519      }
37520
37521      unless ($ssh2->auth_password($user, $passwd)) {
37522        my ($err_code, $err_name, $err_str) = $ssh2->error();
37523        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
37524      }
37525
37526      my $sftp = $ssh2->sftp();
37527      unless ($sftp) {
37528        my ($err_code, $err_name, $err_str) = $ssh2->error();
37529        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
37530      }
37531
37532      my $fh = $sftp->open('test.txt', O_RDONLY);
37533      unless ($fh) {
37534        my ($err_code, $err_name) = $sftp->error();
37535        die("Can't open test.txt: [$err_name] ($err_code)");
37536      }
37537
37538      my $buf;
37539      my $size = 0;
37540      my $buflen = (1024 * 250);
37541
37542      my $res = $fh->read($buf, $buflen);
37543      while ($res) {
37544        $size += $res;
37545        sleep(1);
37546
37547        $res = $fh->read($buf, $buflen);
37548      }
37549
37550      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
37551      $fh = undef;
37552
37553      # To close the SFTP channel, we have to explicitly destroy the object
37554      $sftp = undef;
37555
37556      $ssh2->disconnect();
37557
37558      # The only way we really have, given Net::SSH2's API, to detect
37559      # whether the server disconnected us in mid-download is to check the
37560      # number of bytes we downloaded, to see if it's the full size.
37561      #
37562      # With such long rekey timeout (15 sec), it is expected that we have
37563      # all of the bytes.
37564      $self->assert($test_sz == $size,
37565        test_msg("Expected $test_sz, got $size"));
37566    };
37567
37568    if ($@) {
37569      $ex = $@;
37570    }
37571
37572    $wfh->print("done\n");
37573    $wfh->flush();
37574
37575  } else {
37576    eval { server_wait($config_file, $rfh, $timeout_idle + 3) };
37577    if ($@) {
37578      warn($@);
37579      exit 1;
37580    }
37581
37582    exit 0;
37583  }
37584
37585  # Stop server
37586  server_stop($pid_file);
37587
37588  $self->assert_child_ok($pid);
37589
37590  if ($ex) {
37591    test_append_logfile($log_file, $ex);
37592    unlink($log_file);
37593
37594    die($ex);
37595  }
37596
37597  unlink($log_file);
37598}
37599
37600sub sftp_config_rootlogin {
37601  my $self = shift;
37602  my $tmpdir = $self->{tmpdir};
37603
37604  my $config_file = "$tmpdir/sftp.conf";
37605  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
37606  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
37607
37608  my $log_file = test_get_logfile();
37609
37610  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
37611  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
37612
37613  my $user = 'proftpd';
37614  my $passwd = 'test';
37615  my $group = 'ftpd';
37616  my $home_dir = File::Spec->rel2abs($tmpdir);
37617  my $uid = 0;
37618  my $gid = 0;
37619
37620  # Make sure that, if we're running as root, that the home directory has
37621  # permissions/privs set for the account we create
37622  if ($< == 0) {
37623    unless (chmod(0755, $home_dir)) {
37624      die("Can't set perms on $home_dir to 0755: $!");
37625    }
37626
37627    unless (chown($uid, $gid, $home_dir)) {
37628      die("Can't set owner of $home_dir to $uid/$gid: $!");
37629    }
37630  }
37631
37632  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
37633    '/bin/bash');
37634  auth_group_write($auth_group_file, $group, $gid, $user);
37635
37636  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
37637  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
37638
37639  my $config = {
37640    PidFile => $pid_file,
37641    ScoreboardFile => $scoreboard_file,
37642    SystemLog => $log_file,
37643    TraceLog => $log_file,
37644    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
37645
37646    AuthUserFile => $auth_user_file,
37647    AuthGroupFile => $auth_group_file,
37648
37649    RootLogin => 'off',
37650
37651    IfModules => {
37652      'mod_delay.c' => {
37653        DelayEngine => 'off',
37654      },
37655
37656      'mod_sftp.c' => [
37657        "SFTPEngine on",
37658        "SFTPLog $log_file",
37659        "SFTPHostKey $rsa_host_key",
37660        "SFTPHostKey $dsa_host_key",
37661      ],
37662    },
37663  };
37664
37665  my ($port, $config_user, $config_group) = config_write($config_file, $config);
37666
37667  # Open pipes, for use between the parent and child processes.  Specifically,
37668  # the child will indicate when it's done with its test by writing a message
37669  # to the parent.
37670  my ($rfh, $wfh);
37671  unless (pipe($rfh, $wfh)) {
37672    die("Can't open pipe: $!");
37673  }
37674
37675  require Net::SSH2;
37676
37677  my $ex;
37678
37679  # Ignore SIGPIPE
37680  local $SIG{PIPE} = sub { };
37681
37682  # Fork child
37683  $self->handle_sigchld();
37684  defined(my $pid = fork()) or die("Can't fork: $!");
37685  if ($pid) {
37686    eval {
37687      my $ssh2 = Net::SSH2->new();
37688
37689      sleep(1);
37690
37691      unless ($ssh2->connect('127.0.0.1', $port)) {
37692        my ($err_code, $err_name, $err_str) = $ssh2->error();
37693        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37694      }
37695
37696      if ($ssh2->auth_password($user, $passwd)) {
37697        die("Unexpectedly logged in to SSH2 server");
37698      }
37699    };
37700
37701    if ($@) {
37702      $ex = $@;
37703    }
37704
37705    $wfh->print("done\n");
37706    $wfh->flush();
37707
37708  } else {
37709    eval { server_wait($config_file, $rfh) };
37710    if ($@) {
37711      warn($@);
37712      exit 1;
37713    }
37714
37715    exit 0;
37716  }
37717
37718  # Stop server
37719  server_stop($pid_file);
37720
37721  $self->assert_child_ok($pid);
37722
37723  if ($ex) {
37724    test_append_logfile($log_file, $ex);
37725    unlink($log_file);
37726
37727    die($ex);
37728  }
37729
37730  unlink($log_file);
37731}
37732
37733sub sftp_config_protocols {
37734  my $self = shift;
37735  my $tmpdir = $self->{tmpdir};
37736
37737  my $config_file = "$tmpdir/sftp.conf";
37738  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
37739  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
37740
37741  my $log_file = test_get_logfile();
37742
37743  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
37744  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
37745
37746  my $user = 'proftpd';
37747  my $passwd = 'test';
37748  my $group = 'ftpd';
37749  my $home_dir = File::Spec->rel2abs($tmpdir);
37750  my $uid = 500;
37751  my $gid = 500;
37752
37753  # Make sure that, if we're running as root, that the home directory has
37754  # permissions/privs set for the account we create
37755  if ($< == 0) {
37756    unless (chmod(0755, $home_dir)) {
37757      die("Can't set perms on $home_dir to 0755: $!");
37758    }
37759
37760    unless (chown($uid, $gid, $home_dir)) {
37761      die("Can't set owner of $home_dir to $uid/$gid: $!");
37762    }
37763  }
37764
37765  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
37766    '/bin/bash');
37767  auth_group_write($auth_group_file, $group, $gid, $user);
37768
37769  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
37770  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
37771
37772  my $config = {
37773    PidFile => $pid_file,
37774    ScoreboardFile => $scoreboard_file,
37775    SystemLog => $log_file,
37776    TraceLog => $log_file,
37777    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
37778
37779    AuthUserFile => $auth_user_file,
37780    AuthGroupFile => $auth_group_file,
37781
37782    IfModules => {
37783      'mod_delay.c' => {
37784        DelayEngine => 'off',
37785      },
37786
37787      'mod_sftp.c' => [
37788        "SFTPEngine on",
37789        "SFTPLog $log_file",
37790        "SFTPHostKey $rsa_host_key",
37791        "SFTPHostKey $dsa_host_key",
37792        "Protocols scp",
37793      ],
37794    },
37795  };
37796
37797  my ($port, $config_user, $config_group) = config_write($config_file, $config);
37798
37799  # Open pipes, for use between the parent and child processes.  Specifically,
37800  # the child will indicate when it's done with its test by writing a message
37801  # to the parent.
37802  my ($rfh, $wfh);
37803  unless (pipe($rfh, $wfh)) {
37804    die("Can't open pipe: $!");
37805  }
37806
37807  require Net::SSH2;
37808
37809  my $ex;
37810
37811  # Ignore SIGPIPE
37812  local $SIG{PIPE} = sub { };
37813
37814  # Fork child
37815  $self->handle_sigchld();
37816  defined(my $pid = fork()) or die("Can't fork: $!");
37817  if ($pid) {
37818    eval {
37819      my $ssh2 = Net::SSH2->new();
37820
37821      sleep(1);
37822
37823      unless ($ssh2->connect('127.0.0.1', $port)) {
37824        my ($err_code, $err_name, $err_str) = $ssh2->error();
37825        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37826      }
37827
37828      unless ($ssh2->auth_password($user, $passwd)) {
37829        my ($err_code, $err_name, $err_str) = $ssh2->error();
37830        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37831      }
37832
37833      my $sftp = $ssh2->sftp();
37834      if ($sftp) {
37835        die("SFTP subsystem started unexpectedly");
37836      }
37837
37838      my ($err_code, $err_name, $err_str) = $ssh2->error();
37839
37840      my $expected = 'LIBSSH2_ERROR_CHANNEL_FAILURE';
37841      $self->assert($expected eq $err_name,
37842        test_msg("Expected '$expected', got '$err_name'"));
37843
37844      $ssh2->disconnect();
37845    };
37846
37847    if ($@) {
37848      $ex = $@;
37849    }
37850
37851    $wfh->print("done\n");
37852    $wfh->flush();
37853
37854  } else {
37855    eval { server_wait($config_file, $rfh) };
37856    if ($@) {
37857      warn($@);
37858      exit 1;
37859    }
37860
37861    exit 0;
37862  }
37863
37864  # Stop server
37865  server_stop($pid_file);
37866
37867  $self->assert_child_ok($pid);
37868
37869  if ($ex) {
37870    test_append_logfile($log_file, $ex);
37871    unlink($log_file);
37872
37873    die($ex);
37874  }
37875
37876  unlink($log_file);
37877}
37878
37879sub sftp_config_serverident_off {
37880  my $self = shift;
37881  my $tmpdir = $self->{tmpdir};
37882
37883  my $config_file = "$tmpdir/sftp.conf";
37884  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
37885  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
37886
37887  my $log_file = test_get_logfile();
37888
37889  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
37890  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
37891
37892  my $user = 'proftpd';
37893  my $passwd = 'test';
37894  my $group = 'ftpd';
37895  my $home_dir = File::Spec->rel2abs($tmpdir);
37896  my $uid = 500;
37897  my $gid = 500;
37898
37899  # Make sure that, if we're running as root, that the home directory has
37900  # permissions/privs set for the account we create
37901  if ($< == 0) {
37902    unless (chmod(0755, $home_dir)) {
37903      die("Can't set perms on $home_dir to 0755: $!");
37904    }
37905
37906    unless (chown($uid, $gid, $home_dir)) {
37907      die("Can't set owner of $home_dir to $uid/$gid: $!");
37908    }
37909  }
37910
37911  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
37912    '/bin/bash');
37913  auth_group_write($auth_group_file, $group, $gid, $user);
37914
37915  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
37916  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
37917
37918  my $config = {
37919    PidFile => $pid_file,
37920    ScoreboardFile => $scoreboard_file,
37921    SystemLog => $log_file,
37922    TraceLog => $log_file,
37923    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
37924
37925    AuthUserFile => $auth_user_file,
37926    AuthGroupFile => $auth_group_file,
37927    ServerIdent => 'off',
37928
37929    IfModules => {
37930      'mod_delay.c' => {
37931        DelayEngine => 'off',
37932      },
37933
37934      'mod_sftp.c' => [
37935        "SFTPEngine on",
37936        "SFTPLog $log_file",
37937        "SFTPHostKey $rsa_host_key",
37938        "SFTPHostKey $dsa_host_key",
37939
37940        # Enable this, so that the Telnet connection does not receive the
37941        # KEXINIT data upon connect.
37942        "SFTPOptions PessimisticKexinit",
37943      ],
37944    },
37945  };
37946
37947  my ($port, $config_user, $config_group) = config_write($config_file, $config);
37948
37949  # Open pipes, for use between the parent and child processes.  Specifically,
37950  # the child will indicate when it's done with its test by writing a message
37951  # to the parent.
37952  my ($rfh, $wfh);
37953  unless (pipe($rfh, $wfh)) {
37954    die("Can't open pipe: $!");
37955  }
37956
37957  require Net::SSH2;
37958  require Net::Telnet;
37959
37960  my $ex;
37961
37962  # Ignore SIGPIPE
37963  local $SIG{PIPE} = sub { };
37964
37965  # Fork child
37966  $self->handle_sigchld();
37967  defined(my $pid = fork()) or die("Can't fork: $!");
37968  if ($pid) {
37969    eval {
37970      my $ssh2 = Net::SSH2->new();
37971
37972      sleep(2);
37973
37974      unless ($ssh2->connect('127.0.0.1', $port)) {
37975        my ($err_code, $err_name, $err_str) = $ssh2->error();
37976        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
37977      }
37978
37979      unless ($ssh2->auth_password($user, $passwd)) {
37980        my ($err_code, $err_name, $err_str) = $ssh2->error();
37981        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
37982      }
37983
37984      unless ($ssh2->disconnect('Done with integration test')) {
37985        my ($err_code, $err_name, $err_str) = $ssh2->error();
37986        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
37987      }
37988
37989      $ssh2 = undef;
37990
37991      # Now connect again, this time with a Telnet client, to get the
37992      # SSH version identification string.  The libssh2 API doesn't provide
37993      # a way to get that string, and thus neither does Net::SSH2.
37994      my $telnet = Net::Telnet->new(
37995        Host => '127.0.0.1',
37996        Port => $port,
37997        Timeout => 3,
37998        Errmode => 'return',
37999      );
38000
38001      my $version_id = $telnet->getline();
38002      chomp($version_id);
38003      $telnet->close();
38004
38005      my $expected = 'SSH-2.0-mod_sftp';
38006      $self->assert($version_id eq $expected,
38007        test_msg("Expected SSH version identification '$expected', received '$version_id'"));
38008    };
38009
38010    if ($@) {
38011      $ex = $@;
38012    }
38013
38014    $wfh->print("done\n");
38015    $wfh->flush();
38016
38017  } else {
38018    eval { server_wait($config_file, $rfh) };
38019    if ($@) {
38020      warn($@);
38021      exit 1;
38022    }
38023
38024    exit 0;
38025  }
38026
38027  # Stop server
38028  server_stop($pid_file);
38029
38030  $self->assert_child_ok($pid);
38031
38032  if ($ex) {
38033    test_append_logfile($log_file, $ex);
38034    unlink($log_file);
38035
38036    die($ex);
38037  }
38038
38039  unlink($log_file);
38040}
38041
38042sub sftp_config_serverident_on {
38043  my $self = shift;
38044  my $tmpdir = $self->{tmpdir};
38045
38046  my $config_file = "$tmpdir/sftp.conf";
38047  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
38048  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
38049
38050  my $log_file = test_get_logfile();
38051
38052  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
38053  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
38054
38055  my $user = 'proftpd';
38056  my $passwd = 'test';
38057  my $group = 'ftpd';
38058  my $home_dir = File::Spec->rel2abs($tmpdir);
38059  my $uid = 500;
38060  my $gid = 500;
38061
38062  # Make sure that, if we're running as root, that the home directory has
38063  # permissions/privs set for the account we create
38064  if ($< == 0) {
38065    unless (chmod(0755, $home_dir)) {
38066      die("Can't set perms on $home_dir to 0755: $!");
38067    }
38068
38069    unless (chown($uid, $gid, $home_dir)) {
38070      die("Can't set owner of $home_dir to $uid/$gid: $!");
38071    }
38072  }
38073
38074  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
38075    '/bin/bash');
38076  auth_group_write($auth_group_file, $group, $gid, $user);
38077
38078  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
38079  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
38080
38081  my $config = {
38082    PidFile => $pid_file,
38083    ScoreboardFile => $scoreboard_file,
38084    SystemLog => $log_file,
38085    TraceLog => $log_file,
38086    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
38087
38088    AuthUserFile => $auth_user_file,
38089    AuthGroupFile => $auth_group_file,
38090    ServerIdent => 'on',
38091
38092    IfModules => {
38093      'mod_delay.c' => {
38094        DelayEngine => 'off',
38095      },
38096
38097      'mod_sftp.c' => [
38098        "SFTPEngine on",
38099        "SFTPLog $log_file",
38100        "SFTPHostKey $rsa_host_key",
38101        "SFTPHostKey $dsa_host_key",
38102
38103        # Enable this, so that the Telnet connection does not receive the
38104        # KEXINIT data upon connect.
38105        "SFTPOptions PessimisticKexinit",
38106      ],
38107    },
38108  };
38109
38110  my ($port, $config_user, $config_group) = config_write($config_file, $config);
38111
38112  # Open pipes, for use between the parent and child processes.  Specifically,
38113  # the child will indicate when it's done with its test by writing a message
38114  # to the parent.
38115  my ($rfh, $wfh);
38116  unless (pipe($rfh, $wfh)) {
38117    die("Can't open pipe: $!");
38118  }
38119
38120  require Net::SSH2;
38121  require Net::Telnet;
38122
38123  my $ex;
38124
38125  # Ignore SIGPIPE
38126  local $SIG{PIPE} = sub { };
38127
38128  # Fork child
38129  $self->handle_sigchld();
38130  defined(my $pid = fork()) or die("Can't fork: $!");
38131  if ($pid) {
38132    eval {
38133      my $ssh2 = Net::SSH2->new();
38134
38135      sleep(2);
38136
38137      unless ($ssh2->connect('127.0.0.1', $port)) {
38138        my ($err_code, $err_name, $err_str) = $ssh2->error();
38139        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38140      }
38141
38142      unless ($ssh2->auth_password($user, $passwd)) {
38143        my ($err_code, $err_name, $err_str) = $ssh2->error();
38144        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38145      }
38146
38147      unless ($ssh2->disconnect('Done with integration test')) {
38148        my ($err_code, $err_name, $err_str) = $ssh2->error();
38149        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38150      }
38151
38152      $ssh2 = undef;
38153
38154      # Now connect again, this time with a Telnet client, to get the
38155      # SSH version identification string.  The libssh2 API doesn't provide
38156      # a way to get that string, and thus neither does Net::SSH2.
38157      my $telnet = Net::Telnet->new(
38158        Host => '127.0.0.1',
38159        Port => $port,
38160        Timeout => 3,
38161        Errmode => 'return',
38162      );
38163
38164      my $version_id = $telnet->getline();
38165      chomp($version_id);
38166      $telnet->close();
38167
38168      my $expected = 'SSH-2.0-mod_sftp/\d*\.\d*\.\d*';
38169      $self->assert(qr/$expected/, $version_id,
38170        test_msg("Expected SSH version identification '$expected', received '$version_id'"));
38171    };
38172
38173    if ($@) {
38174      $ex = $@;
38175    }
38176
38177    $wfh->print("done\n");
38178    $wfh->flush();
38179
38180  } else {
38181    eval { server_wait($config_file, $rfh) };
38182    if ($@) {
38183      warn($@);
38184      exit 1;
38185    }
38186
38187    exit 0;
38188  }
38189
38190  # Stop server
38191  server_stop($pid_file);
38192
38193  $self->assert_child_ok($pid);
38194
38195  if ($ex) {
38196    test_append_logfile($log_file, $ex);
38197    unlink($log_file);
38198
38199    die($ex);
38200  }
38201
38202  unlink($log_file);
38203}
38204
38205sub sftp_config_serverident_on_custom {
38206  my $self = shift;
38207  my $tmpdir = $self->{tmpdir};
38208
38209  my $config_file = "$tmpdir/sftp.conf";
38210  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
38211  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
38212
38213  my $log_file = test_get_logfile();
38214
38215  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
38216  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
38217
38218  my $user = 'proftpd';
38219  my $passwd = 'test';
38220  my $group = 'ftpd';
38221  my $home_dir = File::Spec->rel2abs($tmpdir);
38222  my $uid = 500;
38223  my $gid = 500;
38224
38225  # Make sure that, if we're running as root, that the home directory has
38226  # permissions/privs set for the account we create
38227  if ($< == 0) {
38228    unless (chmod(0755, $home_dir)) {
38229      die("Can't set perms on $home_dir to 0755: $!");
38230    }
38231
38232    unless (chown($uid, $gid, $home_dir)) {
38233      die("Can't set owner of $home_dir to $uid/$gid: $!");
38234    }
38235  }
38236
38237  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
38238    '/bin/bash');
38239  auth_group_write($auth_group_file, $group, $gid, $user);
38240
38241  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
38242  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
38243
38244  my $custom_id = "OpenSSH_5.6p1";
38245
38246  my $config = {
38247    PidFile => $pid_file,
38248    ScoreboardFile => $scoreboard_file,
38249    SystemLog => $log_file,
38250    TraceLog => $log_file,
38251    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
38252
38253    AuthUserFile => $auth_user_file,
38254    AuthGroupFile => $auth_group_file,
38255    ServerIdent => "on $custom_id",
38256
38257    IfModules => {
38258      'mod_delay.c' => {
38259        DelayEngine => 'off',
38260      },
38261
38262      'mod_sftp.c' => [
38263        "SFTPEngine on",
38264        "SFTPLog $log_file",
38265        "SFTPHostKey $rsa_host_key",
38266        "SFTPHostKey $dsa_host_key",
38267
38268        # Enable this, so that the Telnet connection does not receive the
38269        # KEXINIT data upon connect.
38270        "SFTPOptions PessimisticKexinit",
38271      ],
38272    },
38273  };
38274
38275  my ($port, $config_user, $config_group) = config_write($config_file, $config);
38276
38277  # Open pipes, for use between the parent and child processes.  Specifically,
38278  # the child will indicate when it's done with its test by writing a message
38279  # to the parent.
38280  my ($rfh, $wfh);
38281  unless (pipe($rfh, $wfh)) {
38282    die("Can't open pipe: $!");
38283  }
38284
38285  require Net::SSH2;
38286  require Net::Telnet;
38287
38288  my $ex;
38289
38290  # Ignore SIGPIPE
38291  local $SIG{PIPE} = sub { };
38292
38293  # Fork child
38294  $self->handle_sigchld();
38295  defined(my $pid = fork()) or die("Can't fork: $!");
38296  if ($pid) {
38297    eval {
38298      my $ssh2 = Net::SSH2->new();
38299
38300      sleep(2);
38301
38302      unless ($ssh2->connect('127.0.0.1', $port)) {
38303        my ($err_code, $err_name, $err_str) = $ssh2->error();
38304        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38305      }
38306
38307      unless ($ssh2->auth_password($user, $passwd)) {
38308        my ($err_code, $err_name, $err_str) = $ssh2->error();
38309        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38310      }
38311
38312      unless ($ssh2->disconnect('Done with integration test')) {
38313        my ($err_code, $err_name, $err_str) = $ssh2->error();
38314        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38315      }
38316
38317      $ssh2 = undef;
38318
38319      # Now connect again, this time with a Telnet client, to get the
38320      # SSH version identification string.  The libssh2 API doesn't provide
38321      # a way to get that string, and thus neither does Net::SSH2.
38322      my $telnet = Net::Telnet->new(
38323        Host => '127.0.0.1',
38324        Port => $port,
38325        Timeout => 3,
38326        Errmode => 'return',
38327      );
38328
38329      my $version_id = $telnet->getline();
38330      chomp($version_id);
38331      $telnet->close();
38332
38333      my $expected = 'SSH-2.0-' . $custom_id;
38334      $self->assert($version_id eq $expected,
38335        test_msg("Expected SSH version identification '$expected', received '$version_id'"));
38336    };
38337
38338    if ($@) {
38339      $ex = $@;
38340    }
38341
38342    $wfh->print("done\n");
38343    $wfh->flush();
38344
38345  } else {
38346    eval { server_wait($config_file, $rfh) };
38347    if ($@) {
38348      warn($@);
38349      exit 1;
38350    }
38351
38352    exit 0;
38353  }
38354
38355  # Stop server
38356  server_stop($pid_file);
38357
38358  $self->assert_child_ok($pid);
38359
38360  if ($ex) {
38361    test_append_logfile($log_file, $ex);
38362    unlink($log_file);
38363
38364    die($ex);
38365  }
38366
38367  unlink($log_file);
38368}
38369
38370sub sftp_config_timeoutidle {
38371  my $self = shift;
38372  my $tmpdir = $self->{tmpdir};
38373
38374  my $config_file = "$tmpdir/sftp.conf";
38375  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
38376  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
38377
38378  my $log_file = test_get_logfile();
38379
38380  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
38381  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
38382
38383  my $user = 'proftpd';
38384  my $passwd = 'test';
38385  my $group = 'ftpd';
38386  my $home_dir = File::Spec->rel2abs($tmpdir);
38387  my $uid = 500;
38388  my $gid = 500;
38389
38390  # Make sure that, if we're running as root, that the home directory has
38391  # permissions/privs set for the account we create
38392  if ($< == 0) {
38393    unless (chmod(0755, $home_dir)) {
38394      die("Can't set perms on $home_dir to 0755: $!");
38395    }
38396
38397    unless (chown($uid, $gid, $home_dir)) {
38398      die("Can't set owner of $home_dir to $uid/$gid: $!");
38399    }
38400  }
38401
38402  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
38403    '/bin/bash');
38404  auth_group_write($auth_group_file, $group, $gid, $user);
38405
38406  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
38407  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
38408
38409  my $timeout_idle = 5;
38410
38411  my $config = {
38412    PidFile => $pid_file,
38413    ScoreboardFile => $scoreboard_file,
38414    SystemLog => $log_file,
38415    TraceLog => $log_file,
38416    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
38417
38418    AuthUserFile => $auth_user_file,
38419    AuthGroupFile => $auth_group_file,
38420    TimeoutIdle => $timeout_idle,
38421
38422    IfModules => {
38423      'mod_delay.c' => {
38424        DelayEngine => 'off',
38425      },
38426
38427      'mod_sftp.c' => [
38428        "SFTPEngine on",
38429        "SFTPLog $log_file",
38430        "SFTPHostKey $rsa_host_key",
38431        "SFTPHostKey $dsa_host_key",
38432      ],
38433    },
38434  };
38435
38436  my ($port, $config_user, $config_group) = config_write($config_file, $config);
38437
38438  # Open pipes, for use between the parent and child processes.  Specifically,
38439  # the child will indicate when it's done with its test by writing a message
38440  # to the parent.
38441  my ($rfh, $wfh);
38442  unless (pipe($rfh, $wfh)) {
38443    die("Can't open pipe: $!");
38444  }
38445
38446  require Net::SSH2;
38447
38448  my $ex;
38449
38450  # Ignore SIGPIPE
38451  local $SIG{PIPE} = sub { };
38452
38453  # Fork child
38454  $self->handle_sigchld();
38455  defined(my $pid = fork()) or die("Can't fork: $!");
38456  if ($pid) {
38457    eval {
38458      my $ssh2 = Net::SSH2->new();
38459
38460      sleep(2);
38461
38462      unless ($ssh2->connect('127.0.0.1', $port)) {
38463        my ($err_code, $err_name, $err_str) = $ssh2->error();
38464        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38465      }
38466
38467      unless ($ssh2->auth_password($user, $passwd)) {
38468        my ($err_code, $err_name, $err_str) = $ssh2->error();
38469        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38470      }
38471
38472      # Wait for more than the idle period
38473      sleep($timeout_idle + 2);
38474
38475      my $sftp = $ssh2->sftp();
38476      if ($sftp) {
38477        die("SFTP subsystem started unexpectedly");
38478      }
38479
38480      my ($err_code, $err_name, $err_str) = $ssh2->error();
38481
38482      my $expected = 'LIBSSH2_ERROR_CHANNEL_FAILURE';
38483      $self->assert($expected eq $err_name,
38484        test_msg("Expected '$expected', got '$err_name'"));
38485
38486      # Try again, this time hitting the TimeoutIdle in the middle of an
38487      # SFTP session
38488
38489      $ssh2 = Net::SSH2->new();
38490
38491      unless ($ssh2->connect('127.0.0.1', $port)) {
38492        my ($err_code, $err_name, $err_str) = $ssh2->error();
38493        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38494      }
38495
38496      unless ($ssh2->auth_password($user, $passwd)) {
38497        my ($err_code, $err_name, $err_str) = $ssh2->error();
38498        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38499      }
38500
38501      $sftp = $ssh2->sftp();
38502      unless ($sftp) {
38503        my ($err_code, $err_name, $err_str) = $ssh2->error();
38504        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
38505      }
38506
38507      # Wait for more than the idle period
38508      sleep($timeout_idle + 2);
38509
38510      my $cwd = $sftp->realpath('.');
38511      if ($cwd) {
38512        die("FXP_REALPATH succeeded unexpectedly");
38513      }
38514
38515      ($err_code, $err_name, $err_str) = $ssh2->error();
38516
38517      $expected = 'LIBSSH2_ERROR_SOCKET_TIMEOUT';
38518      $self->assert($expected eq $err_name,
38519        test_msg("Expected '$expected', got '$err_name'"));
38520    };
38521
38522    if ($@) {
38523      $ex = $@;
38524    }
38525
38526    $wfh->print("done\n");
38527    $wfh->flush();
38528
38529  } else {
38530    eval { server_wait($config_file, $rfh, 30) };
38531    if ($@) {
38532      warn($@);
38533      exit 1;
38534    }
38535
38536    exit 0;
38537  }
38538
38539  # Stop server
38540  server_stop($pid_file);
38541
38542  $self->assert_child_ok($pid);
38543
38544  if ($ex) {
38545    test_append_logfile($log_file, $ex);
38546    unlink($log_file);
38547
38548    die($ex);
38549  }
38550
38551  unlink($log_file);
38552}
38553
38554sub sftp_config_timeoutlogin {
38555  my $self = shift;
38556  my $tmpdir = $self->{tmpdir};
38557
38558  my $config_file = "$tmpdir/sftp.conf";
38559  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
38560  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
38561
38562  my $log_file = test_get_logfile();
38563
38564  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
38565  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
38566
38567  my $user = 'proftpd';
38568  my $passwd = 'test';
38569  my $group = 'ftpd';
38570  my $home_dir = File::Spec->rel2abs($tmpdir);
38571  my $uid = 500;
38572  my $gid = 500;
38573
38574  # Make sure that, if we're running as root, that the home directory has
38575  # permissions/privs set for the account we create
38576  if ($< == 0) {
38577    unless (chmod(0755, $home_dir)) {
38578      die("Can't set perms on $home_dir to 0755: $!");
38579    }
38580
38581    unless (chown($uid, $gid, $home_dir)) {
38582      die("Can't set owner of $home_dir to $uid/$gid: $!");
38583    }
38584  }
38585
38586  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
38587    '/bin/bash');
38588  auth_group_write($auth_group_file, $group, $gid, $user);
38589
38590  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
38591  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
38592
38593  my $timeout_login = 2;
38594
38595  my $config = {
38596    PidFile => $pid_file,
38597    ScoreboardFile => $scoreboard_file,
38598    SystemLog => $log_file,
38599    TraceLog => $log_file,
38600    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
38601
38602    AuthUserFile => $auth_user_file,
38603    AuthGroupFile => $auth_group_file,
38604    TimeoutLogin => $timeout_login,
38605
38606    IfModules => {
38607      'mod_delay.c' => {
38608        DelayEngine => 'off',
38609      },
38610
38611      'mod_sftp.c' => [
38612        "SFTPEngine on",
38613        "SFTPLog $log_file",
38614        "SFTPHostKey $rsa_host_key",
38615        "SFTPHostKey $dsa_host_key",
38616      ],
38617    },
38618  };
38619
38620  my ($port, $config_user, $config_group) = config_write($config_file, $config);
38621
38622  # Open pipes, for use between the parent and child processes.  Specifically,
38623  # the child will indicate when it's done with its test by writing a message
38624  # to the parent.
38625  my ($rfh, $wfh);
38626  unless (pipe($rfh, $wfh)) {
38627    die("Can't open pipe: $!");
38628  }
38629
38630  require Net::SSH2;
38631
38632  my $ex;
38633
38634  # Ignore SIGPIPE
38635  local $SIG{PIPE} = sub { };
38636
38637  # Fork child
38638  $self->handle_sigchld();
38639  defined(my $pid = fork()) or die("Can't fork: $!");
38640  if ($pid) {
38641    eval {
38642      my $ssh2 = Net::SSH2->new();
38643
38644      sleep(1);
38645
38646      unless ($ssh2->connect('127.0.0.1', $port)) {
38647        my ($err_code, $err_name, $err_str) = $ssh2->error();
38648        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38649      }
38650
38651      # Wait for more than the login period
38652      sleep($timeout_login + 2);
38653
38654      if ($ssh2->auth_password($user, $passwd)) {
38655        die("SSH2 login succeeded unexpectedly");
38656      }
38657
38658      my ($err_code, $err_name, $err_str) = $ssh2->error();
38659
38660      my $expected = '(LIBSSH2_ERROR_SOCKET_DISCONNECT|LIBSSH2_ERROR_TIMEOUT)';
38661      $self->assert(qr/$expected/, $err_name,
38662        "Expected '$expected', got '$err_name'");
38663    };
38664
38665    if ($@) {
38666      $ex = $@;
38667    }
38668
38669    $wfh->print("done\n");
38670    $wfh->flush();
38671
38672  } else {
38673    eval { server_wait($config_file, $rfh, 30) };
38674    if ($@) {
38675      warn($@);
38676      exit 1;
38677    }
38678
38679    exit 0;
38680  }
38681
38682  # Stop server
38683  server_stop($pid_file);
38684
38685  $self->assert_child_ok($pid);
38686
38687  if ($ex) {
38688    test_append_logfile($log_file, $ex);
38689    unlink($log_file);
38690
38691    die($ex);
38692  }
38693
38694  unlink($log_file);
38695}
38696
38697sub sftp_config_timeoutnotransfer_download {
38698  my $self = shift;
38699  my $tmpdir = $self->{tmpdir};
38700
38701  my $config_file = "$tmpdir/sftp.conf";
38702  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
38703  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
38704
38705  my $log_file = test_get_logfile();
38706
38707  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
38708  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
38709
38710  my $user = 'proftpd';
38711  my $passwd = 'test';
38712  my $group = 'ftpd';
38713  my $home_dir = File::Spec->rel2abs($tmpdir);
38714  my $uid = 500;
38715  my $gid = 500;
38716
38717  # Make sure that, if we're running as root, that the home directory has
38718  # permissions/privs set for the account we create
38719  if ($< == 0) {
38720    unless (chmod(0755, $home_dir)) {
38721      die("Can't set perms on $home_dir to 0755: $!");
38722    }
38723
38724    unless (chown($uid, $gid, $home_dir)) {
38725      die("Can't set owner of $home_dir to $uid/$gid: $!");
38726    }
38727  }
38728
38729  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
38730    '/bin/bash');
38731  auth_group_write($auth_group_file, $group, $gid, $user);
38732
38733  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
38734  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
38735
38736  my $timeout_noxfer = 2;
38737
38738  my $config = {
38739    PidFile => $pid_file,
38740    ScoreboardFile => $scoreboard_file,
38741    SystemLog => $log_file,
38742    TraceLog => $log_file,
38743    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
38744
38745    AuthUserFile => $auth_user_file,
38746    AuthGroupFile => $auth_group_file,
38747    TimeoutNoTransfer => $timeout_noxfer,
38748
38749    IfModules => {
38750      'mod_delay.c' => {
38751        DelayEngine => 'off',
38752      },
38753
38754      'mod_sftp.c' => [
38755        "SFTPEngine on",
38756        "SFTPLog $log_file",
38757        "SFTPHostKey $rsa_host_key",
38758        "SFTPHostKey $dsa_host_key",
38759      ],
38760    },
38761  };
38762
38763  my ($port, $config_user, $config_group) = config_write($config_file, $config);
38764
38765  # Open pipes, for use between the parent and child processes.  Specifically,
38766  # the child will indicate when it's done with its test by writing a message
38767  # to the parent.
38768  my ($rfh, $wfh);
38769  unless (pipe($rfh, $wfh)) {
38770    die("Can't open pipe: $!");
38771  }
38772
38773  require Net::SSH2;
38774
38775  my $ex;
38776
38777  # Ignore SIGPIPE
38778  local $SIG{PIPE} = sub { };
38779
38780  # Fork child
38781  $self->handle_sigchld();
38782  defined(my $pid = fork()) or die("Can't fork: $!");
38783  if ($pid) {
38784    eval {
38785      my $ssh2 = Net::SSH2->new();
38786
38787      sleep(1);
38788
38789      unless ($ssh2->connect('127.0.0.1', $port)) {
38790        my ($err_code, $err_name, $err_str) = $ssh2->error();
38791        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38792      }
38793
38794      unless ($ssh2->auth_password($user, $passwd)) {
38795        my ($err_code, $err_name, $err_str) = $ssh2->error();
38796        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38797      }
38798
38799      my $sftp = $ssh2->sftp();
38800      unless ($sftp) {
38801        my ($err_code, $err_name, $err_str) = $ssh2->error();
38802        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
38803      }
38804
38805      my $cwd = $sftp->realpath('.');
38806      unless ($cwd) {
38807        my ($err_code, $err_name) = $sftp->error();
38808        die("Can't get real path for '.': [$err_name] ($err_code)");
38809      }
38810
38811      # Wait for more than the no-transfer period
38812      sleep($timeout_noxfer + 2);
38813
38814      my $fh = $sftp->open('test.txt', O_RDONLY);
38815      if ($fh) {
38816        die("FXP_OPEN succeeded unexpectedly");
38817      }
38818
38819      my ($err_code, $err_name, $err_str) = $ssh2->error();
38820
38821      my $expected = 'LIBSSH2_ERROR_SOCKET_NONE';
38822      $self->assert($expected eq $err_name,
38823        test_msg("Expected '$expected', got '$err_name'"));
38824
38825      $sftp = undef;
38826      $ssh2->disconnect();
38827    };
38828
38829    if ($@) {
38830      $ex = $@;
38831    }
38832
38833    $wfh->print("done\n");
38834    $wfh->flush();
38835
38836  } else {
38837    eval { server_wait($config_file, $rfh, 30) };
38838    if ($@) {
38839      warn($@);
38840      exit 1;
38841    }
38842
38843    exit 0;
38844  }
38845
38846  # Stop server
38847  server_stop($pid_file);
38848
38849  $self->assert_child_ok($pid);
38850
38851  if ($ex) {
38852    test_append_logfile($log_file, $ex);
38853    unlink($log_file);
38854
38855    die($ex);
38856  }
38857
38858  unlink($log_file);
38859}
38860
38861sub sftp_config_timeoutnotransfer_readdir {
38862  my $self = shift;
38863  my $tmpdir = $self->{tmpdir};
38864
38865  my $config_file = "$tmpdir/sftp.conf";
38866  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
38867  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
38868
38869  my $log_file = test_get_logfile();
38870
38871  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
38872  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
38873
38874  my $user = 'proftpd';
38875  my $passwd = 'test';
38876  my $group = 'ftpd';
38877  my $home_dir = File::Spec->rel2abs($tmpdir);
38878  my $uid = 500;
38879  my $gid = 500;
38880
38881  # Make sure that, if we're running as root, that the home directory has
38882  # permissions/privs set for the account we create
38883  if ($< == 0) {
38884    unless (chmod(0755, $home_dir)) {
38885      die("Can't set perms on $home_dir to 0755: $!");
38886    }
38887
38888    unless (chown($uid, $gid, $home_dir)) {
38889      die("Can't set owner of $home_dir to $uid/$gid: $!");
38890    }
38891  }
38892
38893  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
38894    '/bin/bash');
38895  auth_group_write($auth_group_file, $group, $gid, $user);
38896
38897  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
38898  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
38899
38900  my $timeout_noxfer = 2;
38901
38902  my $config = {
38903    PidFile => $pid_file,
38904    ScoreboardFile => $scoreboard_file,
38905    SystemLog => $log_file,
38906    TraceLog => $log_file,
38907    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
38908
38909    AuthUserFile => $auth_user_file,
38910    AuthGroupFile => $auth_group_file,
38911    TimeoutNoTransfer => $timeout_noxfer,
38912
38913    IfModules => {
38914      'mod_delay.c' => {
38915        DelayEngine => 'off',
38916      },
38917
38918      'mod_sftp.c' => [
38919        "SFTPEngine on",
38920        "SFTPLog $log_file",
38921        "SFTPHostKey $rsa_host_key",
38922        "SFTPHostKey $dsa_host_key",
38923      ],
38924    },
38925  };
38926
38927  my ($port, $config_user, $config_group) = config_write($config_file, $config);
38928
38929  # Open pipes, for use between the parent and child processes.  Specifically,
38930  # the child will indicate when it's done with its test by writing a message
38931  # to the parent.
38932  my ($rfh, $wfh);
38933  unless (pipe($rfh, $wfh)) {
38934    die("Can't open pipe: $!");
38935  }
38936
38937  require Net::SSH2;
38938
38939  my $ex;
38940
38941  # Ignore SIGPIPE
38942  local $SIG{PIPE} = sub { };
38943
38944  # Fork child
38945  $self->handle_sigchld();
38946  defined(my $pid = fork()) or die("Can't fork: $!");
38947  if ($pid) {
38948    eval {
38949      my $ssh2 = Net::SSH2->new();
38950
38951      sleep(1);
38952
38953      unless ($ssh2->connect('127.0.0.1', $port)) {
38954        my ($err_code, $err_name, $err_str) = $ssh2->error();
38955        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
38956      }
38957
38958      unless ($ssh2->auth_password($user, $passwd)) {
38959        my ($err_code, $err_name, $err_str) = $ssh2->error();
38960        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
38961      }
38962
38963      my $sftp = $ssh2->sftp();
38964      unless ($sftp) {
38965        my ($err_code, $err_name, $err_str) = $ssh2->error();
38966        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
38967      }
38968
38969      my $cwd = $sftp->realpath('.');
38970      unless ($cwd) {
38971        my ($err_code, $err_name) = $sftp->error();
38972        die("Can't get real path for '.': [$err_name] ($err_code)");
38973      }
38974
38975      # Wait for more than the no-transfer period
38976      sleep($timeout_noxfer + 2);
38977
38978      my $dir = $sftp->opendir('.');
38979      if ($dir) {
38980        die("FXP_OPENDIR succeeded unexpectedly");
38981      }
38982
38983      my ($err_code, $err_name, $err_str) = $ssh2->error();
38984
38985      my $expected = 'LIBSSH2_ERROR_SOCKET_NONE';
38986      $self->assert($expected eq $err_name,
38987        test_msg("Expected '$expected', got '$err_name'"));
38988
38989      $sftp = undef;
38990      $ssh2->disconnect();
38991    };
38992
38993    if ($@) {
38994      $ex = $@;
38995    }
38996
38997    $wfh->print("done\n");
38998    $wfh->flush();
38999
39000  } else {
39001    eval { server_wait($config_file, $rfh, 30) };
39002    if ($@) {
39003      warn($@);
39004      exit 1;
39005    }
39006
39007    exit 0;
39008  }
39009
39010  # Stop server
39011  server_stop($pid_file);
39012
39013  $self->assert_child_ok($pid);
39014
39015  if ($ex) {
39016    test_append_logfile($log_file, $ex);
39017    unlink($log_file);
39018
39019    die($ex);
39020  }
39021
39022  unlink($log_file);
39023}
39024
39025sub sftp_config_timeoutnotransfer_upload {
39026  my $self = shift;
39027  my $tmpdir = $self->{tmpdir};
39028
39029  my $config_file = "$tmpdir/sftp.conf";
39030  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
39031  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
39032
39033  my $log_file = test_get_logfile();
39034
39035  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
39036  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
39037
39038  my $user = 'proftpd';
39039  my $passwd = 'test';
39040  my $group = 'ftpd';
39041  my $home_dir = File::Spec->rel2abs($tmpdir);
39042  my $uid = 500;
39043  my $gid = 500;
39044
39045  # Make sure that, if we're running as root, that the home directory has
39046  # permissions/privs set for the account we create
39047  if ($< == 0) {
39048    unless (chmod(0755, $home_dir)) {
39049      die("Can't set perms on $home_dir to 0755: $!");
39050    }
39051
39052    unless (chown($uid, $gid, $home_dir)) {
39053      die("Can't set owner of $home_dir to $uid/$gid: $!");
39054    }
39055  }
39056
39057  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
39058    '/bin/bash');
39059  auth_group_write($auth_group_file, $group, $gid, $user);
39060
39061  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
39062  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
39063
39064  my $timeout_noxfer = 2;
39065
39066  my $config = {
39067    PidFile => $pid_file,
39068    ScoreboardFile => $scoreboard_file,
39069    SystemLog => $log_file,
39070    TraceLog => $log_file,
39071    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
39072
39073    AuthUserFile => $auth_user_file,
39074    AuthGroupFile => $auth_group_file,
39075    TimeoutNoTransfer => $timeout_noxfer,
39076
39077    IfModules => {
39078      'mod_delay.c' => {
39079        DelayEngine => 'off',
39080      },
39081
39082      'mod_sftp.c' => [
39083        "SFTPEngine on",
39084        "SFTPLog $log_file",
39085        "SFTPHostKey $rsa_host_key",
39086        "SFTPHostKey $dsa_host_key",
39087      ],
39088    },
39089  };
39090
39091  my ($port, $config_user, $config_group) = config_write($config_file, $config);
39092
39093  # Open pipes, for use between the parent and child processes.  Specifically,
39094  # the child will indicate when it's done with its test by writing a message
39095  # to the parent.
39096  my ($rfh, $wfh);
39097  unless (pipe($rfh, $wfh)) {
39098    die("Can't open pipe: $!");
39099  }
39100
39101  require Net::SSH2;
39102
39103  my $ex;
39104
39105  # Ignore SIGPIPE
39106  local $SIG{PIPE} = sub { };
39107
39108  # Fork child
39109  $self->handle_sigchld();
39110  defined(my $pid = fork()) or die("Can't fork: $!");
39111  if ($pid) {
39112    eval {
39113      my $ssh2 = Net::SSH2->new();
39114
39115      sleep(1);
39116
39117      unless ($ssh2->connect('127.0.0.1', $port)) {
39118        my ($err_code, $err_name, $err_str) = $ssh2->error();
39119        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
39120      }
39121
39122      unless ($ssh2->auth_password($user, $passwd)) {
39123        my ($err_code, $err_name, $err_str) = $ssh2->error();
39124        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
39125      }
39126
39127      my $sftp = $ssh2->sftp();
39128      unless ($sftp) {
39129        my ($err_code, $err_name, $err_str) = $ssh2->error();
39130        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
39131      }
39132
39133      my $cwd = $sftp->realpath('.');
39134      unless ($cwd) {
39135        my ($err_code, $err_name) = $sftp->error();
39136        die("Can't get real path for '.': [$err_name] ($err_code)");
39137      }
39138
39139      # Wait for more than the no-transfer period
39140      sleep($timeout_noxfer + 2);
39141
39142      my $fh = $sftp->open('test.txt', O_CREAT|O_WRONLY);
39143      if ($fh) {
39144        die("FXP_OPEN succeeded unexpectedly");
39145      }
39146
39147      my ($err_code, $err_name, $err_str) = $ssh2->error();
39148
39149      my $expected = 'LIBSSH2_ERROR_SOCKET_NONE';
39150      $self->assert($expected eq $err_name,
39151        test_msg("Expected '$expected', got '$err_name'"));
39152
39153      $sftp = undef;
39154      $ssh2->disconnect();
39155    };
39156
39157    if ($@) {
39158      $ex = $@;
39159    }
39160
39161    $wfh->print("done\n");
39162    $wfh->flush();
39163
39164  } else {
39165    eval { server_wait($config_file, $rfh, 30) };
39166    if ($@) {
39167      warn($@);
39168      exit 1;
39169    }
39170
39171    exit 0;
39172  }
39173
39174  # Stop server
39175  server_stop($pid_file);
39176
39177  $self->assert_child_ok($pid);
39178
39179  if ($ex) {
39180    test_append_logfile($log_file, $ex);
39181    unlink($log_file);
39182
39183    die($ex);
39184  }
39185
39186  unlink($log_file);
39187}
39188
39189sub sftp_config_timeoutstalled {
39190  my $self = shift;
39191  my $tmpdir = $self->{tmpdir};
39192
39193  my $config_file = "$tmpdir/sftp.conf";
39194  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
39195  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
39196
39197  my $log_file = test_get_logfile();
39198
39199  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
39200  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
39201
39202  my $user = 'proftpd';
39203  my $passwd = 'test';
39204  my $group = 'ftpd';
39205  my $home_dir = File::Spec->rel2abs($tmpdir);
39206  my $uid = 500;
39207  my $gid = 500;
39208
39209  # Make sure that, if we're running as root, that the home directory has
39210  # permissions/privs set for the account we create
39211  if ($< == 0) {
39212    unless (chmod(0755, $home_dir)) {
39213      die("Can't set perms on $home_dir to 0755: $!");
39214    }
39215
39216    unless (chown($uid, $gid, $home_dir)) {
39217      die("Can't set owner of $home_dir to $uid/$gid: $!");
39218    }
39219  }
39220
39221  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
39222    '/bin/bash');
39223  auth_group_write($auth_group_file, $group, $gid, $user);
39224
39225  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
39226  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
39227
39228  my $timeout_stalled = 2;
39229
39230  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
39231  if (open(my $fh, "> $test_file")) {
39232    print $fh "ABCDefgh" x 32768;
39233
39234    unless (close($fh)) {
39235      die("Can't write $test_file: $!");
39236    }
39237
39238  } else {
39239    die("Can't open $test_file: $!");
39240  }
39241
39242  my $config = {
39243    PidFile => $pid_file,
39244    ScoreboardFile => $scoreboard_file,
39245    SystemLog => $log_file,
39246    TraceLog => $log_file,
39247    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
39248
39249    AuthUserFile => $auth_user_file,
39250    AuthGroupFile => $auth_group_file,
39251    TimeoutStalled => $timeout_stalled,
39252
39253    IfModules => {
39254      'mod_delay.c' => {
39255        DelayEngine => 'off',
39256      },
39257
39258      'mod_sftp.c' => [
39259        "SFTPEngine on",
39260        "SFTPLog $log_file",
39261        "SFTPHostKey $rsa_host_key",
39262        "SFTPHostKey $dsa_host_key",
39263      ],
39264    },
39265  };
39266
39267  my ($port, $config_user, $config_group) = config_write($config_file, $config);
39268
39269  # Open pipes, for use between the parent and child processes.  Specifically,
39270  # the child will indicate when it's done with its test by writing a message
39271  # to the parent.
39272  my ($rfh, $wfh);
39273  unless (pipe($rfh, $wfh)) {
39274    die("Can't open pipe: $!");
39275  }
39276
39277  require Net::SSH2;
39278
39279  my $ex;
39280
39281  # Ignore SIGPIPE
39282  local $SIG{PIPE} = sub { };
39283
39284  # Fork child
39285  $self->handle_sigchld();
39286  defined(my $pid = fork()) or die("Can't fork: $!");
39287  if ($pid) {
39288    eval {
39289      my $ssh2 = Net::SSH2->new();
39290
39291      sleep(1);
39292
39293      unless ($ssh2->connect('127.0.0.1', $port)) {
39294        my ($err_code, $err_name, $err_str) = $ssh2->error();
39295        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
39296      }
39297
39298      unless ($ssh2->auth_password($user, $passwd)) {
39299        my ($err_code, $err_name, $err_str) = $ssh2->error();
39300        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
39301      }
39302
39303      my $sftp = $ssh2->sftp();
39304      unless ($sftp) {
39305        my ($err_code, $err_name, $err_str) = $ssh2->error();
39306        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
39307      }
39308
39309      my $fh = $sftp->open('test.txt', O_RDONLY);
39310      unless ($fh) {
39311        my ($err_code, $err_name) = $sftp->error();
39312        die("Can't open test.txt: [$err_name] ($err_code)");
39313      }
39314
39315      my $buf;
39316      my $size = 0;
39317
39318      my $res = $fh->read($buf, 8192);
39319      while ($res) {
39320        $size += $res;
39321
39322        # Sleep for longer than the TimeoutStalled period
39323        sleep($timeout_stalled + 2);
39324
39325        $res = $fh->read($buf, 8192);
39326      }
39327
39328      my ($err_code, $err_name, $err_str) = $ssh2->error();
39329
39330      my $expected = 'LIBSSH2_ERROR_SOCKET_NONE';
39331      $self->assert($expected eq $err_name,
39332        test_msg("Expected '$expected', got '$err_name'"));
39333
39334      $sftp = undef;
39335      $ssh2->disconnect();
39336    };
39337
39338    if ($@) {
39339      $ex = $@;
39340    }
39341
39342    $wfh->print("done\n");
39343    $wfh->flush();
39344
39345  } else {
39346    eval { server_wait($config_file, $rfh, 30) };
39347    if ($@) {
39348      warn($@);
39349      exit 1;
39350    }
39351
39352    exit 0;
39353  }
39354
39355  # Stop server
39356  server_stop($pid_file);
39357
39358  $self->assert_child_ok($pid);
39359
39360  if ($ex) {
39361    test_append_logfile($log_file, $ex);
39362    unlink($log_file);
39363
39364    die($ex);
39365  }
39366
39367  unlink($log_file);
39368}
39369
39370sub sftp_config_ignore_upload_perms_upload {
39371  my $self = shift;
39372  my $tmpdir = $self->{tmpdir};
39373
39374  my $config_file = "$tmpdir/sftp.conf";
39375  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
39376  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
39377
39378  my $log_file = test_get_logfile();
39379
39380  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
39381  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
39382
39383  my $user = 'proftpd';
39384  my $passwd = 'test';
39385  my $group = 'ftpd';
39386  my $home_dir = File::Spec->rel2abs($tmpdir);
39387  my $uid = 500;
39388  my $gid = 500;
39389
39390  # Make sure that, if we're running as root, that the home directory has
39391  # permissions/privs set for the account we create
39392  if ($< == 0) {
39393    unless (chmod(0755, $home_dir)) {
39394      die("Can't set perms on $home_dir to 0755: $!");
39395    }
39396
39397    unless (chown($uid, $gid, $home_dir)) {
39398      die("Can't set owner of $home_dir to $uid/$gid: $!");
39399    }
39400  }
39401
39402  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
39403    '/bin/bash');
39404  auth_group_write($auth_group_file, $group, $gid, $user);
39405
39406  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
39407  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
39408
39409  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
39410
39411  my $config = {
39412    PidFile => $pid_file,
39413    ScoreboardFile => $scoreboard_file,
39414    SystemLog => $log_file,
39415    TraceLog => $log_file,
39416    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
39417
39418    AuthUserFile => $auth_user_file,
39419    AuthGroupFile => $auth_group_file,
39420
39421    IfModules => {
39422      'mod_delay.c' => {
39423        DelayEngine => 'off',
39424      },
39425
39426      'mod_sftp.c' => [
39427        "SFTPEngine on",
39428        "SFTPLog $log_file",
39429        "SFTPHostKey $rsa_host_key",
39430        "SFTPHostKey $dsa_host_key",
39431
39432        "SFTPOptions IgnoreSFTPUploadPerms",
39433      ],
39434    },
39435  };
39436
39437  my ($port, $config_user, $config_group) = config_write($config_file, $config);
39438
39439  # Open pipes, for use between the parent and child processes.  Specifically,
39440  # the child will indicate when it's done with its test by writing a message
39441  # to the parent.
39442  my ($rfh, $wfh);
39443  unless (pipe($rfh, $wfh)) {
39444    die("Can't open pipe: $!");
39445  }
39446
39447  require Net::SSH2;
39448
39449  my $ex;
39450
39451  # Ignore SIGPIPE
39452  local $SIG{PIPE} = sub { };
39453
39454  # Fork child
39455  $self->handle_sigchld();
39456  defined(my $pid = fork()) or die("Can't fork: $!");
39457  if ($pid) {
39458    eval {
39459      my $ssh2 = Net::SSH2->new();
39460
39461      sleep(1);
39462
39463      unless ($ssh2->connect('127.0.0.1', $port)) {
39464        my ($err_code, $err_name, $err_str) = $ssh2->error();
39465        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
39466      }
39467
39468      unless ($ssh2->auth_password($user, $passwd)) {
39469        my ($err_code, $err_name, $err_str) = $ssh2->error();
39470        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
39471      }
39472
39473      my $sftp = $ssh2->sftp();
39474      unless ($sftp) {
39475        my ($err_code, $err_name, $err_str) = $ssh2->error();
39476        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
39477      }
39478
39479      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0666);
39480      unless ($fh) {
39481        my ($err_code, $err_name) = $sftp->error();
39482        die("Can't open test.txt: [$err_name] ($err_code)");
39483      }
39484
39485      my $count = 20;
39486      for (my $i = 0; $i < $count; $i++) {
39487        print $fh "ABCD" x 8192;
39488      }
39489
39490      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
39491      $fh = undef;
39492
39493      # To close the SFTP channel, we have to explicitly destroy the object
39494      $sftp = undef;
39495
39496      $ssh2->disconnect();
39497    };
39498
39499    if ($@) {
39500      $ex = $@;
39501    }
39502
39503    $wfh->print("done\n");
39504    $wfh->flush();
39505
39506  } else {
39507    eval { server_wait($config_file, $rfh) };
39508    if ($@) {
39509      warn($@);
39510      exit 1;
39511    }
39512
39513    exit 0;
39514  }
39515
39516  # Stop server
39517  server_stop($pid_file);
39518
39519  $self->assert_child_ok($pid);
39520
39521  if ($ex) {
39522    test_append_logfile($log_file, $ex);
39523    unlink($log_file);
39524
39525    die($ex);
39526  }
39527
39528  my $perms = ((stat($test_file))[2] & 07777);
39529
39530  my $expected = 0644;
39531  $self->assert($expected == $perms,
39532    test_msg("Expected '$expected', got '$perms'"));
39533
39534  unlink($log_file);
39535}
39536
39537sub sftp_config_ignore_upload_perms_mkdir_bug3680 {
39538  my $self = shift;
39539  my $tmpdir = $self->{tmpdir};
39540
39541  my $config_file = "$tmpdir/sftp.conf";
39542  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
39543  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
39544
39545  my $log_file = test_get_logfile();
39546
39547  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
39548  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
39549
39550  my $user = 'proftpd';
39551  my $passwd = 'test';
39552  my $group = 'ftpd';
39553  my $home_dir = File::Spec->rel2abs($tmpdir);
39554  my $uid = 500;
39555  my $gid = 500;
39556
39557  # Make sure that, if we're running as root, that the home directory has
39558  # permissions/privs set for the account we create
39559  if ($< == 0) {
39560    unless (chmod(0755, $home_dir)) {
39561      die("Can't set perms on $home_dir to 0755: $!");
39562    }
39563
39564    unless (chown($uid, $gid, $home_dir)) {
39565      die("Can't set owner of $home_dir to $uid/$gid: $!");
39566    }
39567  }
39568
39569  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
39570    '/bin/bash');
39571  auth_group_write($auth_group_file, $group, $gid, $user);
39572
39573  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
39574  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
39575
39576  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
39577
39578  my $config = {
39579    PidFile => $pid_file,
39580    ScoreboardFile => $scoreboard_file,
39581    SystemLog => $log_file,
39582    TraceLog => $log_file,
39583    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
39584
39585    AuthUserFile => $auth_user_file,
39586    AuthGroupFile => $auth_group_file,
39587
39588    IfModules => {
39589      'mod_delay.c' => {
39590        DelayEngine => 'off',
39591      },
39592
39593      'mod_sftp.c' => [
39594        "SFTPEngine on",
39595        "SFTPLog $log_file",
39596        "SFTPHostKey $rsa_host_key",
39597        "SFTPHostKey $dsa_host_key",
39598
39599        "SFTPOptions IgnoreSFTPUploadPerms",
39600      ],
39601    },
39602  };
39603
39604  my ($port, $config_user, $config_group) = config_write($config_file, $config);
39605
39606  # Open pipes, for use between the parent and child processes.  Specifically,
39607  # the child will indicate when it's done with its test by writing a message
39608  # to the parent.
39609  my ($rfh, $wfh);
39610  unless (pipe($rfh, $wfh)) {
39611    die("Can't open pipe: $!");
39612  }
39613
39614  require Net::SSH2;
39615
39616  my $ex;
39617
39618  # Ignore SIGPIPE
39619  local $SIG{PIPE} = sub { };
39620
39621  # Fork child
39622  $self->handle_sigchld();
39623  defined(my $pid = fork()) or die("Can't fork: $!");
39624  if ($pid) {
39625    eval {
39626      my $ssh2 = Net::SSH2->new();
39627
39628      sleep(1);
39629
39630      unless ($ssh2->connect('127.0.0.1', $port)) {
39631        my ($err_code, $err_name, $err_str) = $ssh2->error();
39632        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
39633      }
39634
39635      unless ($ssh2->auth_password($user, $passwd)) {
39636        my ($err_code, $err_name, $err_str) = $ssh2->error();
39637        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
39638      }
39639
39640      my $sftp = $ssh2->sftp();
39641      unless ($sftp) {
39642        my ($err_code, $err_name, $err_str) = $ssh2->error();
39643        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
39644      }
39645
39646      my $res = $sftp->mkdir('testdir', 0511);
39647      unless ($res) {
39648        my ($err_code, $err_name) = $sftp->error();
39649        die("Can't mkdir testdir: [$err_name] ($err_code)");
39650      }
39651
39652      $sftp = undef;
39653      $ssh2->disconnect();
39654    };
39655
39656    if ($@) {
39657      $ex = $@;
39658    }
39659
39660    $wfh->print("done\n");
39661    $wfh->flush();
39662
39663  } else {
39664    eval { server_wait($config_file, $rfh) };
39665    if ($@) {
39666      warn($@);
39667      exit 1;
39668    }
39669
39670    exit 0;
39671  }
39672
39673  # Stop server
39674  server_stop($pid_file);
39675
39676  $self->assert_child_ok($pid);
39677
39678  if ($ex) {
39679    test_append_logfile($log_file, $ex);
39680    unlink($log_file);
39681
39682    die($ex);
39683  }
39684
39685  unless (-d $test_dir) {
39686    die("$test_dir directory does not exist as expected");
39687  }
39688
39689  my $perms = ((stat($test_dir))[2] & 07777);
39690
39691  my $expected = 0755;
39692  $self->assert($expected == $perms,
39693    test_msg("Expected '$expected', got '$perms'"));
39694
39695  unlink($log_file);
39696}
39697
39698sub sftp_config_ignore_set_perms_bug3599 {
39699  my $self = shift;
39700  my $tmpdir = $self->{tmpdir};
39701
39702  my $config_file = "$tmpdir/sftp.conf";
39703  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
39704  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
39705
39706  my $log_file = test_get_logfile();
39707
39708  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
39709  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
39710
39711  my $user = 'proftpd';
39712  my $passwd = 'test';
39713  my $group = 'ftpd';
39714  my $home_dir = File::Spec->rel2abs($tmpdir);
39715  my $uid = 500;
39716  my $gid = 500;
39717
39718  # Make sure that, if we're running as root, that the home directory has
39719  # permissions/privs set for the account we create
39720  if ($< == 0) {
39721    unless (chmod(0755, $home_dir)) {
39722      die("Can't set perms on $home_dir to 0755: $!");
39723    }
39724
39725    unless (chown($uid, $gid, $home_dir)) {
39726      die("Can't set owner of $home_dir to $uid/$gid: $!");
39727    }
39728  }
39729
39730  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
39731    '/bin/bash');
39732  auth_group_write($auth_group_file, $group, $gid, $user);
39733
39734  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
39735  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
39736
39737  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
39738  if (open(my $fh, "> $test_file")) {
39739    print $fh "Hello, World!\n";
39740
39741    unless (close($fh)) {
39742      die("Can't write $test_file: $!");
39743    }
39744
39745  } else {
39746    die("Can't open $test_file: $!");
39747  }
39748
39749  my $config = {
39750    PidFile => $pid_file,
39751    ScoreboardFile => $scoreboard_file,
39752    SystemLog => $log_file,
39753    TraceLog => $log_file,
39754    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
39755
39756    AuthUserFile => $auth_user_file,
39757    AuthGroupFile => $auth_group_file,
39758
39759    IfModules => {
39760      'mod_delay.c' => {
39761        DelayEngine => 'off',
39762      },
39763
39764      'mod_sftp.c' => [
39765        "SFTPEngine on",
39766        "SFTPLog $log_file",
39767        "SFTPHostKey $rsa_host_key",
39768        "SFTPHostKey $dsa_host_key",
39769
39770        "SFTPOptions IgnoreSFTPSetPerms",
39771      ],
39772    },
39773  };
39774
39775  my ($port, $config_user, $config_group) = config_write($config_file, $config);
39776
39777  # Open pipes, for use between the parent and child processes.  Specifically,
39778  # the child will indicate when it's done with its test by writing a message
39779  # to the parent.
39780  my ($rfh, $wfh);
39781  unless (pipe($rfh, $wfh)) {
39782    die("Can't open pipe: $!");
39783  }
39784
39785  require Net::SSH2;
39786
39787  my $ex;
39788
39789  # Ignore SIGPIPE
39790  local $SIG{PIPE} = sub { };
39791
39792  # Fork child
39793  $self->handle_sigchld();
39794  defined(my $pid = fork()) or die("Can't fork: $!");
39795  if ($pid) {
39796    eval {
39797      my $ssh2 = Net::SSH2->new();
39798
39799      sleep(1);
39800
39801      unless ($ssh2->connect('127.0.0.1', $port)) {
39802        my ($err_code, $err_name, $err_str) = $ssh2->error();
39803        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
39804      }
39805
39806      unless ($ssh2->auth_password($user, $passwd)) {
39807        my ($err_code, $err_name, $err_str) = $ssh2->error();
39808        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
39809      }
39810
39811      my $sftp = $ssh2->sftp();
39812      unless ($sftp) {
39813        my ($err_code, $err_name, $err_str) = $ssh2->error();
39814        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
39815      }
39816
39817      my $res = $sftp->setstat('test.txt',
39818        mode => 0666,
39819      );
39820      unless ($res) {
39821        my ($err_code, $err_name) = $sftp->error();
39822        die("Can't setstat sftp.conf: [$err_name] ($err_code)");
39823      }
39824
39825      my $attrs = $sftp->stat('test.txt');
39826      unless ($attrs) {
39827        my ($err_code, $err_name) = $sftp->error();
39828        die("FXP_STAT test.txt failed: [$err_name] ($err_code)");
39829      }
39830
39831      $sftp = undef;
39832      $ssh2->disconnect();
39833    };
39834
39835    if ($@) {
39836      $ex = $@;
39837    }
39838
39839    $wfh->print("done\n");
39840    $wfh->flush();
39841
39842  } else {
39843    eval { server_wait($config_file, $rfh) };
39844    if ($@) {
39845      warn($@);
39846      exit 1;
39847    }
39848
39849    exit 0;
39850  }
39851
39852  # Stop server
39853  server_stop($pid_file);
39854
39855  $self->assert_child_ok($pid);
39856
39857  if ($ex) {
39858    test_append_logfile($log_file, $ex);
39859    unlink($log_file);
39860
39861    die($ex);
39862  }
39863
39864  my $perms = ((stat($test_file))[2] & 07777);
39865
39866  my $expected = 0644;
39867  $self->assert($expected == $perms,
39868    test_msg("Expected '$expected', got '$perms'"));
39869
39870  unlink($log_file);
39871}
39872
39873sub sftp_config_ignore_set_times_bug3706 {
39874  my $self = shift;
39875  my $tmpdir = $self->{tmpdir};
39876
39877  my $config_file = "$tmpdir/sftp.conf";
39878  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
39879  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
39880
39881  my $log_file = test_get_logfile();
39882
39883  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
39884  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
39885
39886  my $user = 'proftpd';
39887  my $passwd = 'test';
39888  my $group = 'ftpd';
39889  my $home_dir = File::Spec->rel2abs($tmpdir);
39890  my $uid = 500;
39891  my $gid = 500;
39892
39893  # Make sure that, if we're running as root, that the home directory has
39894  # permissions/privs set for the account we create
39895  if ($< == 0) {
39896    unless (chmod(0755, $home_dir)) {
39897      die("Can't set perms on $home_dir to 0755: $!");
39898    }
39899
39900    unless (chown($uid, $gid, $home_dir)) {
39901      die("Can't set owner of $home_dir to $uid/$gid: $!");
39902    }
39903  }
39904
39905  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
39906    '/bin/bash');
39907  auth_group_write($auth_group_file, $group, $gid, $user);
39908
39909  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
39910  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
39911
39912  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
39913  if (open(my $fh, "> $test_file")) {
39914    print $fh "Hello, World!\n";
39915
39916    unless (close($fh)) {
39917      die("Can't write $test_file: $!");
39918    }
39919
39920  } else {
39921    die("Can't open $test_file: $!");
39922  }
39923
39924  my ($test_atime, $test_mtime) = (stat($test_file))[8, 9];
39925
39926  my $config = {
39927    PidFile => $pid_file,
39928    ScoreboardFile => $scoreboard_file,
39929    SystemLog => $log_file,
39930    TraceLog => $log_file,
39931    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
39932
39933    AuthUserFile => $auth_user_file,
39934    AuthGroupFile => $auth_group_file,
39935
39936    IfModules => {
39937      'mod_delay.c' => {
39938        DelayEngine => 'off',
39939      },
39940
39941      'mod_sftp.c' => [
39942        "SFTPEngine on",
39943        "SFTPLog $log_file",
39944        "SFTPHostKey $rsa_host_key",
39945        "SFTPHostKey $dsa_host_key",
39946
39947        "SFTPOptions IgnoreSFTPSetTimes",
39948      ],
39949    },
39950  };
39951
39952  my ($port, $config_user, $config_group) = config_write($config_file, $config);
39953
39954  # Open pipes, for use between the parent and child processes.  Specifically,
39955  # the child will indicate when it's done with its test by writing a message
39956  # to the parent.
39957  my ($rfh, $wfh);
39958  unless (pipe($rfh, $wfh)) {
39959    die("Can't open pipe: $!");
39960  }
39961
39962  require Net::SSH2;
39963
39964  my $ex;
39965
39966  # Ignore SIGPIPE
39967  local $SIG{PIPE} = sub { };
39968
39969  # Fork child
39970  $self->handle_sigchld();
39971  defined(my $pid = fork()) or die("Can't fork: $!");
39972  if ($pid) {
39973    eval {
39974      my $ssh2 = Net::SSH2->new();
39975
39976      sleep(1);
39977
39978      unless ($ssh2->connect('127.0.0.1', $port)) {
39979        my ($err_code, $err_name, $err_str) = $ssh2->error();
39980        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
39981      }
39982
39983      unless ($ssh2->auth_password($user, $passwd)) {
39984        my ($err_code, $err_name, $err_str) = $ssh2->error();
39985        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
39986      }
39987
39988      my $sftp = $ssh2->sftp();
39989      unless ($sftp) {
39990        my ($err_code, $err_name, $err_str) = $ssh2->error();
39991        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
39992      }
39993
39994      my $res = $sftp->setstat('test.txt',
39995        atime => 0,
39996        mtime => 0,
39997      );
39998      unless ($res) {
39999        my ($err_code, $err_name) = $sftp->error();
40000        die("Can't setstat test.txt: [$err_name] ($err_code)");
40001      }
40002
40003      my $attrs = $sftp->stat('test.txt');
40004      unless ($attrs) {
40005        my ($err_code, $err_name) = $sftp->error();
40006        die("FXP_STAT test.txt failed: [$err_name] ($err_code)");
40007      }
40008
40009      $sftp = undef;
40010      $ssh2->disconnect();
40011    };
40012
40013    if ($@) {
40014      $ex = $@;
40015    }
40016
40017    $wfh->print("done\n");
40018    $wfh->flush();
40019
40020  } else {
40021    eval { server_wait($config_file, $rfh) };
40022    if ($@) {
40023      warn($@);
40024      exit 1;
40025    }
40026
40027    exit 0;
40028  }
40029
40030  # Stop server
40031  server_stop($pid_file);
40032
40033  $self->assert_child_ok($pid);
40034
40035  if ($ex) {
40036    test_append_logfile($log_file, $ex);
40037    unlink($log_file);
40038
40039    die($ex);
40040  }
40041
40042  my ($new_atime, $new_mtime) = (stat($test_file))[8, 9];
40043
40044  my $expected = $test_atime;
40045  $self->assert($expected == $new_atime,
40046    test_msg("Expected atime $expected, got $new_atime"));
40047
40048  $expected = $test_mtime;
40049  $self->assert($expected == $new_mtime,
40050    test_msg("Expected mtime $expected, got $new_mtime"));
40051
40052  unlink($log_file);
40053}
40054
40055sub sftp_config_ignore_set_owners_bug3757 {
40056  my $self = shift;
40057  my $tmpdir = $self->{tmpdir};
40058
40059  my $config_file = "$tmpdir/sftp.conf";
40060  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
40061  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
40062
40063  my $log_file = test_get_logfile();
40064
40065  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
40066  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
40067
40068  my $user = 'proftpd';
40069  my $passwd = 'test';
40070  my $group = 'ftpd';
40071  my $home_dir = File::Spec->rel2abs($tmpdir);
40072  my $uid = 500;
40073  my $gid = 500;
40074
40075  # Make sure that, if we're running as root, that the home directory has
40076  # permissions/privs set for the account we create
40077  if ($< == 0) {
40078    unless (chmod(0755, $home_dir)) {
40079      die("Can't set perms on $home_dir to 0755: $!");
40080    }
40081
40082    unless (chown($uid, $gid, $home_dir)) {
40083      die("Can't set owner of $home_dir to $uid/$gid: $!");
40084    }
40085  }
40086
40087  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
40088    '/bin/bash');
40089  auth_group_write($auth_group_file, $group, $gid, $user);
40090
40091  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
40092  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
40093
40094  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
40095  if (open(my $fh, "> $test_file")) {
40096    print $fh "Hello, World!\n";
40097
40098    unless (close($fh)) {
40099      die("Can't write $test_file: $!");
40100    }
40101
40102  } else {
40103    die("Can't open $test_file: $!");
40104  }
40105
40106  my ($test_uid, $test_gid) = (stat($test_file))[4, 5];
40107
40108  my $config = {
40109    PidFile => $pid_file,
40110    ScoreboardFile => $scoreboard_file,
40111    SystemLog => $log_file,
40112    TraceLog => $log_file,
40113    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
40114
40115    AuthUserFile => $auth_user_file,
40116    AuthGroupFile => $auth_group_file,
40117
40118    IfModules => {
40119      'mod_delay.c' => {
40120        DelayEngine => 'off',
40121      },
40122
40123      'mod_sftp.c' => [
40124        "SFTPEngine on",
40125        "SFTPLog $log_file",
40126        "SFTPHostKey $rsa_host_key",
40127        "SFTPHostKey $dsa_host_key",
40128
40129        "SFTPOptions IgnoreSFTPSetOwners",
40130      ],
40131    },
40132  };
40133
40134  my ($port, $config_user, $config_group) = config_write($config_file, $config);
40135
40136  # Open pipes, for use between the parent and child processes.  Specifically,
40137  # the child will indicate when it's done with its test by writing a message
40138  # to the parent.
40139  my ($rfh, $wfh);
40140  unless (pipe($rfh, $wfh)) {
40141    die("Can't open pipe: $!");
40142  }
40143
40144  require Net::SSH2;
40145
40146  my $ex;
40147
40148  # Ignore SIGPIPE
40149  local $SIG{PIPE} = sub { };
40150
40151  # Fork child
40152  $self->handle_sigchld();
40153  defined(my $pid = fork()) or die("Can't fork: $!");
40154  if ($pid) {
40155    eval {
40156      my $ssh2 = Net::SSH2->new();
40157
40158      sleep(1);
40159
40160      unless ($ssh2->connect('127.0.0.1', $port)) {
40161        my ($err_code, $err_name, $err_str) = $ssh2->error();
40162        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
40163      }
40164
40165      unless ($ssh2->auth_password($user, $passwd)) {
40166        my ($err_code, $err_name, $err_str) = $ssh2->error();
40167        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
40168      }
40169
40170      my $sftp = $ssh2->sftp();
40171      unless ($sftp) {
40172        my ($err_code, $err_name, $err_str) = $ssh2->error();
40173        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
40174      }
40175
40176      my $res = $sftp->setstat('test.txt',
40177        uid => 0,
40178        gid => 0,
40179      );
40180      unless ($res) {
40181        my ($err_code, $err_name) = $sftp->error();
40182        die("Can't setstat test.txt: [$err_name] ($err_code)");
40183      }
40184
40185      my $attrs = $sftp->stat('test.txt');
40186      unless ($attrs) {
40187        my ($err_code, $err_name) = $sftp->error();
40188        die("FXP_STAT test.txt failed: [$err_name] ($err_code)");
40189      }
40190
40191      $sftp = undef;
40192      $ssh2->disconnect();
40193    };
40194
40195    if ($@) {
40196      $ex = $@;
40197    }
40198
40199    $wfh->print("done\n");
40200    $wfh->flush();
40201
40202  } else {
40203    eval { server_wait($config_file, $rfh) };
40204    if ($@) {
40205      warn($@);
40206      exit 1;
40207    }
40208
40209    exit 0;
40210  }
40211
40212  # Stop server
40213  server_stop($pid_file);
40214
40215  $self->assert_child_ok($pid);
40216
40217  if ($ex) {
40218    test_append_logfile($log_file, $ex);
40219    unlink($log_file);
40220
40221    die($ex);
40222  }
40223
40224  my ($new_uid, $new_gid) = (stat($test_file))[4, 5];
40225
40226  my $expected = $test_uid;
40227  $self->assert($expected == $new_uid,
40228    test_msg("Expected uid $expected, got $new_uid"));
40229
40230  $expected = $test_gid;
40231  $self->assert($expected == $new_gid,
40232    test_msg("Expected gid $expected, got $new_gid"));
40233
40234  unlink($log_file);
40235}
40236
40237sub sftp_config_userowner {
40238  my $self = shift;
40239  my $tmpdir = $self->{tmpdir};
40240
40241  my $config_file = "$tmpdir/sftp.conf";
40242  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
40243  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
40244
40245  my $log_file = test_get_logfile();
40246
40247  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
40248  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
40249
40250  my $user = 'proftpd';
40251  my $passwd = 'test';
40252  my $group = 'ftpd';
40253  my $home_dir = File::Spec->rel2abs($tmpdir);
40254  my $uid = 500;
40255  my $gid = 500;
40256
40257  # Make sure that, if we're running as root, that the home directory has
40258  # permissions/privs set for the account we create
40259  if ($< == 0) {
40260    unless (chmod(0755, $home_dir)) {
40261      die("Can't set perms on $home_dir to 0755: $!");
40262    }
40263
40264    unless (chown($uid, $gid, $home_dir)) {
40265      die("Can't set owner of $home_dir to $uid/$gid: $!");
40266    }
40267  }
40268
40269  my $owner = 'proftpd2';
40270  my $owner_uid = 7777;
40271
40272  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
40273    '/bin/bash');
40274  auth_user_write($auth_user_file, $owner, 'none', $owner_uid, $gid, $home_dir,
40275    '/bin/bash');
40276  auth_group_write($auth_group_file, $group, $gid, $user);
40277
40278  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
40279  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
40280
40281  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
40282
40283  my $config = {
40284    PidFile => $pid_file,
40285    ScoreboardFile => $scoreboard_file,
40286    SystemLog => $log_file,
40287    TraceLog => $log_file,
40288    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
40289
40290    AuthUserFile => $auth_user_file,
40291    AuthGroupFile => $auth_group_file,
40292    RootRevoke => 'off',
40293
40294    Directory => {
40295      '~' => {
40296        UserOwner => $owner,
40297      },
40298    },
40299
40300    IfModules => {
40301      'mod_delay.c' => {
40302        DelayEngine => 'off',
40303      },
40304
40305      'mod_sftp.c' => [
40306        "SFTPEngine on",
40307        "SFTPLog $log_file",
40308        "SFTPHostKey $rsa_host_key",
40309        "SFTPHostKey $dsa_host_key",
40310      ],
40311    },
40312  };
40313
40314  my ($port, $config_user, $config_group) = config_write($config_file, $config);
40315
40316  # Open pipes, for use between the parent and child processes.  Specifically,
40317  # the child will indicate when it's done with its test by writing a message
40318  # to the parent.
40319  my ($rfh, $wfh);
40320  unless (pipe($rfh, $wfh)) {
40321    die("Can't open pipe: $!");
40322  }
40323
40324  require Net::SSH2;
40325
40326  my $ex;
40327
40328  # Ignore SIGPIPE
40329  local $SIG{PIPE} = sub { };
40330
40331  # Fork child
40332  $self->handle_sigchld();
40333  defined(my $pid = fork()) or die("Can't fork: $!");
40334  if ($pid) {
40335    eval {
40336      my $ssh2 = Net::SSH2->new();
40337
40338      sleep(1);
40339
40340      unless ($ssh2->connect('127.0.0.1', $port)) {
40341        my ($err_code, $err_name, $err_str) = $ssh2->error();
40342        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
40343      }
40344
40345      unless ($ssh2->auth_password($user, $passwd)) {
40346        my ($err_code, $err_name, $err_str) = $ssh2->error();
40347        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
40348      }
40349
40350      my $sftp = $ssh2->sftp();
40351      unless ($sftp) {
40352        my ($err_code, $err_name, $err_str) = $ssh2->error();
40353        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
40354      }
40355
40356      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
40357      unless ($fh) {
40358        my ($err_code, $err_name) = $sftp->error();
40359        die("Can't open test.txt: [$err_name] ($err_code)");
40360      }
40361
40362      my $count = 20;
40363      for (my $i = 0; $i < $count; $i++) {
40364        print $fh "ABCD" x 8192;
40365      }
40366
40367      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
40368      $fh = undef;
40369
40370      # To close the SFTP channel, we have to explicitly destroy the object
40371      $sftp = undef;
40372
40373      $ssh2->disconnect();
40374
40375      unless (-f $test_file) {
40376        die("File $test_file does not exist as expected");
40377      }
40378
40379      my $owning_uid = (stat($test_file))[4];
40380      $self->assert($owner_uid == $owning_uid,
40381        test_msg("Expected $owner_uid, got $owning_uid"));
40382    };
40383
40384    if ($@) {
40385      $ex = $@;
40386    }
40387
40388    $wfh->print("done\n");
40389    $wfh->flush();
40390
40391  } else {
40392    eval { server_wait($config_file, $rfh) };
40393    if ($@) {
40394      warn($@);
40395      exit 1;
40396    }
40397
40398    exit 0;
40399  }
40400
40401  # Stop server
40402  server_stop($pid_file);
40403
40404  $self->assert_child_ok($pid);
40405
40406  if ($ex) {
40407    test_append_logfile($log_file, $ex);
40408    unlink($log_file);
40409
40410    die($ex);
40411  }
40412
40413  unlink($log_file);
40414}
40415
40416sub sftp_config_groupowner_file_nonmember {
40417  my $self = shift;
40418  my $tmpdir = $self->{tmpdir};
40419
40420  my $config_file = "$tmpdir/sftp.conf";
40421  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
40422  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
40423
40424  my $log_file = test_get_logfile();
40425
40426  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
40427  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
40428
40429  my $user = 'proftpd';
40430  my $passwd = 'test';
40431  my $group = 'ftpd';
40432  my $home_dir = File::Spec->rel2abs($tmpdir);
40433  my $uid = 500;
40434  my $gid = 500;
40435
40436  # Make sure that, if we're running as root, that the home directory has
40437  # permissions/privs set for the account we create
40438  if ($< == 0) {
40439    unless (chmod(0755, $home_dir)) {
40440      die("Can't set perms on $home_dir to 0755: $!");
40441    }
40442
40443    unless (chown($uid, $gid, $home_dir)) {
40444      die("Can't set owner of $home_dir to $uid/$gid: $!");
40445    }
40446  }
40447
40448  my $owner = 'proftpd2';
40449  my $owner_gid = 7777;
40450
40451  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
40452    '/bin/bash');
40453  auth_group_write($auth_group_file, $group, $gid, $user);
40454  auth_group_write($auth_group_file, $owner, $owner_gid, 'foo');
40455
40456  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
40457  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
40458
40459  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
40460
40461  my $config = {
40462    PidFile => $pid_file,
40463    ScoreboardFile => $scoreboard_file,
40464    SystemLog => $log_file,
40465    TraceLog => $log_file,
40466    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
40467
40468    AuthUserFile => $auth_user_file,
40469    AuthGroupFile => $auth_group_file,
40470#    RootRevoke => 'off',
40471
40472    Directory => {
40473      '~' => {
40474        GroupOwner => $owner,
40475      },
40476    },
40477
40478    IfModules => {
40479      'mod_delay.c' => {
40480        DelayEngine => 'off',
40481      },
40482
40483      'mod_sftp.c' => [
40484        "SFTPEngine on",
40485        "SFTPLog $log_file",
40486        "SFTPHostKey $rsa_host_key",
40487        "SFTPHostKey $dsa_host_key",
40488      ],
40489    },
40490  };
40491
40492  my ($port, $config_user, $config_group) = config_write($config_file, $config);
40493
40494  # Open pipes, for use between the parent and child processes.  Specifically,
40495  # the child will indicate when it's done with its test by writing a message
40496  # to the parent.
40497  my ($rfh, $wfh);
40498  unless (pipe($rfh, $wfh)) {
40499    die("Can't open pipe: $!");
40500  }
40501
40502  require Net::SSH2;
40503
40504  my $ex;
40505
40506  # Ignore SIGPIPE
40507  local $SIG{PIPE} = sub { };
40508
40509  # Fork child
40510  $self->handle_sigchld();
40511  defined(my $pid = fork()) or die("Can't fork: $!");
40512  if ($pid) {
40513    eval {
40514      my $ssh2 = Net::SSH2->new();
40515
40516      sleep(1);
40517
40518      unless ($ssh2->connect('127.0.0.1', $port)) {
40519        my ($err_code, $err_name, $err_str) = $ssh2->error();
40520        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
40521      }
40522
40523      unless ($ssh2->auth_password($user, $passwd)) {
40524        my ($err_code, $err_name, $err_str) = $ssh2->error();
40525        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
40526      }
40527
40528      my $sftp = $ssh2->sftp();
40529      unless ($sftp) {
40530        my ($err_code, $err_name, $err_str) = $ssh2->error();
40531        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
40532      }
40533
40534      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
40535      unless ($fh) {
40536        my ($err_code, $err_name) = $sftp->error();
40537        die("Can't open test.txt: [$err_name] ($err_code)");
40538      }
40539
40540      my $count = 20;
40541      for (my $i = 0; $i < $count; $i++) {
40542        print $fh "ABCD" x 8192;
40543      }
40544
40545      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
40546      $fh = undef;
40547
40548      # To close the SFTP channel, we have to explicitly destroy the object
40549      $sftp = undef;
40550
40551      $ssh2->disconnect();
40552
40553      unless (-f $test_file) {
40554        die("File $test_file does not exist as expected");
40555      }
40556
40557      my $owning_gid = (stat($test_file))[5];
40558      $self->assert($owner_gid == $owning_gid,
40559        test_msg("Expected $owner_gid, got $owning_gid"));
40560    };
40561
40562    if ($@) {
40563      $ex = $@;
40564    }
40565
40566    $wfh->print("done\n");
40567    $wfh->flush();
40568
40569  } else {
40570    eval { server_wait($config_file, $rfh) };
40571    if ($@) {
40572      warn($@);
40573      exit 1;
40574    }
40575
40576    exit 0;
40577  }
40578
40579  # Stop server
40580  server_stop($pid_file);
40581
40582  $self->assert_child_ok($pid);
40583
40584  if ($ex) {
40585    test_append_logfile($log_file, $ex);
40586    unlink($log_file);
40587
40588    die($ex);
40589  }
40590
40591  unlink($log_file);
40592}
40593
40594sub sftp_config_groupowner_file_member_norootprivs {
40595  my $self = shift;
40596  my $tmpdir = $self->{tmpdir};
40597
40598  my ($config_user, $config_group) = config_get_identity();
40599
40600  my $members = [split(' ', (getgrnam($config_group))[3])];
40601  if (scalar(@$members) < 2) {
40602    print STDERR " + unable to run 'sftp_config_groupowner_member_norootprivs' test without current user belonging to multiple groups, skipping\n";
40603    return;
40604  }
40605
40606  my ($uid, $gid) = (getpwnam($members->[0]))[2,3];
40607
40608  my $root_login = 'off';
40609  if ($uid == 0) {
40610    $root_login = 'on';
40611  }
40612
40613  my $owner = 'proftpd2';
40614  my $owner_gid = (getpwnam($members->[1]))[3];
40615
40616  my $config_file = "$tmpdir/sftp.conf";
40617  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
40618  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
40619
40620  my $log_file = test_get_logfile();
40621
40622  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
40623  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
40624
40625  my $user = 'proftpd';
40626  my $passwd = 'test';
40627  my $group = 'ftpd';
40628  my $home_dir = File::Spec->rel2abs($tmpdir);
40629
40630  # Make sure that, if we're running as root, that the home directory has
40631  # permissions/privs set for the account we create
40632  if ($< == 0) {
40633    unless (chmod(0755, $home_dir)) {
40634      die("Can't set perms on $home_dir to 0755: $!");
40635    }
40636
40637    unless (chown($uid, $gid, $home_dir)) {
40638      die("Can't set owner of $home_dir to $uid/$gid: $!");
40639    }
40640  }
40641
40642  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
40643    '/bin/bash');
40644  auth_group_write($auth_group_file, $group, $gid, $user);
40645  auth_group_write($auth_group_file, $owner, $owner_gid, $user);
40646
40647  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
40648  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
40649
40650  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
40651
40652  my $config = {
40653    PidFile => $pid_file,
40654    ScoreboardFile => $scoreboard_file,
40655    SystemLog => $log_file,
40656    TraceLog => $log_file,
40657    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
40658
40659    AuthUserFile => $auth_user_file,
40660    AuthGroupFile => $auth_group_file,
40661    RootLogin => $root_login,
40662
40663    Directory => {
40664      '~' => {
40665        GroupOwner => $owner,
40666      },
40667    },
40668
40669    IfModules => {
40670      'mod_delay.c' => {
40671        DelayEngine => 'off',
40672      },
40673
40674      'mod_sftp.c' => [
40675        "SFTPEngine on",
40676        "SFTPLog $log_file",
40677        "SFTPHostKey $rsa_host_key",
40678        "SFTPHostKey $dsa_host_key",
40679      ],
40680    },
40681  };
40682
40683  my $port;
40684  ($port, $config_user, $config_group) = config_write($config_file, $config);
40685
40686  # Open pipes, for use between the parent and child processes.  Specifically,
40687  # the child will indicate when it's done with its test by writing a message
40688  # to the parent.
40689  my ($rfh, $wfh);
40690  unless (pipe($rfh, $wfh)) {
40691    die("Can't open pipe: $!");
40692  }
40693
40694  require Net::SSH2;
40695
40696  my $ex;
40697
40698  # Ignore SIGPIPE
40699  local $SIG{PIPE} = sub { };
40700
40701  # Fork child
40702  $self->handle_sigchld();
40703  defined(my $pid = fork()) or die("Can't fork: $!");
40704  if ($pid) {
40705    eval {
40706      my $ssh2 = Net::SSH2->new();
40707
40708      sleep(1);
40709
40710      unless ($ssh2->connect('127.0.0.1', $port)) {
40711        my ($err_code, $err_name, $err_str) = $ssh2->error();
40712        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
40713      }
40714
40715      unless ($ssh2->auth_password($user, $passwd)) {
40716        my ($err_code, $err_name, $err_str) = $ssh2->error();
40717        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
40718      }
40719
40720      my $sftp = $ssh2->sftp();
40721      unless ($sftp) {
40722        my ($err_code, $err_name, $err_str) = $ssh2->error();
40723        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
40724      }
40725
40726      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
40727      unless ($fh) {
40728        my ($err_code, $err_name) = $sftp->error();
40729        die("Can't open test.txt: [$err_name] ($err_code)");
40730      }
40731
40732      my $count = 20;
40733      for (my $i = 0; $i < $count; $i++) {
40734        print $fh "ABCD" x 8192;
40735      }
40736
40737      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
40738      $fh = undef;
40739
40740      # To close the SFTP channel, we have to explicitly destroy the object
40741      $sftp = undef;
40742
40743      $ssh2->disconnect();
40744
40745      unless (-f $test_file) {
40746        die("File $test_file does not exist as expected");
40747      }
40748
40749      my $owning_gid = (stat($test_file))[5];
40750      $self->assert($owner_gid == $owning_gid,
40751        test_msg("Expected $owner_gid, got $owning_gid"));
40752    };
40753
40754    if ($@) {
40755      $ex = $@;
40756    }
40757
40758    $wfh->print("done\n");
40759    $wfh->flush();
40760
40761  } else {
40762    eval { server_wait($config_file, $rfh) };
40763    if ($@) {
40764      warn($@);
40765      exit 1;
40766    }
40767
40768    exit 0;
40769  }
40770
40771  # Stop server
40772  server_stop($pid_file);
40773
40774  $self->assert_child_ok($pid);
40775
40776  if ($ex) {
40777    test_append_logfile($log_file, $ex);
40778    unlink($log_file);
40779
40780    die($ex);
40781  }
40782
40783  unlink($log_file);
40784}
40785
40786sub sftp_config_groupowner_dir_member_norootprivs_bug3765 {
40787  my $self = shift;
40788  my $tmpdir = $self->{tmpdir};
40789
40790  my ($config_user, $config_group) = config_get_identity();
40791
40792  my $members = [split(' ', (getgrnam($config_group))[3])];
40793  if (scalar(@$members) < 2) {
40794    print STDERR " + unable to run 'sftp_config_groupowner_member_norootprivs' test without current user belonging to multiple groups, skipping\n";
40795    return;
40796  }
40797
40798  my ($uid, $gid) = (getpwnam($members->[0]))[2,3];
40799
40800  my $root_login = 'off';
40801  if ($uid == 0) {
40802    $root_login = 'on';
40803  }
40804
40805  my $owner = 'proftpd2';
40806  my $owner_gid = (getpwnam($members->[1]))[3];
40807
40808  my $config_file = "$tmpdir/sftp.conf";
40809  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
40810  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
40811
40812  my $log_file = test_get_logfile();
40813
40814  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
40815  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
40816
40817  my $user = 'proftpd';
40818  my $passwd = 'test';
40819  my $group = 'ftpd';
40820  my $home_dir = File::Spec->rel2abs($tmpdir);
40821
40822  # Make sure that, if we're running as root, that the home directory has
40823  # permissions/privs set for the account we create
40824  if ($< == 0) {
40825    unless (chmod(0755, $home_dir)) {
40826      die("Can't set perms on $home_dir to 0755: $!");
40827    }
40828
40829    unless (chown($uid, $gid, $home_dir)) {
40830      die("Can't set owner of $home_dir to $uid/$gid: $!");
40831    }
40832  }
40833
40834  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
40835    '/bin/bash');
40836  auth_group_write($auth_group_file, $group, $gid, $user);
40837  auth_group_write($auth_group_file, $owner, $owner_gid, $user);
40838
40839  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
40840  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
40841
40842  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
40843
40844  my $config = {
40845    PidFile => $pid_file,
40846    ScoreboardFile => $scoreboard_file,
40847    SystemLog => $log_file,
40848    TraceLog => $log_file,
40849    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
40850
40851    AuthUserFile => $auth_user_file,
40852    AuthGroupFile => $auth_group_file,
40853    DefaultChdir => '~',
40854
40855    Directory => {
40856      '~' => {
40857        GroupOwner => $owner,
40858      },
40859    },
40860
40861    IfModules => {
40862      'mod_delay.c' => {
40863        DelayEngine => 'off',
40864      },
40865
40866      'mod_sftp.c' => [
40867        "SFTPEngine on",
40868        "SFTPLog $log_file",
40869        "SFTPHostKey $rsa_host_key",
40870        "SFTPHostKey $dsa_host_key",
40871      ],
40872    },
40873  };
40874
40875  my $port;
40876  ($port, $config_user, $config_group) = config_write($config_file, $config);
40877
40878  # Open pipes, for use between the parent and child processes.  Specifically,
40879  # the child will indicate when it's done with its test by writing a message
40880  # to the parent.
40881  my ($rfh, $wfh);
40882  unless (pipe($rfh, $wfh)) {
40883    die("Can't open pipe: $!");
40884  }
40885
40886  require Net::SSH2;
40887
40888  my $ex;
40889
40890  # Ignore SIGPIPE
40891  local $SIG{PIPE} = sub { };
40892
40893  # Fork child
40894  $self->handle_sigchld();
40895  defined(my $pid = fork()) or die("Can't fork: $!");
40896  if ($pid) {
40897    eval {
40898      my $ssh2 = Net::SSH2->new();
40899
40900      sleep(1);
40901
40902      unless ($ssh2->connect('127.0.0.1', $port)) {
40903        my ($err_code, $err_name, $err_str) = $ssh2->error();
40904        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
40905      }
40906
40907      unless ($ssh2->auth_password($user, $passwd)) {
40908        my ($err_code, $err_name, $err_str) = $ssh2->error();
40909        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
40910      }
40911
40912      my $sftp = $ssh2->sftp();
40913      unless ($sftp) {
40914        my ($err_code, $err_name, $err_str) = $ssh2->error();
40915        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
40916      }
40917
40918      my $res = $sftp->mkdir('testdir');
40919      unless ($res) {
40920        my ($err_code, $err_name) = $sftp->error();
40921        die("Can't mkdir testdir: [$err_name] ($err_code)");
40922      }
40923
40924      # To close the SFTP channel, we have to explicitly destroy the object
40925      $sftp = undef;
40926
40927      $ssh2->disconnect();
40928
40929      unless (-d $test_dir) {
40930        die("Directory $test_dir does not exist as expected");
40931      }
40932
40933      my $owning_gid = (stat($test_dir))[5];
40934      $self->assert($owner_gid == $owning_gid,
40935        test_msg("Expected owner GID $owner_gid, got $owning_gid"));
40936    };
40937
40938    if ($@) {
40939      $ex = $@;
40940    }
40941
40942    $wfh->print("done\n");
40943    $wfh->flush();
40944
40945  } else {
40946    eval { server_wait($config_file, $rfh) };
40947    if ($@) {
40948      warn($@);
40949      exit 1;
40950    }
40951
40952    exit 0;
40953  }
40954
40955  # Stop server
40956  server_stop($pid_file);
40957
40958  $self->assert_child_ok($pid);
40959
40960  if ($ex) {
40961    test_append_logfile($log_file, $ex);
40962    unlink($log_file);
40963
40964    die($ex);
40965  }
40966
40967  unlink($log_file);
40968}
40969
40970sub sftp_config_ftpaccess_bug3460 {
40971  my $self = shift;
40972  my $tmpdir = $self->{tmpdir};
40973
40974  my $config_file = "$tmpdir/sftp.conf";
40975  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
40976  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
40977
40978  my $log_file = test_get_logfile();
40979
40980  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
40981  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
40982
40983  my $user = 'proftpd';
40984  my $passwd = 'test';
40985  my $group = 'ftpd';
40986  my $home_dir = File::Spec->rel2abs($tmpdir);
40987  my $uid = 500;
40988  my $gid = 500;
40989
40990  my $data_dir = File::Spec->rel2abs("$home_dir/data");
40991  mkpath($data_dir);
40992
40993  my $ftpaccess_file = File::Spec->rel2abs("$data_dir/.ftpaccess");
40994  if (open(my $fh, "> $ftpaccess_file")) {
40995    print $fh <<EOF;
40996<Limit READ WRITE>
40997  IgnoreHidden on
40998  DenyAll
40999</Limit>
41000EOF
41001    unless (close($fh)) {
41002      die("Can't write $ftpaccess_file: $!");
41003    }
41004
41005  } else {
41006    die("Can't open $ftpaccess_file: $!");
41007  }
41008
41009  my $neither_dir = File::Spec->rel2abs("$data_dir/neither");
41010  mkpath($neither_dir);
41011
41012  my $readable_dir = File::Spec->rel2abs("$data_dir/readable");
41013  mkpath($readable_dir);
41014
41015  $ftpaccess_file = File::Spec->rel2abs("$readable_dir/.ftpaccess");
41016  if (open(my $fh, "> $ftpaccess_file")) {
41017    print $fh <<EOF;
41018<Limit READ>
41019  AllowUser $user
41020  AllowUser foo
41021  DenyAll
41022</Limit>
41023EOF
41024    unless (close($fh)) {
41025      die("Can't write $ftpaccess_file: $!");
41026    }
41027
41028  } else {
41029    die("Can't open $ftpaccess_file: $!");
41030  }
41031
41032  my $writable_dir = File::Spec->rel2abs("$data_dir/writable");
41033  mkpath($writable_dir);
41034
41035  $ftpaccess_file = File::Spec->rel2abs("$writable_dir/.ftpaccess");
41036  if (open(my $fh, "> $ftpaccess_file")) {
41037    print $fh <<EOF;
41038<Limit WRITE READ>
41039  AllowUser $user
41040  AllowUser foo
41041  DenyAll
41042</Limit>
41043EOF
41044    unless (close($fh)) {
41045      die("Can't write $ftpaccess_file: $!");
41046    }
41047
41048  } else {
41049    die("Can't open $ftpaccess_file: $!");
41050  }
41051
41052  my $sub_writable_dir = File::Spec->rel2abs("$writable_dir/subwritable");
41053  mkpath($sub_writable_dir);
41054
41055  # Make sure that, if we're running as root, that the home directory has
41056  # permissions/privs set for the account we create
41057  if ($< == 0) {
41058    unless (chmod(0755, $home_dir, $data_dir, $neither_dir, $readable_dir,
41059        $writable_dir, $sub_writable_dir)) {
41060      die("Can't set perms on $home_dir to 0755: $!");
41061    }
41062
41063    unless (chown($uid, $gid, $home_dir, $data_dir, $neither_dir,
41064        $readable_dir, $writable_dir, $sub_writable_dir)) {
41065      die("Can't set owner of $home_dir to $uid/$gid: $!");
41066    }
41067  }
41068
41069  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $data_dir,
41070    '/bin/bash');
41071  auth_group_write($auth_group_file, $group, $gid, $user);
41072
41073  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
41074  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
41075
41076  my $test_file = File::Spec->rel2abs("$sub_writable_dir/test.txt");
41077  if (open(my $fh, "> $test_file")) {
41078    print $fh "ABCD\n";
41079    unless (close($fh)) {
41080      die("Can't write $test_file: $!");
41081    }
41082
41083  } else {
41084    die("Can't open $test_file: $!");
41085  }
41086
41087  my $config = {
41088    PidFile => $pid_file,
41089    ScoreboardFile => $scoreboard_file,
41090    SystemLog => $log_file,
41091    TraceLog => $log_file,
41092    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20 directory:20 ftpaccess:20',
41093
41094    AuthUserFile => $auth_user_file,
41095    AuthGroupFile => $auth_group_file,
41096
41097    AllowOverride => 'on',
41098    PathDenyFilter => '"\\\\.ftpaccess$"',
41099
41100    Directory => {
41101      '/*' => {
41102        AllowOverwrite => 'on',
41103        HideUser => 'nobody',
41104      },
41105    },
41106
41107    IfModules => {
41108      'mod_delay.c' => {
41109        DelayEngine => 'off',
41110      },
41111
41112      'mod_sftp.c' => [
41113        "SFTPEngine on",
41114        "SFTPLog $log_file",
41115        "SFTPHostKey $rsa_host_key",
41116        "SFTPHostKey $dsa_host_key",
41117      ],
41118    },
41119
41120    Limit => {
41121      'LOCK SYMLINK' => {
41122        DenyAll => '',
41123      },
41124    },
41125  };
41126
41127  my ($port, $config_user, $config_group) = config_write($config_file, $config);
41128
41129  # Open pipes, for use between the parent and child processes.  Specifically,
41130  # the child will indicate when it's done with its test by writing a message
41131  # to the parent.
41132  my ($rfh, $wfh);
41133  unless (pipe($rfh, $wfh)) {
41134    die("Can't open pipe: $!");
41135  }
41136
41137  require Net::SSH2;
41138
41139  my $ex;
41140
41141  # Ignore SIGPIPE
41142  local $SIG{PIPE} = sub { };
41143
41144  # Fork child
41145  $self->handle_sigchld();
41146  defined(my $pid = fork()) or die("Can't fork: $!");
41147  if ($pid) {
41148    eval {
41149      my $ssh2 = Net::SSH2->new();
41150
41151      sleep(1);
41152
41153      unless ($ssh2->connect('127.0.0.1', $port)) {
41154        my ($err_code, $err_name, $err_str) = $ssh2->error();
41155        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
41156      }
41157
41158      unless ($ssh2->auth_password($user, $passwd)) {
41159        my ($err_code, $err_name, $err_str) = $ssh2->error();
41160        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
41161      }
41162
41163      my $sftp = $ssh2->sftp();
41164      unless ($sftp) {
41165        my ($err_code, $err_name, $err_str) = $ssh2->error();
41166        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
41167      }
41168
41169      my $base_path = $sftp->realpath('.');
41170      unless ($base_path) {
41171        my ($err_code, $err_name) = $sftp->error();
41172        die("FXP_REALPATH '.' failed: [$err_name] ($err_code)");
41173      }
41174
41175      my $path = $sftp->realpath("$base_path/writable/subwritable");
41176      unless ($path) {
41177        my ($err_code, $err_name) = $sftp->error();
41178        die("FXP_REALPATH '$base_path/writable/subwritable' failed: [$err_name] ($err_code)");
41179      }
41180
41181      my $dirh = $sftp->opendir($path);
41182      unless ($dirh) {
41183        my ($err_code, $err_name) = $sftp->error();
41184        die("FXP_OPENDIR '$path' failed: [$err_name] ($err_code)");
41185      }
41186
41187      $dirh = undef;
41188
41189      my $file_path = $sftp->realpath("$path/test.txt");
41190      unless ($file_path) {
41191        my ($err_code, $err_name) = $sftp->error();
41192        die("FXP_REALPATH '$path/test.txt' failed: [$err_name] ($err_code)");
41193      }
41194
41195      my $fh = $sftp->open($file_path, O_RDONLY);
41196      unless ($fh) {
41197        my ($err_code, $err_name) = $sftp->error();
41198        die("FXP_OPEN '$file_path' failed: [$err_name] ($err_code)");
41199      }
41200
41201      $fh = undef;
41202      $sftp = undef;
41203      $ssh2->disconnect();
41204    };
41205
41206    if ($@) {
41207      $ex = $@;
41208    }
41209
41210    $wfh->print("done\n");
41211    $wfh->flush();
41212
41213  } else {
41214    eval { server_wait($config_file, $rfh) };
41215    if ($@) {
41216      warn($@);
41217      exit 1;
41218    }
41219
41220    exit 0;
41221  }
41222
41223  # Stop server
41224  server_stop($pid_file);
41225
41226  $self->assert_child_ok($pid);
41227
41228  if ($ex) {
41229    test_append_logfile($log_file, $ex);
41230    unlink($log_file);
41231
41232    die($ex);
41233  }
41234
41235  unlink($log_file);
41236}
41237
41238sub sftp_config_limit_appe {
41239  my $self = shift;
41240  my $tmpdir = $self->{tmpdir};
41241
41242  my $config_file = "$tmpdir/sftp.conf";
41243  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
41244  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
41245
41246  my $log_file = test_get_logfile();
41247
41248  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
41249  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
41250
41251  my $user = 'proftpd';
41252  my $passwd = 'test';
41253  my $group = 'ftpd';
41254  my $home_dir = File::Spec->rel2abs($tmpdir);
41255  my $uid = 500;
41256  my $gid = 500;
41257
41258  # Make sure that, if we're running as root, that the home directory has
41259  # permissions/privs set for the account we create
41260  if ($< == 0) {
41261    unless (chmod(0755, $home_dir)) {
41262      die("Can't set perms on $home_dir to 0755: $!");
41263    }
41264
41265    unless (chown($uid, $gid, $home_dir)) {
41266      die("Can't set owner of $home_dir to $uid/$gid: $!");
41267    }
41268  }
41269
41270  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
41271    '/bin/bash');
41272  auth_group_write($auth_group_file, $group, $gid, $user);
41273
41274  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
41275  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
41276
41277  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
41278  if (open(my $fh, "> $test_file")) {
41279    print $fh "ABCD\n";
41280    unless (close($fh)) {
41281      die("Can't write $test_file: $!");
41282    }
41283
41284  } else {
41285    die("Can't open $test_file: $!");
41286  }
41287
41288  my $config = {
41289    PidFile => $pid_file,
41290    ScoreboardFile => $scoreboard_file,
41291    SystemLog => $log_file,
41292    TraceLog => $log_file,
41293    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
41294
41295    AuthUserFile => $auth_user_file,
41296    AuthGroupFile => $auth_group_file,
41297
41298    Directory => {
41299      '~' => {
41300        AllowOverwrite => 'on',
41301        AllowStoreRestart => 'on',
41302      },
41303    },
41304
41305    IfModules => {
41306      'mod_delay.c' => {
41307        DelayEngine => 'off',
41308      },
41309
41310      'mod_sftp.c' => [
41311        "SFTPEngine on",
41312        "SFTPLog $log_file",
41313        "SFTPHostKey $rsa_host_key",
41314        "SFTPHostKey $dsa_host_key",
41315      ],
41316    },
41317
41318    Limit => {
41319      APPE => {
41320        DenyAll => '',
41321      },
41322    },
41323  };
41324
41325  my ($port, $config_user, $config_group) = config_write($config_file, $config);
41326
41327  # Open pipes, for use between the parent and child processes.  Specifically,
41328  # the child will indicate when it's done with its test by writing a message
41329  # to the parent.
41330  my ($rfh, $wfh);
41331  unless (pipe($rfh, $wfh)) {
41332    die("Can't open pipe: $!");
41333  }
41334
41335  require Net::SSH2;
41336
41337  my $ex;
41338
41339  # Ignore SIGPIPE
41340  local $SIG{PIPE} = sub { };
41341
41342  # Fork child
41343  $self->handle_sigchld();
41344  defined(my $pid = fork()) or die("Can't fork: $!");
41345  if ($pid) {
41346    eval {
41347      my $ssh2 = Net::SSH2->new();
41348
41349      sleep(1);
41350
41351      unless ($ssh2->connect('127.0.0.1', $port)) {
41352        my ($err_code, $err_name, $err_str) = $ssh2->error();
41353        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
41354      }
41355
41356      unless ($ssh2->auth_password($user, $passwd)) {
41357        my ($err_code, $err_name, $err_str) = $ssh2->error();
41358        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
41359      }
41360
41361      my $sftp = $ssh2->sftp();
41362      unless ($sftp) {
41363        my ($err_code, $err_name, $err_str) = $ssh2->error();
41364        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
41365      }
41366
41367      my $fh = $sftp->open('test.txt', O_WRONLY|O_APPEND);
41368      if ($fh) {
41369        $fh = undef;
41370        die("OPEN test.txt succeeded unexpectedly");
41371      }
41372
41373      my ($err_code, $err_name) = $sftp->error();
41374      $sftp = undef;
41375      $ssh2->disconnect();
41376
41377      my $expected = 'SSH_FX_PERMISSION_DENIED';
41378      $self->assert($expected eq $err_name,
41379        test_msg("Expected '$expected', got '$err_name'"));
41380    };
41381
41382    if ($@) {
41383      $ex = $@;
41384    }
41385
41386    $wfh->print("done\n");
41387    $wfh->flush();
41388
41389  } else {
41390    eval { server_wait($config_file, $rfh) };
41391    if ($@) {
41392      warn($@);
41393      exit 1;
41394    }
41395
41396    exit 0;
41397  }
41398
41399  # Stop server
41400  server_stop($pid_file);
41401
41402  $self->assert_child_ok($pid);
41403
41404  if ($ex) {
41405    test_append_logfile($log_file, $ex);
41406    unlink($log_file);
41407
41408    die($ex);
41409  }
41410
41411  unlink($log_file);
41412}
41413
41414sub sftp_config_limit_chmod {
41415  my $self = shift;
41416  my $tmpdir = $self->{tmpdir};
41417
41418  my $config_file = "$tmpdir/sftp.conf";
41419  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
41420  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
41421
41422  my $log_file = test_get_logfile();
41423
41424  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
41425  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
41426
41427  my $user = 'proftpd';
41428  my $passwd = 'test';
41429  my $group = 'ftpd';
41430  my $home_dir = File::Spec->rel2abs($tmpdir);
41431  my $uid = 500;
41432  my $gid = 500;
41433
41434  # Make sure that, if we're running as root, that the home directory has
41435  # permissions/privs set for the account we create
41436  if ($< == 0) {
41437    unless (chmod(0755, $home_dir)) {
41438      die("Can't set perms on $home_dir to 0755: $!");
41439    }
41440
41441    unless (chown($uid, $gid, $home_dir)) {
41442      die("Can't set owner of $home_dir to $uid/$gid: $!");
41443    }
41444  }
41445
41446  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
41447    '/bin/bash');
41448  auth_group_write($auth_group_file, $group, $gid, $user);
41449
41450  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
41451  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
41452
41453  my $config = {
41454    PidFile => $pid_file,
41455    ScoreboardFile => $scoreboard_file,
41456    SystemLog => $log_file,
41457    TraceLog => $log_file,
41458    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
41459
41460    AuthUserFile => $auth_user_file,
41461    AuthGroupFile => $auth_group_file,
41462
41463    IfModules => {
41464      'mod_delay.c' => {
41465        DelayEngine => 'off',
41466      },
41467
41468      'mod_sftp.c' => [
41469        "SFTPEngine on",
41470        "SFTPLog $log_file",
41471        "SFTPHostKey $rsa_host_key",
41472        "SFTPHostKey $dsa_host_key",
41473      ],
41474    },
41475
41476    Limit => {
41477      'SITE_CHMOD' => {
41478        DenyAll => '',
41479      },
41480    },
41481  };
41482
41483  my ($port, $config_user, $config_group) = config_write($config_file, $config);
41484
41485  # Open pipes, for use between the parent and child processes.  Specifically,
41486  # the child will indicate when it's done with its test by writing a message
41487  # to the parent.
41488  my ($rfh, $wfh);
41489  unless (pipe($rfh, $wfh)) {
41490    die("Can't open pipe: $!");
41491  }
41492
41493  require Net::SSH2;
41494
41495  my $ex;
41496
41497  # Fork child
41498  $self->handle_sigchld();
41499  defined(my $pid = fork()) or die("Can't fork: $!");
41500  if ($pid) {
41501    eval {
41502      my $ssh2 = Net::SSH2->new();
41503
41504      sleep(1);
41505
41506      unless ($ssh2->connect('127.0.0.1', $port)) {
41507        my ($err_code, $err_name, $err_str) = $ssh2->error();
41508        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
41509      }
41510
41511      unless ($ssh2->auth_password($user, $passwd)) {
41512        my ($err_code, $err_name, $err_str) = $ssh2->error();
41513        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
41514      }
41515
41516      my $sftp = $ssh2->sftp();
41517      unless ($sftp) {
41518        my ($err_code, $err_name, $err_str) = $ssh2->error();
41519        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
41520      }
41521
41522      my $res = $sftp->setstat('sftp.conf',
41523        mode => 0777,
41524      );
41525      if ($res) {
41526        die("setstat sftp.conf succeeded unexpectly");
41527      }
41528
41529      my $attrs = $sftp->stat('sftp.conf');
41530      unless ($attrs) {
41531        my ($err_code, $err_name) = $sftp->error();
41532        die("FXP_STAT sftp.conf failed: [$err_name] ($err_code)");
41533      }
41534
41535      $sftp = undef;
41536      $ssh2->disconnect();
41537
41538      my $expected;
41539
41540      $expected = 0644;
41541      my $file_mode = ($attrs->{mode} & 0777);
41542      $self->assert($expected == $file_mode,
41543        test_msg("Expected '$expected', got '$file_mode'"));
41544    };
41545
41546    if ($@) {
41547      $ex = $@;
41548    }
41549
41550    $wfh->print("done\n");
41551    $wfh->flush();
41552
41553  } else {
41554    eval { server_wait($config_file, $rfh) };
41555    if ($@) {
41556      warn($@);
41557      exit 1;
41558    }
41559
41560    exit 0;
41561  }
41562
41563  # Stop server
41564  server_stop($pid_file);
41565
41566  $self->assert_child_ok($pid);
41567
41568  if ($ex) {
41569    test_append_logfile($log_file, $ex);
41570    unlink($log_file);
41571
41572    die($ex);
41573  }
41574
41575  unlink($log_file);
41576}
41577
41578sub sftp_config_limit_chgrp_bug3757 {
41579  my $self = shift;
41580  my $tmpdir = $self->{tmpdir};
41581
41582  my $config_file = "$tmpdir/sftp.conf";
41583  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
41584  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
41585
41586  my $log_file = test_get_logfile();
41587
41588  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
41589  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
41590
41591  my $user = 'proftpd';
41592  my $passwd = 'test';
41593  my $group = 'ftpd';
41594  my $home_dir = File::Spec->rel2abs($tmpdir);
41595  my $uid = 500;
41596  my $gid = 500;
41597
41598  # Make sure that, if we're running as root, that the home directory has
41599  # permissions/privs set for the account we create
41600  if ($< == 0) {
41601    unless (chmod(0755, $home_dir)) {
41602      die("Can't set perms on $home_dir to 0755: $!");
41603    }
41604
41605    unless (chown($uid, $gid, $home_dir)) {
41606      die("Can't set owner of $home_dir to $uid/$gid: $!");
41607    }
41608  }
41609
41610  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
41611    '/bin/bash');
41612  auth_group_write($auth_group_file, $group, $gid, $user);
41613
41614  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
41615  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
41616
41617  my $config = {
41618    PidFile => $pid_file,
41619    ScoreboardFile => $scoreboard_file,
41620    SystemLog => $log_file,
41621    TraceLog => $log_file,
41622    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
41623
41624    AuthUserFile => $auth_user_file,
41625    AuthGroupFile => $auth_group_file,
41626
41627    IfModules => {
41628      'mod_delay.c' => {
41629        DelayEngine => 'off',
41630      },
41631
41632      'mod_sftp.c' => [
41633        "SFTPEngine on",
41634        "SFTPLog $log_file",
41635        "SFTPHostKey $rsa_host_key",
41636        "SFTPHostKey $dsa_host_key",
41637      ],
41638    },
41639
41640    Limit => {
41641      'SITE_CHGRP' => {
41642        DenyAll => '',
41643      },
41644    },
41645  };
41646
41647  my ($port, $config_user, $config_group) = config_write($config_file, $config);
41648
41649  my ($test_uid, $test_gid) = (stat($config_file))[4, 5];
41650
41651  # Open pipes, for use between the parent and child processes.  Specifically,
41652  # the child will indicate when it's done with its test by writing a message
41653  # to the parent.
41654  my ($rfh, $wfh);
41655  unless (pipe($rfh, $wfh)) {
41656    die("Can't open pipe: $!");
41657  }
41658
41659  require Net::SSH2;
41660
41661  my $ex;
41662
41663  # Fork child
41664  $self->handle_sigchld();
41665  defined(my $pid = fork()) or die("Can't fork: $!");
41666  if ($pid) {
41667    eval {
41668      my $ssh2 = Net::SSH2->new();
41669
41670      sleep(1);
41671
41672      unless ($ssh2->connect('127.0.0.1', $port)) {
41673        my ($err_code, $err_name, $err_str) = $ssh2->error();
41674        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
41675      }
41676
41677      unless ($ssh2->auth_password($user, $passwd)) {
41678        my ($err_code, $err_name, $err_str) = $ssh2->error();
41679        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
41680      }
41681
41682      my $sftp = $ssh2->sftp();
41683      unless ($sftp) {
41684        my ($err_code, $err_name, $err_str) = $ssh2->error();
41685        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
41686      }
41687
41688      my $res = $sftp->setstat('sftp.conf',
41689        uid => $uid,
41690        gid => $gid,
41691      );
41692      if ($res) {
41693        die("setstat sftp.conf succeeded unexpectly");
41694      }
41695
41696      my $attrs = $sftp->stat('sftp.conf');
41697      unless ($attrs) {
41698        my ($err_code, $err_name) = $sftp->error();
41699        die("FXP_STAT sftp.conf failed: [$err_name] ($err_code)");
41700      }
41701
41702      $sftp = undef;
41703      $ssh2->disconnect();
41704    };
41705
41706    if ($@) {
41707      $ex = $@;
41708    }
41709
41710    $wfh->print("done\n");
41711    $wfh->flush();
41712
41713  } else {
41714    eval { server_wait($config_file, $rfh) };
41715    if ($@) {
41716      warn($@);
41717      exit 1;
41718    }
41719
41720    exit 0;
41721  }
41722
41723  my ($new_uid, $new_gid) = (stat($config_file))[4, 5];
41724
41725  my $expected = $test_uid;
41726  $self->assert($expected == $new_uid,
41727    test_msg("Expected UID $expected, got $new_uid"));
41728
41729  $expected = $test_gid;
41730  $self->assert($expected == $new_gid,
41731    test_msg("Expected GID $expected, got $new_gid"));
41732
41733  # Stop server
41734  server_stop($pid_file);
41735
41736  $self->assert_child_ok($pid);
41737
41738  if ($ex) {
41739    test_append_logfile($log_file, $ex);
41740    unlink($log_file);
41741
41742    die($ex);
41743  }
41744
41745  unlink($log_file);
41746}
41747
41748sub sftp_config_limit_list {
41749  my $self = shift;
41750  my $tmpdir = $self->{tmpdir};
41751
41752  my $config_file = "$tmpdir/sftp.conf";
41753  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
41754  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
41755
41756  my $log_file = test_get_logfile();
41757
41758  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
41759  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
41760
41761  my $user = 'proftpd';
41762  my $passwd = 'test';
41763  my $group = 'ftpd';
41764  my $home_dir = File::Spec->rel2abs($tmpdir);
41765  my $uid = 500;
41766  my $gid = 500;
41767
41768  # Make sure that, if we're running as root, that the home directory has
41769  # permissions/privs set for the account we create
41770  if ($< == 0) {
41771    unless (chmod(0755, $home_dir)) {
41772      die("Can't set perms on $home_dir to 0755: $!");
41773    }
41774
41775    unless (chown($uid, $gid, $home_dir)) {
41776      die("Can't set owner of $home_dir to $uid/$gid: $!");
41777    }
41778  }
41779
41780  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
41781    '/bin/bash');
41782  auth_group_write($auth_group_file, $group, $gid, $user);
41783
41784  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
41785  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
41786
41787  my $config = {
41788    PidFile => $pid_file,
41789    ScoreboardFile => $scoreboard_file,
41790    SystemLog => $log_file,
41791    TraceLog => $log_file,
41792    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
41793
41794    AuthUserFile => $auth_user_file,
41795    AuthGroupFile => $auth_group_file,
41796
41797    IfModules => {
41798      'mod_delay.c' => {
41799        DelayEngine => 'off',
41800      },
41801
41802      'mod_sftp.c' => [
41803        "SFTPEngine on",
41804        "SFTPLog $log_file",
41805        "SFTPHostKey $rsa_host_key",
41806        "SFTPHostKey $dsa_host_key",
41807      ],
41808    },
41809
41810    Limit => {
41811      LIST => {
41812        DenyAll => '',
41813      },
41814    },
41815  };
41816
41817  my ($port, $config_user, $config_group) = config_write($config_file, $config);
41818
41819  # Open pipes, for use between the parent and child processes.  Specifically,
41820  # the child will indicate when it's done with its test by writing a message
41821  # to the parent.
41822  my ($rfh, $wfh);
41823  unless (pipe($rfh, $wfh)) {
41824    die("Can't open pipe: $!");
41825  }
41826
41827  require Net::SSH2;
41828
41829  my $ex;
41830
41831  # Fork child
41832  $self->handle_sigchld();
41833  defined(my $pid = fork()) or die("Can't fork: $!");
41834  if ($pid) {
41835    eval {
41836      my $ssh2 = Net::SSH2->new();
41837
41838      sleep(1);
41839
41840      unless ($ssh2->connect('127.0.0.1', $port)) {
41841        my ($err_code, $err_name, $err_str) = $ssh2->error();
41842        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
41843      }
41844
41845      unless ($ssh2->auth_password($user, $passwd)) {
41846        my ($err_code, $err_name, $err_str) = $ssh2->error();
41847        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
41848      }
41849
41850      my $sftp = $ssh2->sftp();
41851      unless ($sftp) {
41852        my ($err_code, $err_name, $err_str) = $ssh2->error();
41853        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
41854      }
41855
41856      # Make sure that OPENDIR succeeds, but READDIR returns end-of-list.
41857      my $dir = $sftp->opendir('.');
41858      unless ($dir) {
41859        my ($err_code, $err_name) = $sftp->error();
41860        die("FXP_OPENDIR . failed: [$err_name] ($err_code)");
41861      }
41862
41863      my $res = {};
41864
41865      my $file = $dir->read();
41866      while ($file) {
41867        $res->{$file->{name}} = $file;
41868        $file = $dir->read();
41869      }
41870
41871      # To close the dirhandle, we explicitly destroy it.
41872      $dir = undef;
41873
41874      $sftp = undef;
41875      $ssh2->disconnect();
41876
41877      my $expected = {};
41878
41879      my $ok = 1;
41880      my $mismatch;
41881
41882      my $seen = [];
41883      foreach my $name (keys(%$res)) {
41884        push(@$seen, $name);
41885
41886        unless (defined($expected->{$name})) {
41887          $mismatch = $name;
41888          $ok = 0;
41889          last;
41890        }
41891      }
41892
41893      unless ($ok) {
41894        die("Unexpected name '$mismatch' appeared in READDIR data")
41895      }
41896
41897      # Now remove from $expected all of the paths we saw; if there are
41898      # any entries remaining in $expected, something went wrong.
41899      foreach my $name (@$seen) {
41900        delete($expected->{$name});
41901      }
41902
41903      my $remaining = scalar(keys(%$expected));
41904      $self->assert(0 == $remaining,
41905        test_msg("Expected 0, got $remaining"));
41906    };
41907
41908    if ($@) {
41909      $ex = $@;
41910    }
41911
41912    $wfh->print("done\n");
41913    $wfh->flush();
41914
41915  } else {
41916    eval { server_wait($config_file, $rfh) };
41917    if ($@) {
41918      warn($@);
41919      exit 1;
41920    }
41921
41922    exit 0;
41923  }
41924
41925  # Stop server
41926  server_stop($pid_file);
41927
41928  $self->assert_child_ok($pid);
41929
41930  if ($ex) {
41931    test_append_logfile($log_file, $ex);
41932    unlink($log_file);
41933
41934    die($ex);
41935  }
41936
41937  unlink($log_file);
41938}
41939
41940sub sftp_config_limit_nlst {
41941  my $self = shift;
41942  my $tmpdir = $self->{tmpdir};
41943
41944  my $config_file = "$tmpdir/sftp.conf";
41945  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
41946  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
41947
41948  my $log_file = test_get_logfile();
41949
41950  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
41951  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
41952
41953  my $user = 'proftpd';
41954  my $passwd = 'test';
41955  my $group = 'ftpd';
41956  my $home_dir = File::Spec->rel2abs($tmpdir);
41957  my $uid = 500;
41958  my $gid = 500;
41959
41960  # Make sure that, if we're running as root, that the home directory has
41961  # permissions/privs set for the account we create
41962  if ($< == 0) {
41963    unless (chmod(0755, $home_dir)) {
41964      die("Can't set perms on $home_dir to 0755: $!");
41965    }
41966
41967    unless (chown($uid, $gid, $home_dir)) {
41968      die("Can't set owner of $home_dir to $uid/$gid: $!");
41969    }
41970  }
41971
41972  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
41973    '/bin/bash');
41974  auth_group_write($auth_group_file, $group, $gid, $user);
41975
41976  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
41977  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
41978
41979  my $config = {
41980    PidFile => $pid_file,
41981    ScoreboardFile => $scoreboard_file,
41982    SystemLog => $log_file,
41983    TraceLog => $log_file,
41984    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
41985
41986    AuthUserFile => $auth_user_file,
41987    AuthGroupFile => $auth_group_file,
41988
41989    IfModules => {
41990      'mod_delay.c' => {
41991        DelayEngine => 'off',
41992      },
41993
41994      'mod_sftp.c' => [
41995        "SFTPEngine on",
41996        "SFTPLog $log_file",
41997        "SFTPHostKey $rsa_host_key",
41998        "SFTPHostKey $dsa_host_key",
41999      ],
42000    },
42001
42002    Limit => {
42003      NLST => {
42004        DenyAll => '',
42005      },
42006    },
42007  };
42008
42009  my ($port, $config_user, $config_group) = config_write($config_file, $config);
42010
42011  # Open pipes, for use between the parent and child processes.  Specifically,
42012  # the child will indicate when it's done with its test by writing a message
42013  # to the parent.
42014  my ($rfh, $wfh);
42015  unless (pipe($rfh, $wfh)) {
42016    die("Can't open pipe: $!");
42017  }
42018
42019  require Net::SSH2;
42020
42021  my $ex;
42022
42023  # Fork child
42024  $self->handle_sigchld();
42025  defined(my $pid = fork()) or die("Can't fork: $!");
42026  if ($pid) {
42027    eval {
42028      my $ssh2 = Net::SSH2->new();
42029
42030      sleep(1);
42031
42032      unless ($ssh2->connect('127.0.0.1', $port)) {
42033        my ($err_code, $err_name, $err_str) = $ssh2->error();
42034        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
42035      }
42036
42037      unless ($ssh2->auth_password($user, $passwd)) {
42038        my ($err_code, $err_name, $err_str) = $ssh2->error();
42039        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
42040      }
42041
42042      my $sftp = $ssh2->sftp();
42043      unless ($sftp) {
42044        my ($err_code, $err_name, $err_str) = $ssh2->error();
42045        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
42046      }
42047
42048      # Make sure that OPENDIR succeeds, but READDIR returns end-of-list.
42049      my $dir = $sftp->opendir('.');
42050      unless ($dir) {
42051        my ($err_code, $err_name) = $sftp->error();
42052        die("FXP_OPENDIR . failed: [$err_name] ($err_code)");
42053      }
42054
42055      my $res = {};
42056
42057      my $file = $dir->read();
42058      while ($file) {
42059        $res->{$file->{name}} = $file;
42060        $file = $dir->read();
42061      }
42062
42063      # To close the dirhandle, we explicitly destroy it.
42064      $dir = undef;
42065
42066      $sftp = undef;
42067      $ssh2->disconnect();
42068
42069      my $expected = {};
42070
42071      my $ok = 1;
42072      my $mismatch;
42073
42074      my $seen = [];
42075      foreach my $name (keys(%$res)) {
42076        push(@$seen, $name);
42077
42078        unless (defined($expected->{$name})) {
42079          $mismatch = $name;
42080          $ok = 0;
42081          last;
42082        }
42083      }
42084
42085      unless ($ok) {
42086        die("Unexpected name '$mismatch' appeared in READDIR data")
42087      }
42088
42089      # Now remove from $expected all of the paths we saw; if there are
42090      # any entries remaining in $expected, something went wrong.
42091      foreach my $name (@$seen) {
42092        delete($expected->{$name});
42093      }
42094
42095      my $remaining = scalar(keys(%$expected));
42096      $self->assert(0 == $remaining,
42097        test_msg("Expected 0, got $remaining"));
42098    };
42099
42100    if ($@) {
42101      $ex = $@;
42102    }
42103
42104    $wfh->print("done\n");
42105    $wfh->flush();
42106
42107  } else {
42108    eval { server_wait($config_file, $rfh) };
42109    if ($@) {
42110      warn($@);
42111      exit 1;
42112    }
42113
42114    exit 0;
42115  }
42116
42117  # Stop server
42118  server_stop($pid_file);
42119
42120  $self->assert_child_ok($pid);
42121
42122  if ($ex) {
42123    test_append_logfile($log_file, $ex);
42124    unlink($log_file);
42125
42126    die($ex);
42127  }
42128
42129  unlink($log_file);
42130}
42131
42132sub sftp_config_limit_allowfilter_stor_allowed {
42133  my $self = shift;
42134  my $tmpdir = $self->{tmpdir};
42135
42136  my $config_file = "$tmpdir/sftp.conf";
42137  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
42138  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
42139
42140  my $log_file = test_get_logfile();
42141
42142  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
42143  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
42144
42145  my $user = 'proftpd';
42146  my $passwd = 'test';
42147  my $group = 'ftpd';
42148  my $home_dir = File::Spec->rel2abs($tmpdir);
42149  my $uid = 500;
42150  my $gid = 500;
42151
42152  # Make sure that, if we're running as root, that the home directory has
42153  # permissions/privs set for the account we create
42154  if ($< == 0) {
42155    unless (chmod(0755, $home_dir)) {
42156      die("Can't set perms on $home_dir to 0755: $!");
42157    }
42158
42159    unless (chown($uid, $gid, $home_dir)) {
42160      die("Can't set owner of $home_dir to $uid/$gid: $!");
42161    }
42162  }
42163
42164  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
42165    '/bin/bash');
42166  auth_group_write($auth_group_file, $group, $gid, $user);
42167
42168  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
42169  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
42170
42171  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
42172
42173  my $config = {
42174    PidFile => $pid_file,
42175    ScoreboardFile => $scoreboard_file,
42176    SystemLog => $log_file,
42177    TraceLog => $log_file,
42178    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
42179
42180    AuthUserFile => $auth_user_file,
42181    AuthGroupFile => $auth_group_file,
42182    DefaultChdir => '~/test.d',
42183
42184    IfModules => {
42185      'mod_delay.c' => {
42186        DelayEngine => 'off',
42187      },
42188
42189      'mod_sftp.c' => [
42190        "SFTPEngine on",
42191        "SFTPLog $log_file",
42192        "SFTPHostKey $rsa_host_key",
42193        "SFTPHostKey $dsa_host_key",
42194      ],
42195    },
42196
42197    Limit => {
42198      STOR => {
42199        AllowFilter => '\.txt$',
42200        DenyAll => '',
42201      },
42202    },
42203  };
42204
42205  my ($port, $config_user, $config_group) = config_write($config_file, $config);
42206
42207  # Open pipes, for use between the parent and child processes.  Specifically,
42208  # the child will indicate when it's done with its test by writing a message
42209  # to the parent.
42210  my ($rfh, $wfh);
42211  unless (pipe($rfh, $wfh)) {
42212    die("Can't open pipe: $!");
42213  }
42214
42215  require Net::SSH2;
42216
42217  my $ex;
42218
42219  # Fork child
42220  $self->handle_sigchld();
42221  defined(my $pid = fork()) or die("Can't fork: $!");
42222  if ($pid) {
42223    eval {
42224      my $ssh2 = Net::SSH2->new();
42225
42226      sleep(1);
42227
42228      unless ($ssh2->connect('127.0.0.1', $port)) {
42229        my ($err_code, $err_name, $err_str) = $ssh2->error();
42230        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
42231      }
42232
42233      unless ($ssh2->auth_password($user, $passwd)) {
42234        my ($err_code, $err_name, $err_str) = $ssh2->error();
42235        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
42236      }
42237
42238      my $sftp = $ssh2->sftp();
42239      unless ($sftp) {
42240        my ($err_code, $err_name, $err_str) = $ssh2->error();
42241        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
42242      }
42243
42244      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
42245      unless ($fh) {
42246        my ($err_code, $err_name) = $sftp->error();
42247        die("Can't open test.txt: [$err_name] ($err_code)");
42248      }
42249
42250      my $count = 20;
42251      for (my $i = 0; $i < $count; $i++) {
42252        print $fh "ABCD" x 8192;
42253      }
42254
42255      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
42256      $fh = undef;
42257
42258      $sftp = undef;
42259      $ssh2->disconnect();
42260
42261      $self->assert(-f $test_file,
42262        test_msg("File $test_file does not exist as expected"));
42263
42264      $self->assert(-s $test_file,
42265        test_msg("File $test_file size is unexpectedly zero"));
42266    };
42267
42268    if ($@) {
42269      $ex = $@;
42270    }
42271
42272    $wfh->print("done\n");
42273    $wfh->flush();
42274
42275  } else {
42276    eval { server_wait($config_file, $rfh) };
42277    if ($@) {
42278      warn($@);
42279      exit 1;
42280    }
42281
42282    exit 0;
42283  }
42284
42285  # Stop server
42286  server_stop($pid_file);
42287
42288  $self->assert_child_ok($pid);
42289
42290  if ($ex) {
42291    test_append_logfile($log_file, $ex);
42292    unlink($log_file);
42293
42294    die($ex);
42295  }
42296
42297  unlink($log_file);
42298}
42299
42300sub sftp_config_limit_allowfilter_stor_denied {
42301  my $self = shift;
42302  my $tmpdir = $self->{tmpdir};
42303
42304  my $config_file = "$tmpdir/sftp.conf";
42305  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
42306  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
42307
42308  my $log_file = test_get_logfile();
42309
42310  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
42311  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
42312
42313  my $user = 'proftpd';
42314  my $passwd = 'test';
42315  my $group = 'ftpd';
42316  my $home_dir = File::Spec->rel2abs($tmpdir);
42317  my $uid = 500;
42318  my $gid = 500;
42319
42320  # Make sure that, if we're running as root, that the home directory has
42321  # permissions/privs set for the account we create
42322  if ($< == 0) {
42323    unless (chmod(0755, $home_dir)) {
42324      die("Can't set perms on $home_dir to 0755: $!");
42325    }
42326
42327    unless (chown($uid, $gid, $home_dir)) {
42328      die("Can't set owner of $home_dir to $uid/$gid: $!");
42329    }
42330  }
42331
42332  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
42333    '/bin/bash');
42334  auth_group_write($auth_group_file, $group, $gid, $user);
42335
42336  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
42337  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
42338
42339  my $config = {
42340    PidFile => $pid_file,
42341    ScoreboardFile => $scoreboard_file,
42342    SystemLog => $log_file,
42343    TraceLog => $log_file,
42344    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
42345
42346    AuthUserFile => $auth_user_file,
42347    AuthGroupFile => $auth_group_file,
42348
42349    IfModules => {
42350      'mod_delay.c' => {
42351        DelayEngine => 'off',
42352      },
42353
42354      'mod_sftp.c' => [
42355        "SFTPEngine on",
42356        "SFTPLog $log_file",
42357        "SFTPHostKey $rsa_host_key",
42358        "SFTPHostKey $dsa_host_key",
42359      ],
42360    },
42361
42362    Limit => {
42363      STOR => {
42364        AllowFilter => '\.txt$',
42365        DenyAll => '',
42366      },
42367    },
42368  };
42369
42370  my ($port, $config_user, $config_group) = config_write($config_file, $config);
42371
42372  # Open pipes, for use between the parent and child processes.  Specifically,
42373  # the child will indicate when it's done with its test by writing a message
42374  # to the parent.
42375  my ($rfh, $wfh);
42376  unless (pipe($rfh, $wfh)) {
42377    die("Can't open pipe: $!");
42378  }
42379
42380  require Net::SSH2;
42381
42382  my $ex;
42383
42384  # Fork child
42385  $self->handle_sigchld();
42386  defined(my $pid = fork()) or die("Can't fork: $!");
42387  if ($pid) {
42388    eval {
42389      my $ssh2 = Net::SSH2->new();
42390
42391      sleep(1);
42392
42393      unless ($ssh2->connect('127.0.0.1', $port)) {
42394        my ($err_code, $err_name, $err_str) = $ssh2->error();
42395        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
42396      }
42397
42398      unless ($ssh2->auth_password($user, $passwd)) {
42399        my ($err_code, $err_name, $err_str) = $ssh2->error();
42400        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
42401      }
42402
42403      my $sftp = $ssh2->sftp();
42404      unless ($sftp) {
42405        my ($err_code, $err_name, $err_str) = $ssh2->error();
42406        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
42407      }
42408
42409      my $fh = $sftp->open('test.jpg', O_WRONLY|O_CREAT|O_TRUNC, 0644);
42410      if ($fh) {
42411        die("Open of test.jpg succeeded unexpectedly");
42412      }
42413
42414      my ($err_code, $err_name) = $sftp->error();
42415
42416      my $expected = 'SSH_FX_PERMISSION_DENIED';
42417      $self->assert($err_name eq $expected,
42418        test_msg("Expected error name '$expected', got '$err_name'"));
42419
42420      $sftp = undef;
42421      $ssh2->disconnect();
42422    };
42423
42424    if ($@) {
42425      $ex = $@;
42426    }
42427
42428    $wfh->print("done\n");
42429    $wfh->flush();
42430
42431  } else {
42432    eval { server_wait($config_file, $rfh) };
42433    if ($@) {
42434      warn($@);
42435      exit 1;
42436    }
42437
42438    exit 0;
42439  }
42440
42441  # Stop server
42442  server_stop($pid_file);
42443
42444  $self->assert_child_ok($pid);
42445
42446  if ($ex) {
42447    test_append_logfile($log_file, $ex);
42448    unlink($log_file);
42449
42450    die($ex);
42451  }
42452
42453  unlink($log_file);
42454}
42455
42456sub sftp_config_limit_dirs_realpath_bug3871 {
42457  my $self = shift;
42458  my $tmpdir = $self->{tmpdir};
42459
42460  my $config_file = "$tmpdir/sftp.conf";
42461  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
42462  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
42463
42464  my $log_file = test_get_logfile();
42465
42466  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
42467  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
42468
42469  my $user = 'proftpd';
42470  my $passwd = 'test';
42471  my $group = 'ftpd';
42472  my $home_dir = File::Spec->rel2abs($tmpdir);
42473  my $uid = 500;
42474  my $gid = 500;
42475
42476  # Make sure that, if we're running as root, that the home directory has
42477  # permissions/privs set for the account we create
42478  if ($< == 0) {
42479    unless (chmod(0755, $home_dir)) {
42480      die("Can't set perms on $home_dir to 0755: $!");
42481    }
42482
42483    unless (chown($uid, $gid, $home_dir)) {
42484      die("Can't set owner of $home_dir to $uid/$gid: $!");
42485    }
42486  }
42487
42488  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
42489    '/bin/bash');
42490  auth_group_write($auth_group_file, $group, $gid, $user);
42491
42492  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
42493  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
42494
42495  my $sub_dir = File::Spec->rel2abs("$tmpdir/test.d");
42496  mkpath($sub_dir);
42497
42498  my $config = {
42499    PidFile => $pid_file,
42500    ScoreboardFile => $scoreboard_file,
42501    SystemLog => $log_file,
42502    TraceLog => $log_file,
42503    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
42504
42505    AuthUserFile => $auth_user_file,
42506    AuthGroupFile => $auth_group_file,
42507
42508    IfModules => {
42509      'mod_delay.c' => {
42510        DelayEngine => 'off',
42511      },
42512
42513      'mod_sftp.c' => [
42514        "SFTPEngine on",
42515        "SFTPLog $log_file",
42516        "SFTPHostKey $rsa_host_key",
42517        "SFTPHostKey $dsa_host_key",
42518      ],
42519    },
42520  };
42521
42522  my ($port, $config_user, $config_group) = config_write($config_file, $config);
42523
42524  if (open(my $fh, ">> $config_file")) {
42525    print $fh <<EOC;
42526<Directory ~>
42527  <Limit ALL>
42528    DenyAll
42529  </Limit>
42530
42531  <Limit READ DIRS>
42532    AllowUser $user
42533  </Limit>
42534</Directory>
42535EOC
42536    unless (close($fh)) {
42537      die("Can't write $config_file: $!");
42538    }
42539
42540  } else {
42541    die("Can't open $config_file: $!");
42542  }
42543
42544  # Open pipes, for use between the parent and child processes.  Specifically,
42545  # the child will indicate when it's done with its test by writing a message
42546  # to the parent.
42547  my ($rfh, $wfh);
42548  unless (pipe($rfh, $wfh)) {
42549    die("Can't open pipe: $!");
42550  }
42551
42552  require Net::SSH2;
42553
42554  my $ex;
42555
42556  # Ignore SIGPIPE
42557  local $SIG{PIPE} = sub { };
42558
42559  # Fork child
42560  $self->handle_sigchld();
42561  defined(my $pid = fork()) or die("Can't fork: $!");
42562  if ($pid) {
42563    eval {
42564      my $ssh2 = Net::SSH2->new();
42565
42566      sleep(1);
42567
42568      unless ($ssh2->connect('127.0.0.1', $port)) {
42569        my ($err_code, $err_name, $err_str) = $ssh2->error();
42570        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
42571      }
42572
42573      unless ($ssh2->auth_password($user, $passwd)) {
42574        my ($err_code, $err_name, $err_str) = $ssh2->error();
42575        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
42576      }
42577
42578      my $sftp = $ssh2->sftp();
42579      unless ($sftp) {
42580        my ($err_code, $err_name, $err_str) = $ssh2->error();
42581        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
42582      }
42583
42584      my $dir = $sftp->realpath('test.d');
42585      unless ($dir) {
42586        my ($err_code, $err_name) = $sftp->error();
42587        die("Can't get real path for 'test.d': [$err_name] ($err_code)");
42588      }
42589
42590      my $expected;
42591
42592      $expected = $sub_dir;
42593      if ($^O eq 'darwin') {
42594        # MacOSX-specific hack to deal with how it handles tmp files
42595        $expected = ('/private' . $expected);
42596      }
42597
42598      $self->assert($expected eq $dir,
42599        test_msg("Expected '$expected', got '$dir'"));
42600
42601      $sftp = undef;
42602      $ssh2->disconnect();
42603    };
42604
42605    if ($@) {
42606      $ex = $@;
42607    }
42608
42609    $wfh->print("done\n");
42610    $wfh->flush();
42611
42612  } else {
42613    eval { server_wait($config_file, $rfh) };
42614    if ($@) {
42615      warn($@);
42616      exit 1;
42617    }
42618
42619    exit 0;
42620  }
42621
42622  # Stop server
42623  server_stop($pid_file);
42624
42625  $self->assert_child_ok($pid);
42626
42627  if ($ex) {
42628    test_append_logfile($log_file, $ex);
42629    unlink($log_file);
42630
42631    die($ex);
42632  }
42633
42634  unlink($log_file);
42635}
42636
42637sub sftp_config_limit_readdir {
42638  my $self = shift;
42639  my $tmpdir = $self->{tmpdir};
42640
42641  my $config_file = "$tmpdir/sftp.conf";
42642  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
42643  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
42644
42645  my $log_file = test_get_logfile();
42646
42647  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
42648  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
42649
42650  my $user = 'proftpd';
42651  my $passwd = 'test';
42652  my $group = 'ftpd';
42653  my $home_dir = File::Spec->rel2abs($tmpdir);
42654  my $uid = 500;
42655  my $gid = 500;
42656
42657  # Make sure that, if we're running as root, that the home directory has
42658  # permissions/privs set for the account we create
42659  if ($< == 0) {
42660    unless (chmod(0755, $home_dir)) {
42661      die("Can't set perms on $home_dir to 0755: $!");
42662    }
42663
42664    unless (chown($uid, $gid, $home_dir)) {
42665      die("Can't set owner of $home_dir to $uid/$gid: $!");
42666    }
42667  }
42668
42669  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
42670    '/bin/bash');
42671  auth_group_write($auth_group_file, $group, $gid, $user);
42672
42673  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
42674  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
42675
42676  my $config = {
42677    PidFile => $pid_file,
42678    ScoreboardFile => $scoreboard_file,
42679    SystemLog => $log_file,
42680    TraceLog => $log_file,
42681    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
42682
42683    AuthUserFile => $auth_user_file,
42684    AuthGroupFile => $auth_group_file,
42685
42686    IfModules => {
42687      'mod_delay.c' => {
42688        DelayEngine => 'off',
42689      },
42690
42691      'mod_sftp.c' => [
42692        "SFTPEngine on",
42693        "SFTPLog $log_file",
42694        "SFTPHostKey $rsa_host_key",
42695        "SFTPHostKey $dsa_host_key",
42696      ],
42697    },
42698  };
42699
42700  my ($port, $config_user, $config_group) = config_write($config_file, $config);
42701  if (open(my $fh, ">> $config_file")) {
42702    print $fh <<EOC;
42703<Limit ALL>
42704  DenyAll
42705</Limit>
42706
42707# By not allowing READDIR here, we should not get any directory listing,
42708# but the OPENDIR should succeed.
42709<Limit OPENDIR CLOSE>
42710  AllowAll
42711</Limit>
42712EOC
42713    unless (close($fh)) {
42714      die("Can't write $config_file: $!");
42715    }
42716
42717  } else {
42718    die("Can't open $config_file: $!");
42719  }
42720
42721  # Open pipes, for use between the parent and child processes.  Specifically,
42722  # the child will indicate when it's done with its test by writing a message
42723  # to the parent.
42724  my ($rfh, $wfh);
42725  unless (pipe($rfh, $wfh)) {
42726    die("Can't open pipe: $!");
42727  }
42728
42729  require Net::SSH2;
42730
42731  my $ex;
42732
42733  # Ignore SIGPIPE
42734  local $SIG{PIPE} = sub { };
42735
42736  # Fork child
42737  $self->handle_sigchld();
42738  defined(my $pid = fork()) or die("Can't fork: $!");
42739  if ($pid) {
42740    eval {
42741      my $ssh2 = Net::SSH2->new();
42742
42743      sleep(1);
42744
42745      unless ($ssh2->connect('127.0.0.1', $port)) {
42746        my ($err_code, $err_name, $err_str) = $ssh2->error();
42747        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
42748      }
42749
42750      unless ($ssh2->auth_password($user, $passwd)) {
42751        my ($err_code, $err_name, $err_str) = $ssh2->error();
42752        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
42753      }
42754
42755      my $sftp = $ssh2->sftp();
42756      unless ($sftp) {
42757        my ($err_code, $err_name, $err_str) = $ssh2->error();
42758        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
42759      }
42760
42761      my $dir = $sftp->opendir('.');
42762      unless ($dir) {
42763        my ($err_code, $err_name) = $sftp->error();
42764        die("Can't open directory '.': [$err_name] ($err_code)");
42765      }
42766
42767      my $res = {};
42768
42769      my $file = $dir->read();
42770      while ($file) {
42771        $res->{$file->{name}} = $file;
42772        $file = $dir->read();
42773      }
42774
42775      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
42776      $dir = undef;
42777
42778      # To close the SFTP channel, we have to explicitly destroy the object
42779      $sftp = undef;
42780
42781      $ssh2->disconnect();
42782
42783      my $count = scalar(keys(%$res));
42784      my $expected = 0;
42785      $self->assert($count == $expected,
42786        test_msg("Expected $expected directory entries, got $count"));
42787    };
42788
42789    if ($@) {
42790      $ex = $@;
42791    }
42792
42793    $wfh->print("done\n");
42794    $wfh->flush();
42795
42796  } else {
42797    eval { server_wait($config_file, $rfh) };
42798    if ($@) {
42799      warn($@);
42800      exit 1;
42801    }
42802
42803    exit 0;
42804  }
42805
42806  # Stop server
42807  server_stop($pid_file);
42808
42809  $self->assert_child_ok($pid);
42810
42811  if ($ex) {
42812    test_append_logfile($log_file, $ex);
42813    unlink($log_file);
42814
42815    die($ex);
42816  }
42817
42818  unlink($log_file);
42819}
42820
42821sub sftp_config_limit_fsetstat_bug3753 {
42822  my $self = shift;
42823  my $tmpdir = $self->{tmpdir};
42824
42825  my $config_file = "$tmpdir/sftp.conf";
42826  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
42827  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
42828
42829  my $log_file = test_get_logfile();
42830
42831  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
42832  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
42833
42834  my $user = 'proftpd';
42835  my $passwd = 'test';
42836  my $group = 'ftpd';
42837  my $home_dir = File::Spec->rel2abs($tmpdir);
42838  my $uid = 500;
42839  my $gid = 500;
42840
42841  # Make sure that, if we're running as root, that the home directory has
42842  # permissions/privs set for the account we create
42843  if ($< == 0) {
42844    unless (chmod(0755, $home_dir)) {
42845      die("Can't set perms on $home_dir to 0755: $!");
42846    }
42847
42848    unless (chown($uid, $gid, $home_dir)) {
42849      die("Can't set owner of $home_dir to $uid/$gid: $!");
42850    }
42851  }
42852
42853  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
42854    '/bin/bash');
42855  auth_group_write($auth_group_file, $group, $gid, $user);
42856
42857  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
42858  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
42859
42860  my $config = {
42861    PidFile => $pid_file,
42862    ScoreboardFile => $scoreboard_file,
42863    SystemLog => $log_file,
42864    TraceLog => $log_file,
42865    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
42866
42867    AuthUserFile => $auth_user_file,
42868    AuthGroupFile => $auth_group_file,
42869
42870    IfModules => {
42871      'mod_delay.c' => {
42872        DelayEngine => 'off',
42873      },
42874
42875      'mod_sftp.c' => [
42876        "SFTPEngine on",
42877        "SFTPLog $log_file",
42878        "SFTPHostKey $rsa_host_key",
42879        "SFTPHostKey $dsa_host_key",
42880      ],
42881    },
42882  };
42883
42884  my ($port, $config_user, $config_group) = config_write($config_file, $config);
42885  if (open(my $fh, ">> $config_file")) {
42886    print $fh <<EOC;
42887<Limit ALL>
42888  DenyAll
42889</Limit>
42890
42891<Limit READ FSETSTAT>
42892  AllowAll
42893</Limit>
42894EOC
42895    unless (close($fh)) {
42896      die("Can't write $config_file: $!");
42897    }
42898
42899  } else {
42900    die("Can't open $config_file: $!");
42901  }
42902
42903  # Open pipes, for use between the parent and child processes.  Specifically,
42904  # the child will indicate when it's done with its test by writing a message
42905  # to the parent.
42906  my ($rfh, $wfh);
42907  unless (pipe($rfh, $wfh)) {
42908    die("Can't open pipe: $!");
42909  }
42910
42911  require Net::SSH2;
42912
42913  my $ex;
42914
42915  # Fork child
42916  $self->handle_sigchld();
42917  defined(my $pid = fork()) or die("Can't fork: $!");
42918  if ($pid) {
42919    eval {
42920      my $ssh2 = Net::SSH2->new();
42921
42922      sleep(1);
42923
42924      unless ($ssh2->connect('127.0.0.1', $port)) {
42925        my ($err_code, $err_name, $err_str) = $ssh2->error();
42926        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
42927      }
42928
42929      unless ($ssh2->auth_password($user, $passwd)) {
42930        my ($err_code, $err_name, $err_str) = $ssh2->error();
42931        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
42932      }
42933
42934      my $sftp = $ssh2->sftp();
42935      unless ($sftp) {
42936        my ($err_code, $err_name, $err_str) = $ssh2->error();
42937        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
42938      }
42939
42940      my $file = 'sftp.conf';
42941      my $fh = $sftp->open($file, O_RDONLY);
42942      unless ($fh) {
42943        my ($err_code, $err_name) = $sftp->error();
42944        die("Can't open $file: [$err_name] ($err_code)");
42945      }
42946
42947      my $res = $fh->setstat(
42948        atime => 0,
42949        mtime => 0,
42950      );
42951      unless ($res) {
42952        my ($err_code, $err_name) = $sftp->error();
42953        die("Can't fsetstat $file: [$err_name] ($err_code)");
42954      }
42955
42956      # Explicitly destroy the handle to issue the FXP_CLOSE
42957      $fh = undef;
42958
42959      my $attrs = $sftp->stat($file);
42960      unless ($attrs) {
42961        my ($err_code, $err_name) = $sftp->error();
42962        die("Can't stat $file: [$err_name] ($err_code)");
42963      }
42964
42965      $sftp = undef;
42966      $ssh2->disconnect();
42967
42968      my $expected;
42969
42970      $expected = 0;
42971      my $file_atime = $attrs->{atime};
42972      $self->assert($expected == $file_atime,
42973        test_msg("Expected file atime '$expected', got '$file_atime'"));
42974
42975      my $file_mtime = $attrs->{mtime};
42976      $self->assert($expected == $file_mtime,
42977        test_msg("Expected file mtime '$expected', got '$file_mtime'"));
42978    };
42979
42980    if ($@) {
42981      $ex = $@;
42982    }
42983
42984    $wfh->print("done\n");
42985    $wfh->flush();
42986
42987  } else {
42988    eval { server_wait($config_file, $rfh) };
42989    if ($@) {
42990      warn($@);
42991      exit 1;
42992    }
42993
42994    exit 0;
42995  }
42996
42997  # Stop server
42998  server_stop($pid_file);
42999
43000  $self->assert_child_ok($pid);
43001
43002  if ($ex) {
43003    test_append_logfile($log_file, $ex);
43004    unlink($log_file);
43005
43006    die($ex);
43007  }
43008
43009  unlink($log_file);
43010}
43011
43012sub sftp_config_limit_mkdir_bug3753 {
43013  my $self = shift;
43014  my $tmpdir = $self->{tmpdir};
43015
43016  my $config_file = "$tmpdir/sftp.conf";
43017  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
43018  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
43019
43020  my $log_file = test_get_logfile();
43021
43022  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
43023  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
43024
43025  my $user = 'proftpd';
43026  my $passwd = 'test';
43027  my $group = 'ftpd';
43028  my $home_dir = File::Spec->rel2abs($tmpdir);
43029  my $uid = 500;
43030  my $gid = 500;
43031
43032  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
43033
43034  # Make sure that, if we're running as root, that the home directory has
43035  # permissions/privs set for the account we create
43036  if ($< == 0) {
43037    unless (chmod(0755, $home_dir)) {
43038      die("Can't set perms on $home_dir to 0755: $!");
43039    }
43040
43041    unless (chown($uid, $gid, $home_dir)) {
43042      die("Can't set owner of $home_dir to $uid/$gid: $!");
43043    }
43044  }
43045
43046  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
43047    '/bin/bash');
43048  auth_group_write($auth_group_file, $group, $gid, $user);
43049
43050  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
43051  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
43052
43053  my $config = {
43054    PidFile => $pid_file,
43055    ScoreboardFile => $scoreboard_file,
43056    SystemLog => $log_file,
43057    TraceLog => $log_file,
43058    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
43059
43060    AuthUserFile => $auth_user_file,
43061    AuthGroupFile => $auth_group_file,
43062
43063    IfModules => {
43064      'mod_delay.c' => {
43065        DelayEngine => 'off',
43066      },
43067
43068      'mod_sftp.c' => [
43069        "SFTPEngine on",
43070        "SFTPLog $log_file",
43071        "SFTPHostKey $rsa_host_key",
43072        "SFTPHostKey $dsa_host_key",
43073      ],
43074    },
43075  };
43076
43077  my ($port, $config_user, $config_group) = config_write($config_file, $config);
43078  if (open(my $fh, ">> $config_file")) {
43079    print $fh <<EOC;
43080<Limit ALL>
43081  DenyAll
43082</Limit>
43083
43084<Limit MKD>
43085  AllowAll
43086</Limit>
43087EOC
43088    unless (close($fh)) {
43089      die("Can't write $config_file: $!");
43090    }
43091
43092  } else {
43093    die("Can't open $config_file: $!");
43094  }
43095
43096  # Open pipes, for use between the parent and child processes.  Specifically,
43097  # the child will indicate when it's done with its test by writing a message
43098  # to the parent.
43099  my ($rfh, $wfh);
43100  unless (pipe($rfh, $wfh)) {
43101    die("Can't open pipe: $!");
43102  }
43103
43104  require Net::SSH2;
43105
43106  my $ex;
43107
43108  # Fork child
43109  $self->handle_sigchld();
43110  defined(my $pid = fork()) or die("Can't fork: $!");
43111  if ($pid) {
43112    eval {
43113      my $ssh2 = Net::SSH2->new();
43114
43115      sleep(1);
43116
43117      unless ($ssh2->connect('127.0.0.1', $port)) {
43118        my ($err_code, $err_name, $err_str) = $ssh2->error();
43119        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
43120      }
43121
43122      unless ($ssh2->auth_password($user, $passwd)) {
43123        my ($err_code, $err_name, $err_str) = $ssh2->error();
43124        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
43125      }
43126
43127      my $sftp = $ssh2->sftp();
43128      unless ($sftp) {
43129        my ($err_code, $err_name, $err_str) = $ssh2->error();
43130        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
43131      }
43132
43133      my $res = $sftp->mkdir('testdir');
43134      unless ($res) {
43135        my ($err_code, $err_name) = $sftp->error();
43136        die("Can't mkdir testdir: [$err_name] ($err_code)");
43137      }
43138
43139      $sftp = undef;
43140      $ssh2->disconnect();
43141
43142      unless (-d $test_dir) {
43143        die("$test_dir directory does not exist as expected");
43144      }
43145    };
43146
43147    if ($@) {
43148      $ex = $@;
43149    }
43150
43151    $wfh->print("done\n");
43152    $wfh->flush();
43153
43154  } else {
43155    eval { server_wait($config_file, $rfh) };
43156    if ($@) {
43157      warn($@);
43158      exit 1;
43159    }
43160
43161    exit 0;
43162  }
43163
43164  # Stop server
43165  server_stop($pid_file);
43166
43167  $self->assert_child_ok($pid);
43168
43169  if ($ex) {
43170    test_append_logfile($log_file, $ex);
43171    unlink($log_file);
43172
43173    die($ex);
43174  }
43175
43176  unlink($log_file);
43177}
43178
43179sub sftp_config_limit_opendir_bug3753 {
43180  my $self = shift;
43181  my $tmpdir = $self->{tmpdir};
43182
43183  my $config_file = "$tmpdir/sftp.conf";
43184  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
43185  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
43186
43187  my $log_file = test_get_logfile();
43188
43189  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
43190  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
43191
43192  my $user = 'proftpd';
43193  my $passwd = 'test';
43194  my $group = 'ftpd';
43195  my $home_dir = File::Spec->rel2abs($tmpdir);
43196  my $uid = 500;
43197  my $gid = 500;
43198
43199  # Make sure that, if we're running as root, that the home directory has
43200  # permissions/privs set for the account we create
43201  if ($< == 0) {
43202    unless (chmod(0755, $home_dir)) {
43203      die("Can't set perms on $home_dir to 0755: $!");
43204    }
43205
43206    unless (chown($uid, $gid, $home_dir)) {
43207      die("Can't set owner of $home_dir to $uid/$gid: $!");
43208    }
43209  }
43210
43211  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
43212    '/bin/bash');
43213  auth_group_write($auth_group_file, $group, $gid, $user);
43214
43215  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
43216  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
43217
43218  my $config = {
43219    PidFile => $pid_file,
43220    ScoreboardFile => $scoreboard_file,
43221    SystemLog => $log_file,
43222    TraceLog => $log_file,
43223    Trace => 'auth:10 ssh2:20 sftp:20',
43224
43225    AuthUserFile => $auth_user_file,
43226    AuthGroupFile => $auth_group_file,
43227
43228    IfModules => {
43229      'mod_delay.c' => {
43230        DelayEngine => 'off',
43231      },
43232
43233      'mod_sftp.c' => [
43234        "SFTPEngine on",
43235        "SFTPLog $log_file",
43236        "SFTPHostKey $rsa_host_key",
43237        "SFTPHostKey $dsa_host_key",
43238      ],
43239    },
43240  };
43241
43242  my ($port, $config_user, $config_group) = config_write($config_file, $config);
43243  if (open(my $fh, ">> $config_file")) {
43244    print $fh <<EOC;
43245<Limit ALL>
43246  DenyAll
43247</Limit>
43248
43249<Limit MLSD>
43250  AllowAll
43251</Limit>
43252EOC
43253    unless (close($fh)) {
43254      die("Can't write $config_file: $!");
43255    }
43256
43257  } else {
43258    die("Can't open $config_file: $!");
43259  }
43260
43261  # Open pipes, for use between the parent and child processes.  Specifically,
43262  # the child will indicate when it's done with its test by writing a message
43263  # to the parent.
43264  my ($rfh, $wfh);
43265  unless (pipe($rfh, $wfh)) {
43266    die("Can't open pipe: $!");
43267  }
43268
43269  require Net::SSH2;
43270
43271  my $ex;
43272
43273  # Fork child
43274  $self->handle_sigchld();
43275  defined(my $pid = fork()) or die("Can't fork: $!");
43276  if ($pid) {
43277    eval {
43278      my $ssh2 = Net::SSH2->new();
43279
43280      sleep(1);
43281
43282      unless ($ssh2->connect('127.0.0.1', $port)) {
43283        my ($err_code, $err_name, $err_str) = $ssh2->error();
43284        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
43285      }
43286
43287      unless ($ssh2->auth_password($user, $passwd)) {
43288        my ($err_code, $err_name, $err_str) = $ssh2->error();
43289        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
43290      }
43291
43292      my $sftp = $ssh2->sftp();
43293      unless ($sftp) {
43294        my ($err_code, $err_name, $err_str) = $ssh2->error();
43295        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
43296      }
43297
43298      my $dir = $sftp->opendir('.');
43299      unless ($dir) {
43300        my ($err_code, $err_name) = $sftp->error();
43301        die("Can't open directory '.': [$err_name] ($err_code)");
43302      }
43303
43304      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
43305      $dir = undef;
43306
43307      # To close the SFTP channel, we have to explicitly destroy the object
43308      $sftp = undef;
43309
43310      $ssh2->disconnect();
43311    };
43312
43313    if ($@) {
43314      $ex = $@;
43315    }
43316
43317    $wfh->print("done\n");
43318    $wfh->flush();
43319
43320  } else {
43321    eval { server_wait($config_file, $rfh) };
43322    if ($@) {
43323      warn($@);
43324      exit 1;
43325    }
43326
43327    exit 0;
43328  }
43329
43330  # Stop server
43331  server_stop($pid_file);
43332
43333  $self->assert_child_ok($pid);
43334
43335  if ($ex) {
43336    test_append_logfile($log_file, $ex);
43337    unlink($log_file);
43338
43339    die($ex);
43340  }
43341
43342  unlink($log_file);
43343}
43344
43345sub sftp_config_limit_readdir_bug3753 {
43346  my $self = shift;
43347  my $tmpdir = $self->{tmpdir};
43348
43349  my $config_file = "$tmpdir/sftp.conf";
43350  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
43351  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
43352
43353  my $log_file = test_get_logfile();
43354
43355  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
43356  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
43357
43358  my $user = 'proftpd';
43359  my $passwd = 'test';
43360  my $group = 'ftpd';
43361  my $home_dir = File::Spec->rel2abs($tmpdir);
43362  my $uid = 500;
43363  my $gid = 500;
43364
43365  # Make sure that, if we're running as root, that the home directory has
43366  # permissions/privs set for the account we create
43367  if ($< == 0) {
43368    unless (chmod(0755, $home_dir)) {
43369      die("Can't set perms on $home_dir to 0755: $!");
43370    }
43371
43372    unless (chown($uid, $gid, $home_dir)) {
43373      die("Can't set owner of $home_dir to $uid/$gid: $!");
43374    }
43375  }
43376
43377  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
43378    '/bin/bash');
43379  auth_group_write($auth_group_file, $group, $gid, $user);
43380
43381  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
43382  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
43383
43384  my $config = {
43385    PidFile => $pid_file,
43386    ScoreboardFile => $scoreboard_file,
43387    SystemLog => $log_file,
43388    TraceLog => $log_file,
43389    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
43390
43391    AuthUserFile => $auth_user_file,
43392    AuthGroupFile => $auth_group_file,
43393
43394    IfModules => {
43395      'mod_delay.c' => {
43396        DelayEngine => 'off',
43397      },
43398
43399      'mod_sftp.c' => [
43400        "SFTPEngine on",
43401        "SFTPLog $log_file",
43402        "SFTPHostKey $rsa_host_key",
43403        "SFTPHostKey $dsa_host_key",
43404      ],
43405    },
43406  };
43407
43408  my ($port, $config_user, $config_group) = config_write($config_file, $config);
43409  if (open(my $fh, ">> $config_file")) {
43410    print $fh <<EOC;
43411<Limit ALL>
43412  DenyAll
43413</Limit>
43414
43415# By not allowing READDIR here, we should not get any directory listing,
43416# but the OPENDIR should succeed.
43417<Limit OPENDIR READDIR CLOSE>
43418  AllowAll
43419</Limit>
43420EOC
43421    unless (close($fh)) {
43422      die("Can't write $config_file: $!");
43423    }
43424
43425  } else {
43426    die("Can't open $config_file: $!");
43427  }
43428
43429  # Open pipes, for use between the parent and child processes.  Specifically,
43430  # the child will indicate when it's done with its test by writing a message
43431  # to the parent.
43432  my ($rfh, $wfh);
43433  unless (pipe($rfh, $wfh)) {
43434    die("Can't open pipe: $!");
43435  }
43436
43437  require Net::SSH2;
43438
43439  my $ex;
43440
43441  # Ignore SIGPIPE
43442  local $SIG{PIPE} = sub { };
43443
43444  # Fork child
43445  $self->handle_sigchld();
43446  defined(my $pid = fork()) or die("Can't fork: $!");
43447  if ($pid) {
43448    eval {
43449      my $ssh2 = Net::SSH2->new();
43450
43451      sleep(1);
43452
43453      unless ($ssh2->connect('127.0.0.1', $port)) {
43454        my ($err_code, $err_name, $err_str) = $ssh2->error();
43455        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
43456      }
43457
43458      unless ($ssh2->auth_password($user, $passwd)) {
43459        my ($err_code, $err_name, $err_str) = $ssh2->error();
43460        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
43461      }
43462
43463      my $sftp = $ssh2->sftp();
43464      unless ($sftp) {
43465        my ($err_code, $err_name, $err_str) = $ssh2->error();
43466        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
43467      }
43468
43469      my $dir = $sftp->opendir('.');
43470      unless ($dir) {
43471        my ($err_code, $err_name) = $sftp->error();
43472        die("Can't open directory '.': [$err_name] ($err_code)");
43473      }
43474
43475      my $res = {};
43476
43477      my $file = $dir->read();
43478      while ($file) {
43479        $res->{$file->{name}} = $file;
43480        $file = $dir->read();
43481      }
43482
43483      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
43484      $dir = undef;
43485
43486      # To close the SFTP channel, we have to explicitly destroy the object
43487      $sftp = undef;
43488
43489      $ssh2->disconnect();
43490
43491      my $expected = {
43492        '.' => 1,
43493        '..' => 1,
43494        'sftp.conf' => 1,
43495        'sftp.group' => 1,
43496        'sftp.passwd' => 1,
43497        'sftp.pid' => 1,
43498        'sftp.scoreboard' => 1,
43499        'sftp.scoreboard.lck' => 1,
43500      };
43501
43502      my $ok = 1;
43503      my $mismatch;
43504
43505      my $seen = [];
43506      foreach my $name (keys(%$res)) {
43507        push(@$seen, $name);
43508
43509        unless (defined($expected->{$name})) {
43510          $mismatch = $name;
43511          $ok = 0;
43512          last;
43513        }
43514      }
43515
43516      unless ($ok) {
43517        die("Unexpected name '$mismatch' appeared in READDIR data")
43518      }
43519
43520      # Now remove from $expected all of the paths we saw; if there are
43521      # any entries remaining in $expected, something went wrong.
43522      foreach my $name (@$seen) {
43523        delete($expected->{$name});
43524      }
43525
43526      my $remaining = scalar(keys(%$expected));
43527      $self->assert(0 == $remaining,
43528        test_msg("Expected 0, got $remaining"));
43529    };
43530
43531    if ($@) {
43532      $ex = $@;
43533    }
43534
43535    $wfh->print("done\n");
43536    $wfh->flush();
43537
43538  } else {
43539    eval { server_wait($config_file, $rfh) };
43540    if ($@) {
43541      warn($@);
43542      exit 1;
43543    }
43544
43545    exit 0;
43546  }
43547
43548  # Stop server
43549  server_stop($pid_file);
43550
43551  $self->assert_child_ok($pid);
43552
43553  if ($ex) {
43554    test_append_logfile($log_file, $ex);
43555    unlink($log_file);
43556
43557    die($ex);
43558  }
43559
43560  unlink($log_file);
43561}
43562
43563sub sftp_config_limit_readlink_bug3753 {
43564  my $self = shift;
43565  my $tmpdir = $self->{tmpdir};
43566
43567  my $config_file = "$tmpdir/sftp.conf";
43568  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
43569  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
43570
43571  my $log_file = test_get_logfile();
43572
43573  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
43574  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
43575
43576  my $user = 'proftpd';
43577  my $passwd = 'test';
43578  my $group = 'ftpd';
43579  my $home_dir = File::Spec->rel2abs($tmpdir);
43580  my $uid = 500;
43581  my $gid = 500;
43582
43583  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
43584  if (open(my $fh, "> $test_file")) {
43585    print $fh "ABCD" x 8192;
43586
43587    unless (close($fh)) {
43588      die("Can't write $test_file: $!");
43589    }
43590
43591  } else {
43592    die("Can't open $test_file: $!");
43593  }
43594
43595  my $test_symlink = File::Spec->rel2abs("$tmpdir/test.lnk");
43596  unless (symlink($test_file, $test_symlink)) {
43597    die("Can't symlink $test_symlink to $test_file: $!");
43598  }
43599
43600  # Make sure that, if we're running as root, that the home directory has
43601  # permissions/privs set for the account we create
43602  if ($< == 0) {
43603    unless (chmod(0755, $home_dir)) {
43604      die("Can't set perms on $home_dir to 0755: $!");
43605    }
43606
43607    unless (chown($uid, $gid, $home_dir)) {
43608      die("Can't set owner of $home_dir to $uid/$gid: $!");
43609    }
43610  }
43611
43612  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
43613    '/bin/bash');
43614  auth_group_write($auth_group_file, $group, $gid, $user);
43615
43616  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
43617  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
43618
43619  my $config = {
43620    PidFile => $pid_file,
43621    ScoreboardFile => $scoreboard_file,
43622    SystemLog => $log_file,
43623    TraceLog => $log_file,
43624    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
43625
43626    AuthUserFile => $auth_user_file,
43627    AuthGroupFile => $auth_group_file,
43628
43629    IfModules => {
43630      'mod_delay.c' => {
43631        DelayEngine => 'off',
43632      },
43633
43634      'mod_sftp.c' => [
43635        "SFTPEngine on",
43636        "SFTPLog $log_file",
43637        "SFTPHostKey $rsa_host_key",
43638        "SFTPHostKey $dsa_host_key",
43639      ],
43640    },
43641  };
43642
43643  my ($port, $config_user, $config_group) = config_write($config_file, $config);
43644  if (open(my $fh, ">> $config_file")) {
43645    print $fh <<EOC;
43646<Limit ALL>
43647  DenyAll
43648</Limit>
43649
43650<Limit READLINK>
43651  AllowAll
43652</Limit>
43653EOC
43654    unless (close($fh)) {
43655      die("Can't write $config_file: $!");
43656    }
43657
43658  } else {
43659    die("Can't open $config_file: $!");
43660  }
43661
43662  # Open pipes, for use between the parent and child processes.  Specifically,
43663  # the child will indicate when it's done with its test by writing a message
43664  # to the parent.
43665  my ($rfh, $wfh);
43666  unless (pipe($rfh, $wfh)) {
43667    die("Can't open pipe: $!");
43668  }
43669
43670  require Net::SSH2;
43671
43672  my $ex;
43673
43674  # Fork child
43675  $self->handle_sigchld();
43676  defined(my $pid = fork()) or die("Can't fork: $!");
43677  if ($pid) {
43678    eval {
43679      my $ssh2 = Net::SSH2->new();
43680
43681      sleep(1);
43682
43683      unless ($ssh2->connect('127.0.0.1', $port)) {
43684        my ($err_code, $err_name, $err_str) = $ssh2->error();
43685        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
43686      }
43687
43688      unless ($ssh2->auth_password($user, $passwd)) {
43689        my ($err_code, $err_name, $err_str) = $ssh2->error();
43690        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
43691      }
43692
43693      my $sftp = $ssh2->sftp();
43694      unless ($sftp) {
43695        my ($err_code, $err_name, $err_str) = $ssh2->error();
43696        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
43697      }
43698
43699      my $path = $sftp->readlink('test.lnk');
43700      unless ($path) {
43701        my ($err_code, $err_name) = $sftp->error();
43702        die("Can't readlink test.lnk: [$err_name] ($err_code)");
43703      }
43704
43705      $sftp = undef;
43706      $ssh2->disconnect();
43707
43708      $self->assert($test_file eq $path,
43709        test_msg("Expected '$test_file', got '$path'"));
43710    };
43711
43712    if ($@) {
43713      $ex = $@;
43714    }
43715
43716    $wfh->print("done\n");
43717    $wfh->flush();
43718
43719  } else {
43720    eval { server_wait($config_file, $rfh) };
43721    if ($@) {
43722      warn($@);
43723      exit 1;
43724    }
43725
43726    exit 0;
43727  }
43728
43729  # Stop server
43730  server_stop($pid_file);
43731
43732  $self->assert_child_ok($pid);
43733
43734  if ($ex) {
43735    test_append_logfile($log_file, $ex);
43736    unlink($log_file);
43737
43738    die($ex);
43739  }
43740
43741  unlink($log_file);
43742}
43743
43744sub sftp_config_limit_remove_bug3753 {
43745  my $self = shift;
43746  my $tmpdir = $self->{tmpdir};
43747
43748  my $config_file = "$tmpdir/sftp.conf";
43749  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
43750  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
43751
43752  my $log_file = test_get_logfile();
43753
43754  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
43755  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
43756
43757  my $user = 'proftpd';
43758  my $passwd = 'test';
43759  my $group = 'ftpd';
43760  my $home_dir = File::Spec->rel2abs($tmpdir);
43761  my $uid = 500;
43762  my $gid = 500;
43763
43764  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
43765  if (open(my $fh, "> $test_file")) {
43766    print $fh "ABCD" x 8192;
43767
43768    unless (close($fh)) {
43769      die("Can't write $test_file: $!");
43770    }
43771
43772  } else {
43773    die("Can't open $test_file: $!");
43774  }
43775
43776  # Make sure that, if we're running as root, that the home directory has
43777  # permissions/privs set for the account we create
43778  if ($< == 0) {
43779    unless (chmod(0755, $home_dir)) {
43780      die("Can't set perms on $home_dir to 0755: $!");
43781    }
43782
43783    unless (chown($uid, $gid, $home_dir)) {
43784      die("Can't set owner of $home_dir to $uid/$gid: $!");
43785    }
43786  }
43787
43788  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
43789    '/bin/bash');
43790  auth_group_write($auth_group_file, $group, $gid, $user);
43791
43792  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
43793  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
43794
43795  my $config = {
43796    PidFile => $pid_file,
43797    ScoreboardFile => $scoreboard_file,
43798    SystemLog => $log_file,
43799    TraceLog => $log_file,
43800    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
43801
43802    AuthUserFile => $auth_user_file,
43803    AuthGroupFile => $auth_group_file,
43804
43805    IfModules => {
43806      'mod_delay.c' => {
43807        DelayEngine => 'off',
43808      },
43809
43810      'mod_sftp.c' => [
43811        "SFTPEngine on",
43812        "SFTPLog $log_file",
43813        "SFTPHostKey $rsa_host_key",
43814        "SFTPHostKey $dsa_host_key",
43815      ],
43816    },
43817  };
43818
43819  my ($port, $config_user, $config_group) = config_write($config_file, $config);
43820  if (open(my $fh, ">> $config_file")) {
43821    print $fh <<EOC;
43822<Limit ALL>
43823  DenyAll
43824</Limit>
43825
43826<Limit DELE>
43827  AllowAll
43828</Limit>
43829EOC
43830    unless (close($fh)) {
43831      die("Can't write $config_file: $!");
43832    }
43833
43834  } else {
43835    die("Can't open $config_file: $!");
43836  }
43837
43838  # Open pipes, for use between the parent and child processes.  Specifically,
43839  # the child will indicate when it's done with its test by writing a message
43840  # to the parent.
43841  my ($rfh, $wfh);
43842  unless (pipe($rfh, $wfh)) {
43843    die("Can't open pipe: $!");
43844  }
43845
43846  require Net::SSH2;
43847
43848  my $ex;
43849
43850  # Fork child
43851  $self->handle_sigchld();
43852  defined(my $pid = fork()) or die("Can't fork: $!");
43853  if ($pid) {
43854    eval {
43855      my $ssh2 = Net::SSH2->new();
43856
43857      sleep(1);
43858
43859      unless ($ssh2->connect('127.0.0.1', $port)) {
43860        my ($err_code, $err_name, $err_str) = $ssh2->error();
43861        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
43862      }
43863
43864      unless ($ssh2->auth_password($user, $passwd)) {
43865        my ($err_code, $err_name, $err_str) = $ssh2->error();
43866        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
43867      }
43868
43869      my $sftp = $ssh2->sftp();
43870      unless ($sftp) {
43871        my ($err_code, $err_name, $err_str) = $ssh2->error();
43872        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
43873      }
43874
43875      my $file = 'test.txt';
43876      my $res = $sftp->unlink($file);
43877      unless ($res) {
43878        my ($err_code, $err_name) = $sftp->error();
43879        die("Can't remove $file: [$err_name] ($err_code)");
43880      }
43881
43882      $sftp = undef;
43883      $ssh2->disconnect();
43884
43885      if (-f $test_file) {
43886        die("$test_file file exists unexpectedly");
43887      }
43888    };
43889
43890    if ($@) {
43891      $ex = $@;
43892    }
43893
43894    $wfh->print("done\n");
43895    $wfh->flush();
43896
43897  } else {
43898    eval { server_wait($config_file, $rfh) };
43899    if ($@) {
43900      warn($@);
43901      exit 1;
43902    }
43903
43904    exit 0;
43905  }
43906
43907  # Stop server
43908  server_stop($pid_file);
43909
43910  $self->assert_child_ok($pid);
43911
43912  if ($ex) {
43913    test_append_logfile($log_file, $ex);
43914    unlink($log_file);
43915
43916    die($ex);
43917  }
43918
43919  unlink($log_file);
43920}
43921
43922sub sftp_config_limit_rename_bug3753 {
43923  my $self = shift;
43924  my $tmpdir = $self->{tmpdir};
43925
43926  my $config_file = "$tmpdir/sftp.conf";
43927  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
43928  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
43929
43930  my $log_file = test_get_logfile();
43931
43932  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
43933  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
43934
43935  my $user = 'proftpd';
43936  my $passwd = 'test';
43937  my $group = 'ftpd';
43938  my $home_dir = File::Spec->rel2abs($tmpdir);
43939  my $uid = 500;
43940  my $gid = 500;
43941
43942  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
43943  if (open(my $fh, "> $test_file")) {
43944    print $fh "ABCD" x 8192;
43945
43946    unless (close($fh)) {
43947      die("Can't write $test_file: $!");
43948    }
43949
43950  } else {
43951    die("Can't open $test_file: $!");
43952  }
43953
43954  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
43955
43956  # Make sure that, if we're running as root, that the home directory has
43957  # permissions/privs set for the account we create
43958  if ($< == 0) {
43959    unless (chmod(0755, $home_dir)) {
43960      die("Can't set perms on $home_dir to 0755: $!");
43961    }
43962
43963    unless (chown($uid, $gid, $home_dir)) {
43964      die("Can't set owner of $home_dir to $uid/$gid: $!");
43965    }
43966  }
43967
43968  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
43969    '/bin/bash');
43970  auth_group_write($auth_group_file, $group, $gid, $user);
43971
43972  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
43973  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
43974
43975  my $config = {
43976    PidFile => $pid_file,
43977    ScoreboardFile => $scoreboard_file,
43978    SystemLog => $log_file,
43979    TraceLog => $log_file,
43980    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
43981
43982    AuthUserFile => $auth_user_file,
43983    AuthGroupFile => $auth_group_file,
43984
43985    IfModules => {
43986      'mod_delay.c' => {
43987        DelayEngine => 'off',
43988      },
43989
43990      'mod_sftp.c' => [
43991        "SFTPEngine on",
43992        "SFTPLog $log_file",
43993        "SFTPHostKey $rsa_host_key",
43994        "SFTPHostKey $dsa_host_key",
43995      ],
43996    },
43997  };
43998
43999  my ($port, $config_user, $config_group) = config_write($config_file, $config);
44000  if (open(my $fh, ">> $config_file")) {
44001    print $fh <<EOC;
44002<Limit ALL>
44003  DenyAll
44004</Limit>
44005
44006<Limit RNFR RNTO>
44007  AllowAll
44008</Limit>
44009EOC
44010    unless (close($fh)) {
44011      die("Can't write $config_file: $!");
44012    }
44013
44014  } else {
44015    die("Can't open $config_file: $!");
44016  }
44017
44018  # Open pipes, for use between the parent and child processes.  Specifically,
44019  # the child will indicate when it's done with its test by writing a message
44020  # to the parent.
44021  my ($rfh, $wfh);
44022  unless (pipe($rfh, $wfh)) {
44023    die("Can't open pipe: $!");
44024  }
44025
44026  require Net::SSH2;
44027
44028  my $ex;
44029
44030  # Fork child
44031  $self->handle_sigchld();
44032  defined(my $pid = fork()) or die("Can't fork: $!");
44033  if ($pid) {
44034    eval {
44035      my $ssh2 = Net::SSH2->new();
44036
44037      sleep(1);
44038
44039      unless ($ssh2->connect('127.0.0.1', $port)) {
44040        my ($err_code, $err_name, $err_str) = $ssh2->error();
44041        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44042      }
44043
44044      unless ($ssh2->auth_password($user, $passwd)) {
44045        my ($err_code, $err_name, $err_str) = $ssh2->error();
44046        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44047      }
44048
44049      my $sftp = $ssh2->sftp();
44050      unless ($sftp) {
44051        my ($err_code, $err_name, $err_str) = $ssh2->error();
44052        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
44053      }
44054
44055      my $res = $sftp->rename('test.txt', 'test2.txt');
44056      unless ($res) {
44057        my ($err_code, $err_name) = $sftp->error();
44058        die("Can't rename test.txt to test2.txt: [$err_name] ($err_code)");
44059      }
44060
44061      $sftp = undef;
44062      $ssh2->disconnect();
44063
44064      if (-f $test_file) {
44065        die("$test_file file exists unexpectedly");
44066      }
44067
44068      unless (-f $test_file2) {
44069        die("$test_file2 file does not exist as expected");
44070      }
44071    };
44072
44073    if ($@) {
44074      $ex = $@;
44075    }
44076
44077    $wfh->print("done\n");
44078    $wfh->flush();
44079
44080  } else {
44081    eval { server_wait($config_file, $rfh) };
44082    if ($@) {
44083      warn($@);
44084      exit 1;
44085    }
44086
44087    exit 0;
44088  }
44089
44090  # Stop server
44091  server_stop($pid_file);
44092
44093  $self->assert_child_ok($pid);
44094
44095  if ($ex) {
44096    test_append_logfile($log_file, $ex);
44097    unlink($log_file);
44098
44099    die($ex);
44100  }
44101
44102  unlink($log_file);
44103}
44104
44105sub sftp_config_limit_rmdir_bug3753 {
44106  my $self = shift;
44107  my $tmpdir = $self->{tmpdir};
44108
44109  my $config_file = "$tmpdir/sftp.conf";
44110  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
44111  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
44112
44113  my $log_file = test_get_logfile();
44114
44115  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
44116  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
44117
44118  my $user = 'proftpd';
44119  my $passwd = 'test';
44120  my $group = 'ftpd';
44121  my $home_dir = File::Spec->rel2abs($tmpdir);
44122  my $uid = 500;
44123  my $gid = 500;
44124
44125  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
44126  mkpath($test_dir);
44127
44128  # Make sure that, if we're running as root, that the home directory has
44129  # permissions/privs set for the account we create
44130  if ($< == 0) {
44131    unless (chmod(0755, $home_dir)) {
44132      die("Can't set perms on $home_dir to 0755: $!");
44133    }
44134
44135    unless (chown($uid, $gid, $home_dir)) {
44136      die("Can't set owner of $home_dir to $uid/$gid: $!");
44137    }
44138  }
44139
44140  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
44141    '/bin/bash');
44142  auth_group_write($auth_group_file, $group, $gid, $user);
44143
44144  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
44145  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
44146
44147  my $config = {
44148    PidFile => $pid_file,
44149    ScoreboardFile => $scoreboard_file,
44150    SystemLog => $log_file,
44151    TraceLog => $log_file,
44152    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
44153
44154    AuthUserFile => $auth_user_file,
44155    AuthGroupFile => $auth_group_file,
44156
44157    IfModules => {
44158      'mod_delay.c' => {
44159        DelayEngine => 'off',
44160      },
44161
44162      'mod_sftp.c' => [
44163        "SFTPEngine on",
44164        "SFTPLog $log_file",
44165        "SFTPHostKey $rsa_host_key",
44166        "SFTPHostKey $dsa_host_key",
44167      ],
44168    },
44169  };
44170
44171  my ($port, $config_user, $config_group) = config_write($config_file, $config);
44172  if (open(my $fh, ">> $config_file")) {
44173    print $fh <<EOC;
44174<Limit ALL>
44175  DenyAll
44176</Limit>
44177
44178<Limit RMD>
44179  AllowAll
44180</Limit>
44181EOC
44182    unless (close($fh)) {
44183      die("Can't write $config_file: $!");
44184    }
44185
44186  } else {
44187    die("Can't open $config_file: $!");
44188  }
44189
44190  # Open pipes, for use between the parent and child processes.  Specifically,
44191  # the child will indicate when it's done with its test by writing a message
44192  # to the parent.
44193  my ($rfh, $wfh);
44194  unless (pipe($rfh, $wfh)) {
44195    die("Can't open pipe: $!");
44196  }
44197
44198  require Net::SSH2;
44199
44200  my $ex;
44201
44202  # Fork child
44203  $self->handle_sigchld();
44204  defined(my $pid = fork()) or die("Can't fork: $!");
44205  if ($pid) {
44206    eval {
44207      my $ssh2 = Net::SSH2->new();
44208
44209      sleep(1);
44210
44211      unless ($ssh2->connect('127.0.0.1', $port)) {
44212        my ($err_code, $err_name, $err_str) = $ssh2->error();
44213        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44214      }
44215
44216      unless ($ssh2->auth_password($user, $passwd)) {
44217        my ($err_code, $err_name, $err_str) = $ssh2->error();
44218        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44219      }
44220
44221      my $sftp = $ssh2->sftp();
44222      unless ($sftp) {
44223        my ($err_code, $err_name, $err_str) = $ssh2->error();
44224        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
44225      }
44226
44227      my $res = $sftp->rmdir('testdir');
44228      unless ($res) {
44229        my ($err_code, $err_name) = $sftp->error();
44230        die("Can't rmdir testdir: [$err_name] ($err_code)");
44231      }
44232
44233      $sftp = undef;
44234      $ssh2->disconnect();
44235
44236      if (-d $test_dir) {
44237        die("$test_dir directory exists unexpectedly");
44238      }
44239    };
44240
44241    if ($@) {
44242      $ex = $@;
44243    }
44244
44245    $wfh->print("done\n");
44246    $wfh->flush();
44247
44248  } else {
44249    eval { server_wait($config_file, $rfh) };
44250    if ($@) {
44251      warn($@);
44252      exit 1;
44253    }
44254
44255    exit 0;
44256  }
44257
44258  # Stop server
44259  server_stop($pid_file);
44260
44261  $self->assert_child_ok($pid);
44262
44263  if ($ex) {
44264    test_append_logfile($log_file, $ex);
44265    unlink($log_file);
44266
44267    die($ex);
44268  }
44269
44270  unlink($log_file);
44271}
44272
44273sub sftp_config_maxclientsperuser_issue750 {
44274  my $self = shift;
44275  my $tmpdir = $self->{tmpdir};
44276  my $setup = test_setup($tmpdir, 'sftp');
44277
44278  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
44279  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
44280
44281  my $config = {
44282    PidFile => $setup->{pid_file},
44283    ScoreboardFile => $setup->{scoreboard_file},
44284    SystemLog => $setup->{log_file},
44285    TraceLog => $setup->{log_file},
44286    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
44287
44288    AuthUserFile => $setup->{auth_user_file},
44289    AuthGroupFile => $setup->{auth_group_file},
44290    MaxClientsPerUser => 1,
44291
44292    IfModules => {
44293      'mod_delay.c' => {
44294        DelayEngine => 'off',
44295      },
44296
44297      'mod_sftp.c' => [
44298        "SFTPEngine on",
44299        "SFTPLog $setup->{log_file}",
44300        "SFTPHostKey $rsa_host_key",
44301        "SFTPHostKey $dsa_host_key",
44302      ],
44303    },
44304  };
44305
44306  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
44307    $config);
44308
44309  # Open pipes, for use between the parent and child processes.  Specifically,
44310  # the child will indicate when it's done with its test by writing a message
44311  # to the parent.
44312  my ($rfh, $wfh);
44313  unless (pipe($rfh, $wfh)) {
44314    die("Can't open pipe: $!");
44315  }
44316
44317  require Net::SSH2;
44318
44319  my $ex;
44320
44321  # Fork child
44322  $self->handle_sigchld();
44323  defined(my $pid = fork()) or die("Can't fork: $!");
44324  if ($pid) {
44325    eval {
44326      my $first_ssh2 = Net::SSH2->new();
44327      my $second_ssh2 = Net::SSH2->new();
44328
44329      sleep(1);
44330
44331      # First, we'll try to login with normal user/password; this should
44332      # succeed.
44333      unless ($first_ssh2->connect('127.0.0.1', $port)) {
44334        my ($err_code, $err_name, $err_str) = $first_ssh2->error();
44335        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44336      }
44337
44338      unless ($first_ssh2->auth_password($setup->{user}, $setup->{passwd})) {
44339        my ($err_code, $err_name, $err_str) = $first_ssh2->error();
44340        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44341      }
44342
44343      my $first_sftp = $first_ssh2->sftp();
44344      unless ($first_sftp) {
44345        my ($err_code, $err_name, $err_str) = $first_ssh2->error();
44346        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
44347      }
44348
44349      # Then we'll try to login again with the same user; this should fail.
44350      unless ($second_ssh2->connect('127.0.0.1', $port)) {
44351        my ($err_code, $err_name, $err_str) = $second_ssh2->error();
44352        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44353      }
44354
44355      unless ($second_ssh2->auth_password($setup->{user}, $setup->{passwd})) {
44356        my ($err_code, $err_name, $err_str) = $second_ssh2->error();
44357        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44358      }
44359
44360      # MaxClientsPerUser et al are enforced _after_ authentication, thus we
44361      # need to interact a little more, to ensure that we have been
44362      # disconnected.
44363      my $second_sftp = $second_ssh2->sftp();
44364      if ($second_sftp) {
44365        die("Second login succeeded unexpectedly");
44366      }
44367
44368      $second_ssh2->disconnect();
44369      $second_ssh2 = undef;
44370
44371      $first_sftp = undef;
44372      $first_ssh2->disconnect();
44373      $first_ssh2 = undef;
44374    };
44375    if ($@) {
44376      $ex = $@;
44377    }
44378
44379    $wfh->print("done\n");
44380    $wfh->flush();
44381
44382  } else {
44383    eval { server_wait($setup->{config_file}, $rfh) };
44384    if ($@) {
44385      warn($@);
44386      exit 1;
44387    }
44388
44389    exit 0;
44390  }
44391
44392  # Stop server
44393  server_stop($setup->{pid_file});
44394  $self->assert_child_ok($pid);
44395
44396  test_cleanup($setup->{log_file}, $ex);
44397}
44398
44399sub sftp_multi_channels {
44400  my $self = shift;
44401  my $tmpdir = $self->{tmpdir};
44402
44403  my $config_file = "$tmpdir/sftp.conf";
44404  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
44405  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
44406
44407  my $log_file = test_get_logfile();
44408
44409  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
44410  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
44411
44412  my $user = 'proftpd';
44413  my $passwd = 'test';
44414  my $group = 'ftpd';
44415  my $home_dir = File::Spec->rel2abs($tmpdir);
44416  my $uid = 500;
44417  my $gid = 500;
44418
44419  # Make sure that, if we're running as root, that the home directory has
44420  # permissions/privs set for the account we create
44421  if ($< == 0) {
44422    unless (chmod(0755, $home_dir)) {
44423      die("Can't set perms on $home_dir to 0755: $!");
44424    }
44425
44426    unless (chown($uid, $gid, $home_dir)) {
44427      die("Can't set owner of $home_dir to $uid/$gid: $!");
44428    }
44429  }
44430
44431  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
44432    '/bin/bash');
44433  auth_group_write($auth_group_file, $group, $gid, $user);
44434
44435  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
44436  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
44437
44438  my $config = {
44439    PidFile => $pid_file,
44440    ScoreboardFile => $scoreboard_file,
44441    SystemLog => $log_file,
44442    TraceLog => $log_file,
44443    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
44444
44445    AuthUserFile => $auth_user_file,
44446    AuthGroupFile => $auth_group_file,
44447
44448    IfModules => {
44449      'mod_delay.c' => {
44450        DelayEngine => 'off',
44451      },
44452
44453      'mod_sftp.c' => [
44454        "SFTPEngine on",
44455        "SFTPLog $log_file",
44456        "SFTPHostKey $rsa_host_key",
44457        "SFTPHostKey $dsa_host_key",
44458      ],
44459    },
44460  };
44461
44462  my ($port, $config_user, $config_group) = config_write($config_file, $config);
44463
44464  # Open pipes, for use between the parent and child processes.  Specifically,
44465  # the child will indicate when it's done with its test by writing a message
44466  # to the parent.
44467  my ($rfh, $wfh);
44468  unless (pipe($rfh, $wfh)) {
44469    die("Can't open pipe: $!");
44470  }
44471
44472  require Net::SSH2;
44473
44474  my $ex;
44475
44476  # Fork child
44477  $self->handle_sigchld();
44478  defined(my $pid = fork()) or die("Can't fork: $!");
44479  if ($pid) {
44480    eval {
44481      my $ssh2 = Net::SSH2->new();
44482
44483      sleep(1);
44484
44485      unless ($ssh2->connect('127.0.0.1', $port)) {
44486        my ($err_code, $err_name, $err_str) = $ssh2->error();
44487        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44488      }
44489
44490      unless ($ssh2->auth_password($user, $passwd)) {
44491        my ($err_code, $err_name, $err_str) = $ssh2->error();
44492        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44493      }
44494
44495      # Open three different 'sftp' sessions, and make sure they all
44496      # work as expected.
44497
44498      my $sftps = [];
44499
44500      for (my $i = 0; $i < 3; $i++) {
44501        my $sftp = $ssh2->sftp();
44502        unless ($sftp) {
44503          my ($err_code, $err_name, $err_str) = $ssh2->error();
44504          die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
44505        }
44506
44507        push(@$sftps, $sftp);
44508      }
44509
44510      for (my $i = 0; $i < scalar(@$sftps); $i++) {
44511        my $cwd = $sftps->[$i]->realpath('.');
44512        unless ($cwd) {
44513          my ($err_code, $err_name) = $sftps->[$i]->error();
44514          die("Can't get real path for '.': [$err_name] ($err_code)");
44515        }
44516
44517        my $expected;
44518
44519        $expected = $home_dir;
44520        if ($^O eq 'darwin') {
44521          # MacOSX-specific hack to deal with how it handles tmp files
44522          $expected = ('/private' . $expected);
44523        }
44524
44525        $self->assert($expected eq $cwd,
44526          test_msg("Expected '$expected', got '$cwd'"));
44527      }
44528
44529      for (my $i = 0; $i < scalar(@$sftps); $i++) {
44530        $sftps->[$i] = undef;
44531      }
44532
44533      $ssh2->disconnect();
44534    };
44535
44536    if ($@) {
44537      $ex = $@;
44538    }
44539
44540    $wfh->print("done\n");
44541    $wfh->flush();
44542
44543  } else {
44544    eval { server_wait($config_file, $rfh) };
44545    if ($@) {
44546      warn($@);
44547      exit 1;
44548    }
44549
44550    exit 0;
44551  }
44552
44553  # Stop server
44554  server_stop($pid_file);
44555
44556  $self->assert_child_ok($pid);
44557
44558  if ($ex) {
44559    test_append_logfile($log_file, $ex);
44560    unlink($log_file);
44561
44562    die($ex);
44563  }
44564
44565  unlink($log_file);
44566}
44567
44568sub sftp_config_insecure_hostkey_perms_bug4098 {
44569  my $self = shift;
44570  my $tmpdir = $self->{tmpdir};
44571  my $setup = test_setup($tmpdir, 'sftp');
44572
44573  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
44574  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
44575
44576  # Deliberately set insecure perms on the hostkeys
44577  unless (chmod(0444, $rsa_host_key, $dsa_host_key)) {
44578    die("Can't set perms on $rsa_host_key, $dsa_host_key: $!");
44579  }
44580
44581  my $config = {
44582    PidFile => $setup->{pid_file},
44583    ScoreboardFile => $setup->{scoreboard_file},
44584    SystemLog => $setup->{log_file},
44585    TraceLog => $setup->{log_file},
44586    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
44587
44588    AuthUserFile => $setup->{auth_user_file},
44589    AuthGroupFile => $setup->{auth_group_file},
44590
44591    IfModules => {
44592      'mod_delay.c' => {
44593        DelayEngine => 'off',
44594      },
44595
44596      'mod_sftp.c' => [
44597        "SFTPEngine on",
44598        "SFTPLog $setup->{log_file}",
44599        "SFTPOptions InsecureHostKeyPerms",
44600        "SFTPHostKey $rsa_host_key",
44601        "SFTPHostKey $dsa_host_key",
44602      ],
44603    },
44604  };
44605
44606  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
44607    $config);
44608
44609  my $ex;
44610
44611  # First, start the server.
44612  eval { server_start($setup->{config_file}, $setup->{pid_file}) };
44613  if ($@) {
44614    $ex = "Server failed to start up with world-readable SFTPHostKey";
44615
44616  } else {
44617    server_stop($setup->{pid_file});
44618  }
44619
44620  test_cleanup($setup->{log_file}, $ex);
44621}
44622
44623sub sftp_config_allow_empty_passwords_off_bug4309 {
44624  my $self = shift;
44625  my $tmpdir = $self->{tmpdir};
44626  my $setup = test_setup($tmpdir, 'sftp');
44627
44628  my $other_user = 'nopassword';
44629  my $other_passwd = '';
44630  my $other_uid = 1000;
44631  my $other_gid = 1000;
44632
44633  auth_user_write($setup->{auth_user_file}, $other_user, $other_passwd,
44634    $other_uid, $other_gid, $setup->{home_dir}, '/bin/bash');
44635  auth_group_write($setup->{auth_group_file}, $setup->{group}, $setup->{gid},
44636    $other_user);
44637
44638  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
44639  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
44640
44641  my $config = {
44642    PidFile => $setup->{pid_file},
44643    ScoreboardFile => $setup->{scoreboard_file},
44644    SystemLog => $setup->{log_file},
44645    TraceLog => $setup->{log_file},
44646    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
44647
44648    AuthUserFile => $setup->{auth_user_file},
44649    AuthGroupFile => $setup->{auth_group_file},
44650
44651    IfModules => {
44652      'mod_delay.c' => {
44653        DelayEngine => 'off',
44654      },
44655
44656      'mod_sftp.c' => [
44657        "SFTPEngine on",
44658        "SFTPLog $setup->{log_file}",
44659        "SFTPHostKey $rsa_host_key",
44660        "SFTPHostKey $dsa_host_key",
44661        "AllowEmptyPasswords off",
44662      ],
44663    },
44664  };
44665
44666  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
44667    $config);
44668
44669  # Open pipes, for use between the parent and child processes.  Specifically,
44670  # the child will indicate when it's done with its test by writing a message
44671  # to the parent.
44672  my ($rfh, $wfh);
44673  unless (pipe($rfh, $wfh)) {
44674    die("Can't open pipe: $!");
44675  }
44676
44677  require Net::SSH2;
44678
44679  my $ex;
44680
44681  # Fork child
44682  $self->handle_sigchld();
44683  defined(my $pid = fork()) or die("Can't fork: $!");
44684  if ($pid) {
44685    eval {
44686      my $ssh2 = Net::SSH2->new();
44687
44688      sleep(1);
44689
44690      # First, we'll try to login with normal user/password; this should
44691      # succeed.
44692      unless ($ssh2->connect('127.0.0.1', $port)) {
44693        my ($err_code, $err_name, $err_str) = $ssh2->error();
44694        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44695      }
44696
44697      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
44698        my ($err_code, $err_name, $err_str) = $ssh2->error();
44699        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44700      }
44701
44702      my $sftp = $ssh2->sftp();
44703      unless ($sftp) {
44704        my ($err_code, $err_name, $err_str) = $ssh2->error();
44705        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
44706      }
44707
44708      $sftp = undef;
44709      $ssh2->disconnect();
44710      $ssh2 = undef;
44711
44712      # Then, we'll try to login with an empty password; this should fail.
44713
44714      $ssh2 = Net::SSH2->new();
44715      unless ($ssh2->connect('127.0.0.1', $port)) {
44716        my ($err_code, $err_name, $err_str) = $ssh2->error();
44717        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44718      }
44719
44720      if ($ssh2->auth_password($other_user, $other_passwd)) {
44721        die("Login with empty password succeeded unexpectedly");
44722      }
44723
44724      $ssh2->disconnect();
44725    };
44726    if ($@) {
44727      $ex = $@;
44728    }
44729
44730    $wfh->print("done\n");
44731    $wfh->flush();
44732
44733  } else {
44734    eval { server_wait($setup->{config_file}, $rfh) };
44735    if ($@) {
44736      warn($@);
44737      exit 1;
44738    }
44739
44740    exit 0;
44741  }
44742
44743  # Stop server
44744  server_stop($setup->{pid_file});
44745  $self->assert_child_ok($pid);
44746
44747  test_cleanup($setup->{log_file}, $ex);
44748}
44749
44750sub sftp_multi_channel_downloads {
44751  my $self = shift;
44752  my $tmpdir = $self->{tmpdir};
44753
44754  my $config_file = "$tmpdir/sftp.conf";
44755  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
44756  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
44757
44758  my $log_file = test_get_logfile();
44759
44760  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
44761  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
44762
44763  my $user = 'proftpd';
44764  my $passwd = 'test';
44765  my $group = 'ftpd';
44766  my $home_dir = File::Spec->rel2abs($tmpdir);
44767  my $uid = 500;
44768  my $gid = 500;
44769
44770  # Make sure that, if we're running as root, that the home directory has
44771  # permissions/privs set for the account we create
44772  if ($< == 0) {
44773    unless (chmod(0755, $home_dir)) {
44774      die("Can't set perms on $home_dir to 0755: $!");
44775    }
44776
44777    unless (chown($uid, $gid, $home_dir)) {
44778      die("Can't set owner of $home_dir to $uid/$gid: $!");
44779    }
44780  }
44781
44782  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
44783    '/bin/bash');
44784  auth_group_write($auth_group_file, $group, $gid, $user);
44785
44786  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
44787  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
44788
44789  my $config = {
44790    PidFile => $pid_file,
44791    ScoreboardFile => $scoreboard_file,
44792    SystemLog => $log_file,
44793    TraceLog => $log_file,
44794    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
44795
44796    AuthUserFile => $auth_user_file,
44797    AuthGroupFile => $auth_group_file,
44798
44799    IfModules => {
44800      'mod_delay.c' => {
44801        DelayEngine => 'off',
44802      },
44803
44804      'mod_sftp.c' => [
44805        "SFTPEngine on",
44806        "SFTPLog $log_file",
44807        "SFTPHostKey $rsa_host_key",
44808        "SFTPHostKey $dsa_host_key",
44809      ],
44810    },
44811  };
44812
44813  my $test_file1 = File::Spec->rel2abs("$tmpdir/test1.txt");
44814  if (open(my $fh, "> $test_file1")) {
44815    print $fh "ABCD" x 8192;
44816    unless (close($fh)) {
44817      die("Can't write $test_file1: $!");
44818    }
44819
44820  } else {
44821    die("Can't open $test_file1: $!");
44822  }
44823
44824  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
44825  if (open(my $fh, "> $test_file2")) {
44826    print $fh "KLMN" x 8192;
44827    unless (close($fh)) {
44828      die("Can't write $test_file2: $!");
44829    }
44830
44831  } else {
44832    die("Can't open $test_file2: $!");
44833  }
44834
44835  my $test_file3 = File::Spec->rel2abs("$tmpdir/test3.txt");
44836  if (open(my $fh, "> $test_file3")) {
44837    print $fh "UVWX" x 8192;
44838    unless (close($fh)) {
44839      die("Can't write $test_file3: $!");
44840    }
44841
44842  } else {
44843    die("Can't open $test_file3: $!");
44844  }
44845
44846  my ($port, $config_user, $config_group) = config_write($config_file, $config);
44847
44848  # Open pipes, for use between the parent and child processes.  Specifically,
44849  # the child will indicate when it's done with its test by writing a message
44850  # to the parent.
44851  my ($rfh, $wfh);
44852  unless (pipe($rfh, $wfh)) {
44853    die("Can't open pipe: $!");
44854  }
44855
44856  require Net::SSH2;
44857
44858  my $ex;
44859
44860  # Fork child
44861  $self->handle_sigchld();
44862  defined(my $pid = fork()) or die("Can't fork: $!");
44863  if ($pid) {
44864    eval {
44865      my $ssh2 = Net::SSH2->new();
44866
44867      sleep(1);
44868
44869      unless ($ssh2->connect('127.0.0.1', $port)) {
44870        my ($err_code, $err_name, $err_str) = $ssh2->error();
44871        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
44872      }
44873
44874      unless ($ssh2->auth_password($user, $passwd)) {
44875        my ($err_code, $err_name, $err_str) = $ssh2->error();
44876        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
44877      }
44878
44879      # Open three different 'sftp' sessions, and make sure they all
44880      # work as expected.
44881
44882      my $sftps = [];
44883      my $fhs = [];
44884      my $md5s = [];
44885
44886      for (my $i = 0; $i < 3; $i++) {
44887        my $sftp = $ssh2->sftp();
44888        unless ($sftp) {
44889          my ($err_code, $err_name, $err_str) = $ssh2->error();
44890          die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
44891        }
44892
44893        push(@$sftps, $sftp);
44894      }
44895
44896      for (my $i = 0; $i < scalar(@$sftps); $i++) {
44897        my $path = "test" . ($i + 1) . ".txt";
44898
44899        my $test_fh = $sftps->[$i]->open($path, O_RDONLY);
44900        unless ($test_fh) {
44901          my ($err_code, $err_name) = $sftps->[$i]->error();
44902          die("Can't open $path: [$err_name] ($err_code)");
44903        }
44904
44905        my $ctx = Digest::MD5->new();
44906
44907        # my $read_len = 65535;
44908        my $read_len = 32768;
44909        my $buf;
44910
44911        my $res = $test_fh->read($buf, $read_len);
44912        unless ($res) {
44913          my ($err_code, $err_name) = $sftps->[$i]->error();
44914          if ($err_code != 0) {
44915            die("Can't read $path: [$err_name] ($err_code)");
44916          } else {
44917            my $err_str;
44918            ($err_code, $err_name, $err_str) = $ssh2->error();
44919            die("SSH2 error: [$err_name] ($err_code) $err_str");
44920          }
44921        }
44922
44923        while ($res) {
44924          $ctx->add($buf);
44925          unless ($test_fh->seek($res)) {
44926            die("Can't seek to offset $res on $path handle: $!");
44927          }
44928
44929          $res = $test_fh->read($buf, $read_len);
44930        }
44931
44932        push(@$md5s, $ctx->hexdigest());
44933
44934        push(@$fhs, $test_fh);
44935      }
44936
44937      for (my $i = 0; $i < scalar(@$fhs); $i++) {
44938        $fhs->[$i] = undef;
44939      }
44940
44941      for (my $i = 0; $i < scalar(@$sftps); $i++) {
44942        $sftps->[$i] = undef;
44943      }
44944
44945      $ssh2->disconnect();
44946
44947      my $expected;
44948
44949      $expected = '6e816b2d373a619a29d1706ac6be1db0';
44950      $self->assert($expected eq $md5s->[0],
44951        test_msg("Expected '$expected', got '$md5s->[0]'"));
44952
44953      $expected = 'b96129f1efce8f38324adf1a9d1e889c';
44954      $self->assert($expected eq $md5s->[1],
44955        test_msg("Expected '$expected', got '$md5s->[1]'"));
44956
44957      $expected = 'b6df9d6dccce294918a51ac7deabfd96';
44958      $self->assert($expected eq $md5s->[2],
44959        test_msg("Expected '$expected', got '$md5s->[2]'"));
44960    };
44961
44962    if ($@) {
44963      $ex = $@;
44964    }
44965
44966    $wfh->print("done\n");
44967    $wfh->flush();
44968
44969  } else {
44970    eval { server_wait($config_file, $rfh, 30) };
44971    if ($@) {
44972      warn($@);
44973      exit 1;
44974    }
44975
44976    exit 0;
44977  }
44978
44979  # Stop server
44980  server_stop($pid_file);
44981
44982  $self->assert_child_ok($pid);
44983
44984  if ($ex) {
44985    test_append_logfile($log_file, $ex);
44986    unlink($log_file);
44987
44988    die($ex);
44989  }
44990
44991  unlink($log_file);
44992}
44993
44994sub sftp_log_xferlog_download {
44995  my $self = shift;
44996  my $tmpdir = $self->{tmpdir};
44997
44998  my $config_file = "$tmpdir/sftp.conf";
44999  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
45000  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
45001  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
45002
45003  my $log_file = test_get_logfile();
45004
45005  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
45006  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
45007
45008  my $user = 'proftpd';
45009  my $passwd = 'test';
45010  my $group = 'ftpd';
45011  my $home_dir = File::Spec->rel2abs($tmpdir);
45012  my $uid = 500;
45013  my $gid = 500;
45014
45015  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
45016  if (open(my $fh, "> $test_file")) {
45017    print $fh "ABCD" x 256;
45018
45019    unless (close($fh)) {
45020      die("Can't write $test_file: $!");
45021    }
45022
45023  } else {
45024    die("Can't open $test_file: $!");
45025  }
45026
45027  my $test_sz = (stat($test_file))[7];
45028
45029  # Make sure that, if we're running as root, that the home directory has
45030  # permissions/privs set for the account we create
45031  if ($< == 0) {
45032    unless (chmod(0755, $home_dir)) {
45033      die("Can't set perms on $home_dir to 0755: $!");
45034    }
45035
45036    unless (chown($uid, $gid, $home_dir)) {
45037      die("Can't set owner of $home_dir to $uid/$gid: $!");
45038    }
45039  }
45040
45041  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
45042    '/bin/bash');
45043  auth_group_write($auth_group_file, $group, $gid, $user);
45044
45045  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
45046  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
45047
45048  my $config = {
45049    PidFile => $pid_file,
45050    ScoreboardFile => $scoreboard_file,
45051    SystemLog => $log_file,
45052    TraceLog => $log_file,
45053    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
45054
45055    AuthUserFile => $auth_user_file,
45056    AuthGroupFile => $auth_group_file,
45057
45058    TransferLog => $xferlog_file,
45059
45060    IfModules => {
45061      'mod_delay.c' => {
45062        DelayEngine => 'off',
45063      },
45064
45065      'mod_sftp.c' => [
45066        "SFTPEngine on",
45067        "SFTPLog $log_file",
45068        "SFTPHostKey $rsa_host_key",
45069        "SFTPHostKey $dsa_host_key",
45070      ],
45071    },
45072  };
45073
45074  my ($port, $config_user, $config_group) = config_write($config_file, $config);
45075
45076  # Open pipes, for use between the parent and child processes.  Specifically,
45077  # the child will indicate when it's done with its test by writing a message
45078  # to the parent.
45079  my ($rfh, $wfh);
45080  unless (pipe($rfh, $wfh)) {
45081    die("Can't open pipe: $!");
45082  }
45083
45084  require Net::SSH2;
45085
45086  my $ex;
45087
45088  # Ignore SIGPIPE
45089  local $SIG{PIPE} = sub { };
45090
45091  # Fork child
45092  $self->handle_sigchld();
45093  defined(my $pid = fork()) or die("Can't fork: $!");
45094  if ($pid) {
45095    eval {
45096      my $ssh2 = Net::SSH2->new();
45097
45098      sleep(1);
45099
45100      unless ($ssh2->connect('127.0.0.1', $port)) {
45101        my ($err_code, $err_name, $err_str) = $ssh2->error();
45102        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
45103      }
45104
45105      unless ($ssh2->auth_password($user, $passwd)) {
45106        my ($err_code, $err_name, $err_str) = $ssh2->error();
45107        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
45108      }
45109
45110      my $sftp = $ssh2->sftp();
45111      unless ($sftp) {
45112        my ($err_code, $err_name, $err_str) = $ssh2->error();
45113        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
45114      }
45115
45116      my $fh = $sftp->open('test.txt', O_RDONLY);
45117      unless ($fh) {
45118        my ($err_code, $err_name) = $sftp->error();
45119        die("Can't open test.txt: [$err_name] ($err_code)");
45120      }
45121
45122      my $buf;
45123      my $size = 0;
45124
45125      my $res = $fh->read($buf, 8192);
45126      while ($res) {
45127        $size += $res;
45128
45129        $res = $fh->read($buf, 8192);
45130      }
45131
45132      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
45133      $fh = undef;
45134
45135      # To close the SFTP channel, we have to explicitly destroy the object
45136      $sftp = undef;
45137
45138      $self->assert($test_sz == $size,
45139        test_msg("Expected $test_sz, got $size"));
45140
45141      $ssh2->disconnect();
45142    };
45143
45144    if ($@) {
45145      $ex = $@;
45146    }
45147
45148    $wfh->print("done\n");
45149    $wfh->flush();
45150
45151  } else {
45152    eval { server_wait($config_file, $rfh) };
45153    if ($@) {
45154      warn($@);
45155      exit 1;
45156    }
45157
45158    exit 0;
45159  }
45160
45161  # Stop server
45162  server_stop($pid_file);
45163
45164  $self->assert_child_ok($pid);
45165
45166  if ($ex) {
45167    test_append_logfile($log_file, $ex);
45168    unlink($log_file);
45169
45170    die($ex);
45171  }
45172
45173  if (open(my $fh, "< $xferlog_file")) {
45174    my $ok = 0;
45175
45176    while (my $line = <$fh>) {
45177      chomp($line);
45178
45179     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
45180        my $client_addr = $3;
45181        my $nbytes = $4;
45182        my $path = $5;
45183        my $xfer_type = $6;
45184        my $action_flag = $7;
45185        my $xfer_direction = $8;
45186        my $access_mode = $9;
45187        my $user_name = $10;
45188        my $service_name = $11;
45189        my $completion_status = $12;
45190
45191        my $expected;
45192
45193        $expected = '127.0.0.1';
45194        $self->assert($expected eq $client_addr,
45195          test_msg("Expected IP address '$expected', got '$client_addr'"));
45196
45197        $expected = $test_sz;
45198        $self->assert($expected == $nbytes,
45199          test_msg("Expected size $expected, got $nbytes"));
45200
45201        $expected = $test_file;
45202        if ($^O eq 'darwin') {
45203          # MacOSX-specific hack to deal with how it handles tmp files
45204          $expected = ('/private' . $expected);
45205        }
45206        $self->assert($expected eq $path,
45207          test_msg("Expected path '$expected', got '$path'"));
45208
45209        $expected = 'b';
45210        $self->assert($expected eq $xfer_type,
45211          test_msg("Expected transfer type '$expected', got '$xfer_type'"));
45212
45213        $expected = '_';
45214        $self->assert($expected eq $action_flag,
45215          test_msg("Expected action flag '$expected', got '$action_flag'"));
45216
45217        $expected = 'o';
45218        $self->assert($expected eq $xfer_direction,
45219          test_msg("Expected transfer direction '$expected', got '$xfer_direction'"));
45220
45221        $expected = 'r';
45222        $self->assert($expected eq $access_mode,
45223          test_msg("Expected access mode '$expected', got '$access_mode'"));
45224
45225        $expected = $user;
45226        $self->assert($expected eq $user_name,
45227          test_msg("Expected user '$expected', got '$user_name'"));
45228
45229        $expected = 'sftp';
45230        $self->assert($expected eq $service_name,
45231          test_msg("Expected service '$expected', got '$service_name'"));
45232
45233        $expected = 'c';
45234        $self->assert($expected eq $completion_status,
45235          test_msg("Expected completion status '$expected', got '$completion_status'"));
45236
45237        $ok = 1;
45238        last;
45239      }
45240    }
45241
45242    close($fh);
45243
45244    unless ($ok) {
45245      die("No lines found in $xferlog_file");
45246    }
45247
45248  } else {
45249    die("Can't read $xferlog_file: $!");
45250  }
45251
45252  unlink($log_file);
45253}
45254
45255sub sftp_log_xferlog_download_incomplete {
45256  my $self = shift;
45257  my $tmpdir = $self->{tmpdir};
45258
45259  my $config_file = "$tmpdir/sftp.conf";
45260  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
45261  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
45262  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
45263
45264  my $log_file = test_get_logfile();
45265
45266  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
45267  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
45268
45269  my $user = 'proftpd';
45270  my $passwd = 'test';
45271  my $group = 'ftpd';
45272  my $home_dir = File::Spec->rel2abs($tmpdir);
45273  my $uid = 500;
45274  my $gid = 500;
45275
45276  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
45277  if (open(my $fh, "> $test_file")) {
45278    print $fh "ABCD" x 256;
45279
45280    unless (close($fh)) {
45281      die("Can't write $test_file: $!");
45282    }
45283
45284  } else {
45285    die("Can't open $test_file: $!");
45286  }
45287
45288  my $read_sz = 32;
45289
45290  # Make sure that, if we're running as root, that the home directory has
45291  # permissions/privs set for the account we create
45292  if ($< == 0) {
45293    unless (chmod(0755, $home_dir)) {
45294      die("Can't set perms on $home_dir to 0755: $!");
45295    }
45296
45297    unless (chown($uid, $gid, $home_dir)) {
45298      die("Can't set owner of $home_dir to $uid/$gid: $!");
45299    }
45300  }
45301
45302  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
45303    '/bin/bash');
45304  auth_group_write($auth_group_file, $group, $gid, $user);
45305
45306  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
45307  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
45308
45309  my $config = {
45310    PidFile => $pid_file,
45311    ScoreboardFile => $scoreboard_file,
45312    SystemLog => $log_file,
45313    TraceLog => $log_file,
45314    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
45315
45316    AuthUserFile => $auth_user_file,
45317    AuthGroupFile => $auth_group_file,
45318    TransferLog => $xferlog_file,
45319
45320    IfModules => {
45321      'mod_delay.c' => {
45322        DelayEngine => 'off',
45323      },
45324
45325      'mod_sftp.c' => [
45326        "SFTPEngine on",
45327        "SFTPLog $log_file",
45328        "SFTPHostKey $rsa_host_key",
45329        "SFTPHostKey $dsa_host_key",
45330      ],
45331    },
45332  };
45333
45334  my ($port, $config_user, $config_group) = config_write($config_file, $config);
45335
45336  # Open pipes, for use between the parent and child processes.  Specifically,
45337  # the child will indicate when it's done with its test by writing a message
45338  # to the parent.
45339  my ($rfh, $wfh);
45340  unless (pipe($rfh, $wfh)) {
45341    die("Can't open pipe: $!");
45342  }
45343
45344  require Net::SSH2;
45345
45346  my $ex;
45347
45348  # Ignore SIGPIPE
45349  local $SIG{PIPE} = sub { };
45350
45351  # Fork child
45352  $self->handle_sigchld();
45353  defined(my $pid = fork()) or die("Can't fork: $!");
45354  if ($pid) {
45355    eval {
45356      my $ssh2 = Net::SSH2->new();
45357
45358      sleep(1);
45359
45360      unless ($ssh2->connect('127.0.0.1', $port)) {
45361        my ($err_code, $err_name, $err_str) = $ssh2->error();
45362        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
45363      }
45364
45365      unless ($ssh2->auth_password($user, $passwd)) {
45366        my ($err_code, $err_name, $err_str) = $ssh2->error();
45367        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
45368      }
45369
45370      my $sftp = $ssh2->sftp();
45371      unless ($sftp) {
45372        my ($err_code, $err_name, $err_str) = $ssh2->error();
45373        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
45374      }
45375
45376      my $fh = $sftp->open('test.txt', O_RDONLY);
45377      unless ($fh) {
45378        my ($err_code, $err_name) = $sftp->error();
45379        die("Can't open test.txt: [$err_name] ($err_code)");
45380      }
45381
45382      my $buf;
45383      my $res = $fh->read($buf, $read_sz);
45384      unless ($res) {
45385        my ($err_code, $err_name) = $sftp->error();
45386        die("Can't read test.txt: [$err_name] ($err_code)");
45387      }
45388
45389      sleep(1);
45390
45391      # Explicitly disconnect without closing the file, simulating an
45392      # aborted transfer.
45393      $ssh2->disconnect();
45394
45395      # Give a little time for the server to do its end-of-session thing.
45396      sleep(1);
45397    };
45398
45399    if ($@) {
45400      $ex = $@;
45401    }
45402
45403    $wfh->print("done\n");
45404    $wfh->flush();
45405
45406  } else {
45407    eval { server_wait($config_file, $rfh) };
45408    if ($@) {
45409      warn($@);
45410      exit 1;
45411    }
45412
45413    exit 0;
45414  }
45415
45416  # Stop server
45417  server_stop($pid_file);
45418
45419  $self->assert_child_ok($pid);
45420
45421  if ($ex) {
45422    test_append_logfile($log_file, $ex);
45423    unlink($log_file);
45424
45425    die($ex);
45426  }
45427
45428  if (open(my $fh, "< $xferlog_file")) {
45429    my $ok = 0;
45430
45431    while (my $line = <$fh>) {
45432      chomp($line);
45433
45434     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
45435        my $client_addr = $3;
45436        my $nbytes = $4;
45437        my $path = $5;
45438        my $xfer_type = $6;
45439        my $action_flag = $7;
45440        my $xfer_direction = $8;
45441        my $access_mode = $9;
45442        my $user_name = $10;
45443        my $service_name = $11;
45444        my $completion_status = $12;
45445
45446        my $expected;
45447
45448        $expected = '127.0.0.1';
45449        $self->assert($expected eq $client_addr,
45450          test_msg("Expected '$expected', got '$client_addr'"));
45451
45452        $expected = $read_sz;
45453        $self->assert($expected == $nbytes,
45454          test_msg("Expected $expected, got $nbytes"));
45455
45456        $expected = $test_file;
45457        $self->assert($expected eq $path,
45458          test_msg("Expected '$expected', got '$path'"));
45459
45460        $expected = 'b';
45461        $self->assert($expected eq $xfer_type,
45462          test_msg("Expected '$expected', got '$xfer_type'"));
45463
45464        $expected = '_';
45465        $self->assert($expected eq $action_flag,
45466          test_msg("Expected '$expected', got '$action_flag'"));
45467
45468        $expected = 'o';
45469        $self->assert($expected eq $xfer_direction,
45470          test_msg("Expected '$expected', got '$xfer_direction'"));
45471
45472        $expected = 'r';
45473        $self->assert($expected eq $access_mode,
45474          test_msg("Expected '$expected', got '$access_mode'"));
45475
45476        $expected = $user;
45477        $self->assert($expected eq $user_name,
45478          test_msg("Expected '$expected', got '$user_name'"));
45479
45480        $expected = 'sftp';
45481        $self->assert($expected eq $service_name,
45482          test_msg("Expected '$expected', got '$service_name'"));
45483
45484        $expected = 'i';
45485        $self->assert($expected eq $completion_status,
45486          test_msg("Expected '$expected', got '$completion_status'"));
45487
45488        $ok = 1;
45489        last;
45490      }
45491    }
45492
45493    close($fh);
45494
45495    unless ($ok) {
45496      die("No lines found in $xferlog_file");
45497    }
45498
45499  } else {
45500    die("Can't read $xferlog_file: $!");
45501  }
45502
45503  unlink($log_file);
45504}
45505
45506sub sftp_log_xferlog_delete {
45507  my $self = shift;
45508  my $tmpdir = $self->{tmpdir};
45509
45510  my $config_file = "$tmpdir/sftp.conf";
45511  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
45512  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
45513  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
45514
45515  my $log_file = test_get_logfile();
45516
45517  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
45518  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
45519
45520  my $user = 'proftpd';
45521  my $passwd = 'test';
45522  my $group = 'ftpd';
45523  my $home_dir = File::Spec->rel2abs($tmpdir);
45524  my $uid = 500;
45525  my $gid = 500;
45526
45527  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
45528  if (open(my $fh, "> $test_file")) {
45529    print $fh "ABCD\n";
45530
45531    unless (close($fh)) {
45532      die("Can't write $test_file: $!");
45533    }
45534
45535  } else {
45536    die("Can't open $test_file: $!");
45537  }
45538
45539  # Make sure that, if we're running as root, that the home directory has
45540  # permissions/privs set for the account we create
45541  if ($< == 0) {
45542    unless (chmod(0755, $home_dir)) {
45543      die("Can't set perms on $home_dir to 0755: $!");
45544    }
45545
45546    unless (chown($uid, $gid, $home_dir)) {
45547      die("Can't set owner of $home_dir to $uid/$gid: $!");
45548    }
45549  }
45550
45551  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
45552    '/bin/bash');
45553  auth_group_write($auth_group_file, $group, $gid, $user);
45554
45555  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
45556  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
45557
45558  my $config = {
45559    PidFile => $pid_file,
45560    ScoreboardFile => $scoreboard_file,
45561    SystemLog => $log_file,
45562    TraceLog => $log_file,
45563    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
45564
45565    AuthUserFile => $auth_user_file,
45566    AuthGroupFile => $auth_group_file,
45567
45568    TransferLog => $xferlog_file,
45569
45570    IfModules => {
45571      'mod_delay.c' => {
45572        DelayEngine => 'off',
45573      },
45574
45575      'mod_sftp.c' => [
45576        "SFTPEngine on",
45577        "SFTPLog $log_file",
45578        "SFTPHostKey $rsa_host_key",
45579        "SFTPHostKey $dsa_host_key",
45580      ],
45581    },
45582  };
45583
45584  my ($port, $config_user, $config_group) = config_write($config_file, $config);
45585
45586  # Open pipes, for use between the parent and child processes.  Specifically,
45587  # the child will indicate when it's done with its test by writing a message
45588  # to the parent.
45589  my ($rfh, $wfh);
45590  unless (pipe($rfh, $wfh)) {
45591    die("Can't open pipe: $!");
45592  }
45593
45594  require Net::SSH2;
45595
45596  my $ex;
45597
45598  # Ignore SIGPIPE
45599  local $SIG{PIPE} = sub { };
45600
45601  # Fork child
45602  $self->handle_sigchld();
45603  defined(my $pid = fork()) or die("Can't fork: $!");
45604  if ($pid) {
45605    eval {
45606      my $ssh2 = Net::SSH2->new();
45607
45608      sleep(1);
45609
45610      unless ($ssh2->connect('127.0.0.1', $port)) {
45611        my ($err_code, $err_name, $err_str) = $ssh2->error();
45612        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
45613      }
45614
45615      unless ($ssh2->auth_password($user, $passwd)) {
45616        my ($err_code, $err_name, $err_str) = $ssh2->error();
45617        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
45618      }
45619
45620      my $sftp = $ssh2->sftp();
45621      unless ($sftp) {
45622        my ($err_code, $err_name, $err_str) = $ssh2->error();
45623        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
45624      }
45625
45626      my $res = $sftp->unlink('test.txt');
45627      unless ($res) {
45628        my ($err_code, $err_name) = $sftp->error();
45629        die("Can't delete test.txt: [$err_name] ($err_code)");
45630      }
45631
45632      $sftp = undef;
45633      $ssh2->disconnect();
45634    };
45635
45636    if ($@) {
45637      $ex = $@;
45638    }
45639
45640    $wfh->print("done\n");
45641    $wfh->flush();
45642
45643  } else {
45644    eval { server_wait($config_file, $rfh) };
45645    if ($@) {
45646      warn($@);
45647      exit 1;
45648    }
45649
45650    exit 0;
45651  }
45652
45653  # Stop server
45654  server_stop($pid_file);
45655
45656  $self->assert_child_ok($pid);
45657
45658  if ($ex) {
45659    test_append_logfile($log_file, $ex);
45660    unlink($log_file);
45661
45662    die($ex);
45663  }
45664
45665  if (open(my $fh, "< $xferlog_file")) {
45666    my $ok = 0;
45667
45668    while (my $line = <$fh>) {
45669      chomp($line);
45670
45671     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
45672        my $client_addr = $3;
45673        my $nbytes = $4;
45674        my $path = $5;
45675        my $xfer_type = $6;
45676        my $action_flag = $7;
45677        my $xfer_direction = $8;
45678        my $access_mode = $9;
45679        my $user_name = $10;
45680        my $service_name = $11;
45681        my $completion_status = $12;
45682
45683        my $expected;
45684
45685        $expected = '127.0.0.1';
45686        $self->assert($expected eq $client_addr,
45687          test_msg("Expected '$expected', got '$client_addr'"));
45688
45689        $expected = $test_file;
45690        if ($^O eq 'darwin') {
45691          # MacOSX-specific hack to deal with how it handles tmp files
45692          $expected = ('/private' . $expected);
45693        }
45694
45695        $self->assert($expected eq $path,
45696          test_msg("Expected '$expected', got '$path'"));
45697
45698        $expected = 'b';
45699        $self->assert($expected eq $xfer_type,
45700          test_msg("Expected '$expected', got '$xfer_type'"));
45701
45702        $expected = '_';
45703        $self->assert($expected eq $action_flag,
45704          test_msg("Expected '$expected', got '$action_flag'"));
45705
45706        $expected = 'd';
45707        $self->assert($expected eq $xfer_direction,
45708          test_msg("Expected '$expected', got '$xfer_direction'"));
45709
45710        $expected = 'r';
45711        $self->assert($expected eq $access_mode,
45712          test_msg("Expected '$expected', got '$access_mode'"));
45713
45714        $expected = $user;
45715        $self->assert($expected eq $user_name,
45716          test_msg("Expected '$expected', got '$user_name'"));
45717
45718        $expected = 'sftp';
45719        $self->assert($expected eq $service_name,
45720          test_msg("Expected '$expected', got '$service_name'"));
45721
45722        $expected = 'c';
45723        $self->assert($expected eq $completion_status,
45724          test_msg("Expected '$expected', got '$completion_status'"));
45725
45726        $ok = 1;
45727        last;
45728      }
45729    }
45730
45731    close($fh);
45732
45733    unless ($ok) {
45734      die("No lines found in $xferlog_file");
45735    }
45736
45737  } else {
45738    die("Can't read $xferlog_file: $!");
45739  }
45740
45741  unlink($log_file);
45742}
45743
45744sub sftp_log_xferlog_delete_chrooted {
45745  my $self = shift;
45746  my $tmpdir = $self->{tmpdir};
45747
45748  my $config_file = "$tmpdir/sftp.conf";
45749  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
45750  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
45751  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
45752
45753  my $log_file = test_get_logfile();
45754
45755  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
45756  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
45757
45758  my $user = 'proftpd';
45759  my $passwd = 'test';
45760  my $group = 'ftpd';
45761  my $home_dir = File::Spec->rel2abs($tmpdir);
45762  my $uid = 500;
45763  my $gid = 500;
45764
45765  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
45766  if (open(my $fh, "> $test_file")) {
45767    print $fh "ABCD\n";
45768
45769    unless (close($fh)) {
45770      die("Can't write $test_file: $!");
45771    }
45772
45773  } else {
45774    die("Can't open $test_file: $!");
45775  }
45776
45777  # Make sure that, if we're running as root, that the home directory has
45778  # permissions/privs set for the account we create
45779  if ($< == 0) {
45780    unless (chmod(0755, $home_dir)) {
45781      die("Can't set perms on $home_dir to 0755: $!");
45782    }
45783
45784    unless (chown($uid, $gid, $home_dir)) {
45785      die("Can't set owner of $home_dir to $uid/$gid: $!");
45786    }
45787  }
45788
45789  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
45790    '/bin/bash');
45791  auth_group_write($auth_group_file, $group, $gid, $user);
45792
45793  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
45794  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
45795
45796  my $config = {
45797    PidFile => $pid_file,
45798    ScoreboardFile => $scoreboard_file,
45799    SystemLog => $log_file,
45800    TraceLog => $log_file,
45801    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
45802
45803    AuthUserFile => $auth_user_file,
45804    AuthGroupFile => $auth_group_file,
45805    DefaultRoot => '~',
45806
45807    TransferLog => $xferlog_file,
45808
45809    IfModules => {
45810      'mod_delay.c' => {
45811        DelayEngine => 'off',
45812      },
45813
45814      'mod_sftp.c' => [
45815        "SFTPEngine on",
45816        "SFTPLog $log_file",
45817        "SFTPHostKey $rsa_host_key",
45818        "SFTPHostKey $dsa_host_key",
45819      ],
45820    },
45821  };
45822
45823  my ($port, $config_user, $config_group) = config_write($config_file, $config);
45824
45825  # Open pipes, for use between the parent and child processes.  Specifically,
45826  # the child will indicate when it's done with its test by writing a message
45827  # to the parent.
45828  my ($rfh, $wfh);
45829  unless (pipe($rfh, $wfh)) {
45830    die("Can't open pipe: $!");
45831  }
45832
45833  require Net::SSH2;
45834
45835  my $ex;
45836
45837  # Ignore SIGPIPE
45838  local $SIG{PIPE} = sub { };
45839
45840  # Fork child
45841  $self->handle_sigchld();
45842  defined(my $pid = fork()) or die("Can't fork: $!");
45843  if ($pid) {
45844    eval {
45845      my $ssh2 = Net::SSH2->new();
45846
45847      sleep(1);
45848
45849      unless ($ssh2->connect('127.0.0.1', $port)) {
45850        my ($err_code, $err_name, $err_str) = $ssh2->error();
45851        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
45852      }
45853
45854      unless ($ssh2->auth_password($user, $passwd)) {
45855        my ($err_code, $err_name, $err_str) = $ssh2->error();
45856        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
45857      }
45858
45859      my $sftp = $ssh2->sftp();
45860      unless ($sftp) {
45861        my ($err_code, $err_name, $err_str) = $ssh2->error();
45862        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
45863      }
45864
45865      my $res = $sftp->unlink('test.txt');
45866      unless ($res) {
45867        my ($err_code, $err_name) = $sftp->error();
45868        die("Can't delete test.txt: [$err_name] ($err_code)");
45869      }
45870
45871      $sftp = undef;
45872      $ssh2->disconnect();
45873    };
45874
45875    if ($@) {
45876      $ex = $@;
45877    }
45878
45879    $wfh->print("done\n");
45880    $wfh->flush();
45881
45882  } else {
45883    eval { server_wait($config_file, $rfh) };
45884    if ($@) {
45885      warn($@);
45886      exit 1;
45887    }
45888
45889    exit 0;
45890  }
45891
45892  # Stop server
45893  server_stop($pid_file);
45894
45895  $self->assert_child_ok($pid);
45896
45897  if ($ex) {
45898    test_append_logfile($log_file, $ex);
45899    unlink($log_file);
45900
45901    die($ex);
45902  }
45903
45904  if (open(my $fh, "< $xferlog_file")) {
45905    my $ok = 0;
45906
45907    while (my $line = <$fh>) {
45908      chomp($line);
45909
45910     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
45911        my $client_addr = $3;
45912        my $nbytes = $4;
45913        my $path = $5;
45914        my $xfer_type = $6;
45915        my $action_flag = $7;
45916        my $xfer_direction = $8;
45917        my $access_mode = $9;
45918        my $user_name = $10;
45919        my $service_name = $11;
45920        my $completion_status = $12;
45921
45922        my $expected;
45923
45924        $expected = '127.0.0.1';
45925        $self->assert($expected eq $client_addr,
45926          test_msg("Expected '$expected', got '$client_addr'"));
45927
45928        $expected = $test_file;
45929        $self->assert($expected eq $path,
45930          test_msg("Expected '$expected', got '$path'"));
45931
45932        $expected = 'b';
45933        $self->assert($expected eq $xfer_type,
45934          test_msg("Expected '$expected', got '$xfer_type'"));
45935
45936        $expected = '_';
45937        $self->assert($expected eq $action_flag,
45938          test_msg("Expected '$expected', got '$action_flag'"));
45939
45940        $expected = 'd';
45941        $self->assert($expected eq $xfer_direction,
45942          test_msg("Expected '$expected', got '$xfer_direction'"));
45943
45944        $expected = 'r';
45945        $self->assert($expected eq $access_mode,
45946          test_msg("Expected '$expected', got '$access_mode'"));
45947
45948        $expected = $user;
45949        $self->assert($expected eq $user_name,
45950          test_msg("Expected '$expected', got '$user_name'"));
45951
45952        $expected = 'sftp';
45953        $self->assert($expected eq $service_name,
45954          test_msg("Expected '$expected', got '$service_name'"));
45955
45956        $expected = 'c';
45957        $self->assert($expected eq $completion_status,
45958          test_msg("Expected '$expected', got '$completion_status'"));
45959
45960        $ok = 1;
45961        last;
45962      }
45963    }
45964
45965    close($fh);
45966
45967    unless ($ok) {
45968      die("No lines found in $xferlog_file");
45969    }
45970
45971  } else {
45972    die("Can't read $xferlog_file: $!");
45973  }
45974
45975  unlink($log_file);
45976}
45977
45978sub sftp_log_xferlog_upload {
45979  my $self = shift;
45980  my $tmpdir = $self->{tmpdir};
45981
45982  my $config_file = "$tmpdir/sftp.conf";
45983  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
45984  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
45985  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
45986
45987  my $log_file = test_get_logfile();
45988
45989  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
45990  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
45991
45992  my $user = 'proftpd';
45993  my $passwd = 'test';
45994  my $group = 'ftpd';
45995  my $home_dir = File::Spec->rel2abs($tmpdir);
45996  my $uid = 500;
45997  my $gid = 500;
45998
45999  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
46000  my $write_sz = 1024;
46001
46002  # Make sure that, if we're running as root, that the home directory has
46003  # permissions/privs set for the account we create
46004  if ($< == 0) {
46005    unless (chmod(0755, $home_dir)) {
46006      die("Can't set perms on $home_dir to 0755: $!");
46007    }
46008
46009    unless (chown($uid, $gid, $home_dir)) {
46010      die("Can't set owner of $home_dir to $uid/$gid: $!");
46011    }
46012  }
46013
46014  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
46015    '/bin/bash');
46016  auth_group_write($auth_group_file, $group, $gid, $user);
46017
46018  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
46019  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
46020
46021  my $config = {
46022    PidFile => $pid_file,
46023    ScoreboardFile => $scoreboard_file,
46024    SystemLog => $log_file,
46025    TraceLog => $log_file,
46026    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
46027
46028    AuthUserFile => $auth_user_file,
46029    AuthGroupFile => $auth_group_file,
46030
46031    TransferLog => $xferlog_file,
46032
46033    IfModules => {
46034      'mod_delay.c' => {
46035        DelayEngine => 'off',
46036      },
46037
46038      'mod_sftp.c' => [
46039        "SFTPEngine on",
46040        "SFTPLog $log_file",
46041        "SFTPHostKey $rsa_host_key",
46042        "SFTPHostKey $dsa_host_key",
46043      ],
46044    },
46045  };
46046
46047  my ($port, $config_user, $config_group) = config_write($config_file, $config);
46048
46049  # Open pipes, for use between the parent and child processes.  Specifically,
46050  # the child will indicate when it's done with its test by writing a message
46051  # to the parent.
46052  my ($rfh, $wfh);
46053  unless (pipe($rfh, $wfh)) {
46054    die("Can't open pipe: $!");
46055  }
46056
46057  require Net::SSH2;
46058
46059  my $ex;
46060
46061  # Ignore SIGPIPE
46062  local $SIG{PIPE} = sub { };
46063
46064  # Fork child
46065  $self->handle_sigchld();
46066  defined(my $pid = fork()) or die("Can't fork: $!");
46067  if ($pid) {
46068    eval {
46069      my $ssh2 = Net::SSH2->new();
46070
46071      sleep(1);
46072
46073      unless ($ssh2->connect('127.0.0.1', $port)) {
46074        my ($err_code, $err_name, $err_str) = $ssh2->error();
46075        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
46076      }
46077
46078      unless ($ssh2->auth_password($user, $passwd)) {
46079        my ($err_code, $err_name, $err_str) = $ssh2->error();
46080        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
46081      }
46082
46083      my $sftp = $ssh2->sftp();
46084      unless ($sftp) {
46085        my ($err_code, $err_name, $err_str) = $ssh2->error();
46086        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
46087      }
46088
46089      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
46090      unless ($fh) {
46091        my ($err_code, $err_name) = $sftp->error();
46092        die("Can't open test.txt: [$err_name] ($err_code)");
46093      }
46094
46095      my $buf = ("ABCD" x 256);
46096      print $fh $buf;
46097
46098      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
46099      $fh = undef;
46100
46101      # To close the SFTP channel, we have to explicitly destroy the object
46102      $sftp = undef;
46103
46104      $ssh2->disconnect();
46105    };
46106
46107    if ($@) {
46108      $ex = $@;
46109    }
46110
46111    $wfh->print("done\n");
46112    $wfh->flush();
46113
46114  } else {
46115    eval { server_wait($config_file, $rfh) };
46116    if ($@) {
46117      warn($@);
46118      exit 1;
46119    }
46120
46121    exit 0;
46122  }
46123
46124  # Stop server
46125  server_stop($pid_file);
46126
46127  $self->assert_child_ok($pid);
46128
46129  if ($ex) {
46130    test_append_logfile($log_file, $ex);
46131    unlink($log_file);
46132
46133    die($ex);
46134  }
46135
46136  if (open(my $fh, "< $xferlog_file")) {
46137    my $ok = 0;
46138
46139    while (my $line = <$fh>) {
46140      chomp($line);
46141
46142     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
46143        my $client_addr = $3;
46144        my $nbytes = $4;
46145        my $path = $5;
46146        my $xfer_type = $6;
46147        my $action_flag = $7;
46148        my $xfer_direction = $8;
46149        my $access_mode = $9;
46150        my $user_name = $10;
46151        my $service_name = $11;
46152        my $completion_status = $12;
46153
46154        my $expected;
46155
46156        $expected = '127.0.0.1';
46157        $self->assert($expected eq $client_addr,
46158          test_msg("Expected '$expected', got '$client_addr'"));
46159
46160        $expected = $write_sz;
46161        $self->assert($expected == $nbytes,
46162          test_msg("Expected $expected, got $nbytes"));
46163
46164        $expected = $test_file;
46165        if ($^O eq 'darwin') {
46166          # MacOSX-specific hack to deal with how it handles tmp files
46167          $expected = ('/private' . $expected);
46168        }
46169
46170        $self->assert($expected eq $path,
46171          test_msg("Expected '$expected', got '$path'"));
46172
46173        $expected = 'b';
46174        $self->assert($expected eq $xfer_type,
46175          test_msg("Expected '$expected', got '$xfer_type'"));
46176
46177        $expected = '_';
46178        $self->assert($expected eq $action_flag,
46179          test_msg("Expected '$expected', got '$action_flag'"));
46180
46181        $expected = 'i';
46182        $self->assert($expected eq $xfer_direction,
46183          test_msg("Expected '$expected', got '$xfer_direction'"));
46184
46185        $expected = 'r';
46186        $self->assert($expected eq $access_mode,
46187          test_msg("Expected '$expected', got '$access_mode'"));
46188
46189        $expected = $user;
46190        $self->assert($expected eq $user_name,
46191          test_msg("Expected '$expected', got '$user_name'"));
46192
46193        $expected = 'sftp';
46194        $self->assert($expected eq $service_name,
46195          test_msg("Expected '$expected', got '$service_name'"));
46196
46197        $expected = 'c';
46198        $self->assert($expected eq $completion_status,
46199          test_msg("Expected '$expected', got '$completion_status'"));
46200
46201        $ok = 1;
46202        last;
46203      }
46204    }
46205
46206    close($fh);
46207
46208    unless ($ok) {
46209      die("No lines found in $xferlog_file");
46210    }
46211
46212  } else {
46213    die("Can't read $xferlog_file: $!");
46214  }
46215
46216  unlink($log_file);
46217}
46218
46219sub sftp_log_xferlog_upload_incomplete {
46220  my $self = shift;
46221  my $tmpdir = $self->{tmpdir};
46222
46223  my $config_file = "$tmpdir/sftp.conf";
46224  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
46225  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
46226  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
46227
46228  my $log_file = test_get_logfile();
46229
46230  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
46231  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
46232
46233  my $user = 'proftpd';
46234  my $passwd = 'test';
46235  my $group = 'ftpd';
46236  my $home_dir = File::Spec->rel2abs($tmpdir);
46237  my $uid = 500;
46238  my $gid = 500;
46239
46240  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
46241  my $write_sz = 32;
46242
46243  # Make sure that, if we're running as root, that the home directory has
46244  # permissions/privs set for the account we create
46245  if ($< == 0) {
46246    unless (chmod(0755, $home_dir)) {
46247      die("Can't set perms on $home_dir to 0755: $!");
46248    }
46249
46250    unless (chown($uid, $gid, $home_dir)) {
46251      die("Can't set owner of $home_dir to $uid/$gid: $!");
46252    }
46253  }
46254
46255  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
46256    '/bin/bash');
46257  auth_group_write($auth_group_file, $group, $gid, $user);
46258
46259  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
46260  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
46261
46262  my $config = {
46263    PidFile => $pid_file,
46264    ScoreboardFile => $scoreboard_file,
46265    SystemLog => $log_file,
46266    TraceLog => $log_file,
46267    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
46268
46269    AuthUserFile => $auth_user_file,
46270    AuthGroupFile => $auth_group_file,
46271    TransferLog => $xferlog_file,
46272
46273    IfModules => {
46274      'mod_delay.c' => {
46275        DelayEngine => 'off',
46276      },
46277
46278      'mod_sftp.c' => [
46279        "SFTPEngine on",
46280        "SFTPLog $log_file",
46281        "SFTPHostKey $rsa_host_key",
46282        "SFTPHostKey $dsa_host_key",
46283      ],
46284    },
46285  };
46286
46287  my ($port, $config_user, $config_group) = config_write($config_file, $config);
46288
46289  # Open pipes, for use between the parent and child processes.  Specifically,
46290  # the child will indicate when it's done with its test by writing a message
46291  # to the parent.
46292  my ($rfh, $wfh);
46293  unless (pipe($rfh, $wfh)) {
46294    die("Can't open pipe: $!");
46295  }
46296
46297  require Net::SSH2;
46298
46299  my $ex;
46300
46301  # Ignore SIGPIPE
46302  local $SIG{PIPE} = sub { };
46303
46304  # Fork child
46305  $self->handle_sigchld();
46306  defined(my $pid = fork()) or die("Can't fork: $!");
46307  if ($pid) {
46308    eval {
46309      my $ssh2 = Net::SSH2->new();
46310
46311      sleep(1);
46312
46313      unless ($ssh2->connect('127.0.0.1', $port)) {
46314        my ($err_code, $err_name, $err_str) = $ssh2->error();
46315        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
46316      }
46317
46318      unless ($ssh2->auth_password($user, $passwd)) {
46319        my ($err_code, $err_name, $err_str) = $ssh2->error();
46320        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
46321      }
46322
46323      my $sftp = $ssh2->sftp();
46324      unless ($sftp) {
46325        my ($err_code, $err_name, $err_str) = $ssh2->error();
46326        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
46327      }
46328
46329      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
46330      unless ($fh) {
46331        my ($err_code, $err_name) = $sftp->error();
46332        die("Can't open test.txt: [$err_name] ($err_code)");
46333      }
46334
46335      my $buf = ("ABCD" x 8);
46336      my $res = $fh->write($buf);
46337      unless ($res) {
46338        my ($err_code, $err_name) = $sftp->error();
46339        die("Can't write test.txt: [$err_name] ($err_code)");
46340      }
46341
46342      # Explicitly disconnect without closing the file, simulating an
46343      # aborted transfer.
46344      $ssh2->disconnect();
46345
46346      # Give a little time for the server to do its end-of-session thing.
46347      sleep(1);
46348    };
46349
46350    if ($@) {
46351      $ex = $@;
46352    }
46353
46354    $wfh->print("done\n");
46355    $wfh->flush();
46356
46357  } else {
46358    eval { server_wait($config_file, $rfh) };
46359    if ($@) {
46360      warn($@);
46361      exit 1;
46362    }
46363
46364    exit 0;
46365  }
46366
46367  # Stop server
46368  server_stop($pid_file);
46369
46370  $self->assert_child_ok($pid);
46371
46372  if ($ex) {
46373    test_append_logfile($log_file, $ex);
46374    unlink($log_file);
46375
46376    die($ex);
46377  }
46378
46379  if (open(my $fh, "< $xferlog_file")) {
46380    my $ok = 0;
46381
46382    while (my $line = <$fh>) {
46383      chomp($line);
46384
46385     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
46386        my $client_addr = $3;
46387        my $nbytes = $4;
46388        my $path = $5;
46389        my $xfer_type = $6;
46390        my $action_flag = $7;
46391        my $xfer_direction = $8;
46392        my $access_mode = $9;
46393        my $user_name = $10;
46394        my $service_name = $11;
46395        my $completion_status = $12;
46396
46397        my $expected;
46398
46399        $expected = '127.0.0.1';
46400        $self->assert($expected eq $client_addr,
46401          test_msg("Expected '$expected', got '$client_addr'"));
46402
46403        $expected = $write_sz;
46404        $self->assert($expected == $nbytes,
46405          test_msg("Expected $expected, got $nbytes"));
46406
46407        $expected = $test_file;
46408        if ($^O eq 'darwin') {
46409          # MacOSX-specific hack to deal with how it handles tmp files
46410          $expected = ('/private' . $expected);
46411        }
46412
46413        $self->assert($expected eq $path,
46414          test_msg("Expected '$expected', got '$path'"));
46415
46416        $expected = 'b';
46417        $self->assert($expected eq $xfer_type,
46418          test_msg("Expected '$expected', got '$xfer_type'"));
46419
46420        $expected = '_';
46421        $self->assert($expected eq $action_flag,
46422          test_msg("Expected '$expected', got '$action_flag'"));
46423
46424        $expected = 'i';
46425        $self->assert($expected eq $xfer_direction,
46426          test_msg("Expected '$expected', got '$xfer_direction'"));
46427
46428        $expected = 'r';
46429        $self->assert($expected eq $access_mode,
46430          test_msg("Expected '$expected', got '$access_mode'"));
46431
46432        $expected = $user;
46433        $self->assert($expected eq $user_name,
46434          test_msg("Expected '$expected', got '$user_name'"));
46435
46436        $expected = 'sftp';
46437        $self->assert($expected eq $service_name,
46438          test_msg("Expected '$expected', got '$service_name'"));
46439
46440        $expected = 'i';
46441        $self->assert($expected eq $completion_status,
46442          test_msg("Expected '$expected', got '$completion_status'"));
46443
46444        $ok = 1;
46445        last;
46446      }
46447    }
46448
46449    close($fh);
46450
46451    unless ($ok) {
46452      die("No lines found in $xferlog_file");
46453    }
46454
46455  } else {
46456    die("Can't read $xferlog_file: $!");
46457  }
46458
46459  unlink($log_file);
46460}
46461
46462sub sftp_log_extlog_auth_bug3845 {
46463  my $self = shift;
46464  my $tmpdir = $self->{tmpdir};
46465
46466  my $config_file = "$tmpdir/sftp.conf";
46467  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
46468  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
46469  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
46470
46471  my $log_file = test_get_logfile();
46472
46473  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
46474  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
46475
46476  my $user = 'proftpd';
46477  my $passwd = 'test';
46478  my $group = 'ftpd';
46479  my $home_dir = File::Spec->rel2abs($tmpdir);
46480  my $uid = 500;
46481  my $gid = 500;
46482
46483  # Make sure that, if we're running as root, that the home directory has
46484  # permissions/privs set for the account we create
46485  if ($< == 0) {
46486    unless (chmod(0755, $home_dir)) {
46487      die("Can't set perms on $home_dir to 0755: $!");
46488    }
46489
46490    unless (chown($uid, $gid, $home_dir)) {
46491      die("Can't set owner of $home_dir to $uid/$gid: $!");
46492    }
46493  }
46494
46495  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
46496    '/bin/bash');
46497  auth_group_write($auth_group_file, $group, $gid, $user);
46498
46499  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
46500  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
46501
46502  my $config = {
46503    PidFile => $pid_file,
46504    ScoreboardFile => $scoreboard_file,
46505    SystemLog => $log_file,
46506    TraceLog => $log_file,
46507    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
46508
46509    AuthUserFile => $auth_user_file,
46510    AuthGroupFile => $auth_group_file,
46511
46512    LogFormat => 'login "\"%r\" %s"',
46513    ExtendedLog => "$extlog_file AUTH login",
46514
46515    IfModules => {
46516      'mod_delay.c' => {
46517        DelayEngine => 'off',
46518      },
46519
46520      'mod_sftp.c' => [
46521        "SFTPEngine on",
46522        "SFTPLog $log_file",
46523        "SFTPHostKey $rsa_host_key",
46524        "SFTPHostKey $dsa_host_key",
46525      ],
46526    },
46527  };
46528
46529  my ($port, $config_user, $config_group) = config_write($config_file, $config);
46530
46531  # Open pipes, for use between the parent and child processes.  Specifically,
46532  # the child will indicate when it's done with its test by writing a message
46533  # to the parent.
46534  my ($rfh, $wfh);
46535  unless (pipe($rfh, $wfh)) {
46536    die("Can't open pipe: $!");
46537  }
46538
46539  require Net::SSH2;
46540
46541  my $ex;
46542
46543  # Ignore SIGPIPE
46544  local $SIG{PIPE} = sub { };
46545
46546  # Fork child
46547  $self->handle_sigchld();
46548  defined(my $pid = fork()) or die("Can't fork: $!");
46549  if ($pid) {
46550    eval {
46551      my $ssh2 = Net::SSH2->new();
46552
46553      sleep(1);
46554
46555      unless ($ssh2->connect('127.0.0.1', $port)) {
46556        my ($err_code, $err_name, $err_str) = $ssh2->error();
46557        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
46558      }
46559
46560      unless ($ssh2->auth_password($user, $passwd)) {
46561        my ($err_code, $err_name, $err_str) = $ssh2->error();
46562        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
46563      }
46564
46565      my $sftp = $ssh2->sftp();
46566      unless ($sftp) {
46567        my ($err_code, $err_name, $err_str) = $ssh2->error();
46568        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
46569      }
46570
46571      $sftp = undef;
46572      $ssh2->disconnect();
46573
46574      # Give a little time for the server to do its end-of-session thing.
46575      sleep(1);
46576    };
46577
46578    if ($@) {
46579      $ex = $@;
46580    }
46581
46582    $wfh->print("done\n");
46583    $wfh->flush();
46584
46585  } else {
46586    eval { server_wait($config_file, $rfh) };
46587    if ($@) {
46588      warn($@);
46589      exit 1;
46590    }
46591
46592    exit 0;
46593  }
46594
46595  # Stop server
46596  server_stop($pid_file);
46597
46598  $self->assert_child_ok($pid);
46599
46600  if ($ex) {
46601    test_append_logfile($log_file, $ex);
46602    unlink($log_file);
46603
46604    die($ex);
46605  }
46606
46607  if (open(my $fh, "< $extlog_file")) {
46608    my $user_ok = 0;
46609    my $pass_ok = 0;
46610
46611    while (my $line = <$fh>) {
46612      chomp($line);
46613
46614      if ($line =~ /^"(\S+)\s+(\S+).*"\s+(\d+)$/) {
46615        my $cmd = $1;
46616        my $cmd_arg = $2;
46617        my $resp_code = $3;
46618
46619        if ($cmd eq 'USER') {
46620          if ($resp_code == 331) {
46621            $user_ok = 1;
46622          }
46623
46624        } elsif ($cmd eq 'PASS') {
46625          if ($resp_code == 230) {
46626            $pass_ok = 1;
46627          }
46628        }
46629      }
46630    }
46631
46632    close($fh);
46633
46634    $self->assert($user_ok,
46635      test_msg("Did not see USER command in ExtendedLog $extlog_file as expected"));
46636    $self->assert($pass_ok,
46637      test_msg("Did not see PASS command in ExtendedLog $extlog_file as expected"));
46638
46639  } else {
46640    die("Can't read $extlog_file: $!");
46641  }
46642
46643  unlink($log_file);
46644}
46645
46646sub sftp_log_extlog_reads {
46647  my $self = shift;
46648  my $tmpdir = $self->{tmpdir};
46649
46650  my $config_file = "$tmpdir/sftp.conf";
46651  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
46652  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
46653  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
46654
46655  my $log_file = test_get_logfile();
46656
46657  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
46658  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
46659
46660  my $user = 'proftpd';
46661  my $passwd = 'test';
46662  my $group = 'ftpd';
46663  my $home_dir = File::Spec->rel2abs($tmpdir);
46664  my $uid = 500;
46665  my $gid = 500;
46666
46667  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
46668  my $write_sz = 32;
46669
46670  # Make sure that, if we're running as root, that the home directory has
46671  # permissions/privs set for the account we create
46672  if ($< == 0) {
46673    unless (chmod(0755, $home_dir)) {
46674      die("Can't set perms on $home_dir to 0755: $!");
46675    }
46676
46677    unless (chown($uid, $gid, $home_dir)) {
46678      die("Can't set owner of $home_dir to $uid/$gid: $!");
46679    }
46680  }
46681
46682  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
46683    '/bin/bash');
46684  auth_group_write($auth_group_file, $group, $gid, $user);
46685
46686  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
46687  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
46688
46689  my $config = {
46690    PidFile => $pid_file,
46691    ScoreboardFile => $scoreboard_file,
46692    SystemLog => $log_file,
46693    TraceLog => $log_file,
46694    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
46695
46696    AuthUserFile => $auth_user_file,
46697    AuthGroupFile => $auth_group_file,
46698
46699    LogFormat => 'transfer "%m \"%F\""',
46700    ExtendedLog => "$extlog_file READ transfer",
46701
46702    IfModules => {
46703      'mod_delay.c' => {
46704        DelayEngine => 'off',
46705      },
46706
46707      'mod_sftp.c' => [
46708        "SFTPEngine on",
46709        "SFTPLog $log_file",
46710        "SFTPHostKey $rsa_host_key",
46711        "SFTPHostKey $dsa_host_key",
46712      ],
46713    },
46714  };
46715
46716  my ($port, $config_user, $config_group) = config_write($config_file, $config);
46717
46718  # Open pipes, for use between the parent and child processes.  Specifically,
46719  # the child will indicate when it's done with its test by writing a message
46720  # to the parent.
46721  my ($rfh, $wfh);
46722  unless (pipe($rfh, $wfh)) {
46723    die("Can't open pipe: $!");
46724  }
46725
46726  require Net::SSH2;
46727
46728  my $ex;
46729
46730  # Ignore SIGPIPE
46731  local $SIG{PIPE} = sub { };
46732
46733  # Fork child
46734  $self->handle_sigchld();
46735  defined(my $pid = fork()) or die("Can't fork: $!");
46736  if ($pid) {
46737    eval {
46738      my $ssh2 = Net::SSH2->new();
46739
46740      sleep(1);
46741
46742      unless ($ssh2->connect('127.0.0.1', $port)) {
46743        my ($err_code, $err_name, $err_str) = $ssh2->error();
46744        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
46745      }
46746
46747      unless ($ssh2->auth_password($user, $passwd)) {
46748        my ($err_code, $err_name, $err_str) = $ssh2->error();
46749        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
46750      }
46751
46752      my $sftp = $ssh2->sftp();
46753      unless ($sftp) {
46754        my ($err_code, $err_name, $err_str) = $ssh2->error();
46755        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
46756      }
46757
46758      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
46759      unless ($fh) {
46760        my ($err_code, $err_name) = $sftp->error();
46761        die("Can't open test.txt: [$err_name] ($err_code)");
46762      }
46763
46764      my $buf = ("ABCD" x 8);
46765      my $res = $fh->write($buf);
46766      unless ($res) {
46767        my ($err_code, $err_name) = $sftp->error();
46768        die("Can't write test.txt: [$err_name] ($err_code)");
46769      }
46770
46771      # Explicitly disconnect without closing the file, simulating an
46772      # aborted transfer.
46773      $ssh2->disconnect();
46774
46775      # Give a little time for the server to do its end-of-session thing.
46776      sleep(1);
46777    };
46778
46779    if ($@) {
46780      $ex = $@;
46781    }
46782
46783    $wfh->print("done\n");
46784    $wfh->flush();
46785
46786  } else {
46787    eval { server_wait($config_file, $rfh) };
46788    if ($@) {
46789      warn($@);
46790      exit 1;
46791    }
46792
46793    exit 0;
46794  }
46795
46796  # Stop server
46797  server_stop($pid_file);
46798
46799  $self->assert_child_ok($pid);
46800
46801  if ($ex) {
46802    test_append_logfile($log_file, $ex);
46803    unlink($log_file);
46804
46805    die($ex);
46806  }
46807
46808  if (open(my $fh, "< $extlog_file")) {
46809    my $ok = 1;
46810
46811    while (my $line = <$fh>) {
46812      chomp($line);
46813
46814      # We don't expect to see any lines in this ExtendedLog for the SSH2
46815      # connection.
46816
46817      $ok = 0;
46818      last;
46819    }
46820
46821    close($fh);
46822
46823    unless ($ok) {
46824      die("Lines found unexpectedly in $extlog_file");
46825    }
46826
46827  } else {
46828    die("Can't read $extlog_file: $!");
46829  }
46830
46831  unlink($log_file);
46832}
46833
46834sub sftp_log_extlog_read_close {
46835  my $self = shift;
46836  my $tmpdir = $self->{tmpdir};
46837
46838  my $config_file = "$tmpdir/sftp.conf";
46839  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
46840  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
46841  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
46842
46843  my $log_file = test_get_logfile();
46844
46845  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
46846  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
46847
46848  my $user = 'proftpd';
46849  my $passwd = 'test';
46850  my $group = 'ftpd';
46851  my $home_dir = File::Spec->rel2abs($tmpdir);
46852  my $uid = 500;
46853  my $gid = 500;
46854
46855  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
46856  my $write_sz = 32;
46857
46858  # Make sure that, if we're running as root, that the home directory has
46859  # permissions/privs set for the account we create
46860  if ($< == 0) {
46861    unless (chmod(0755, $home_dir)) {
46862      die("Can't set perms on $home_dir to 0755: $!");
46863    }
46864
46865    unless (chown($uid, $gid, $home_dir)) {
46866      die("Can't set owner of $home_dir to $uid/$gid: $!");
46867    }
46868  }
46869
46870  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
46871    '/bin/bash');
46872  auth_group_write($auth_group_file, $group, $gid, $user);
46873
46874  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
46875  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
46876
46877  my $config = {
46878    PidFile => $pid_file,
46879    ScoreboardFile => $scoreboard_file,
46880    SystemLog => $log_file,
46881    TraceLog => $log_file,
46882    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
46883
46884    AuthUserFile => $auth_user_file,
46885    AuthGroupFile => $auth_group_file,
46886
46887    LogFormat => 'transfer "%m \"%F\""',
46888    ExtendedLog => "$extlog_file READ transfer",
46889
46890    IfModules => {
46891      'mod_delay.c' => {
46892        DelayEngine => 'off',
46893      },
46894
46895      'mod_sftp.c' => [
46896        "SFTPEngine on",
46897        "SFTPLog $log_file",
46898        "SFTPHostKey $rsa_host_key",
46899        "SFTPHostKey $dsa_host_key",
46900      ],
46901    },
46902  };
46903
46904  my ($port, $config_user, $config_group) = config_write($config_file, $config);
46905
46906  # Open pipes, for use between the parent and child processes.  Specifically,
46907  # the child will indicate when it's done with its test by writing a message
46908  # to the parent.
46909  my ($rfh, $wfh);
46910  unless (pipe($rfh, $wfh)) {
46911    die("Can't open pipe: $!");
46912  }
46913
46914  require Net::SSH2;
46915
46916  my $ex;
46917
46918  # Ignore SIGPIPE
46919  local $SIG{PIPE} = sub { };
46920
46921  # Fork child
46922  $self->handle_sigchld();
46923  defined(my $pid = fork()) or die("Can't fork: $!");
46924  if ($pid) {
46925    eval {
46926      my $ssh2 = Net::SSH2->new();
46927
46928      sleep(2);
46929
46930      unless ($ssh2->connect('127.0.0.1', $port)) {
46931        my ($err_code, $err_name, $err_str) = $ssh2->error();
46932        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
46933      }
46934
46935      unless ($ssh2->auth_password($user, $passwd)) {
46936        my ($err_code, $err_name, $err_str) = $ssh2->error();
46937        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
46938      }
46939
46940      my $sftp = $ssh2->sftp();
46941      unless ($sftp) {
46942        my ($err_code, $err_name, $err_str) = $ssh2->error();
46943        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
46944      }
46945
46946      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
46947      unless ($fh) {
46948        my ($err_code, $err_name) = $sftp->error();
46949        die("Can't open test.txt: [$err_name] ($err_code)");
46950      }
46951
46952      my $buf = ("ABCD" x 8);
46953      my $res = $fh->write($buf);
46954      unless ($res) {
46955        my ($err_code, $err_name) = $sftp->error();
46956        die("Can't write test.txt: [$err_name] ($err_code)");
46957      }
46958
46959      $fh = undef;
46960
46961      $sftp = undef;
46962      $ssh2->disconnect();
46963
46964      # Give a little time for the server to do its end-of-session thing.
46965      sleep(1);
46966    };
46967
46968    if ($@) {
46969      $ex = $@;
46970    }
46971
46972    $wfh->print("done\n");
46973    $wfh->flush();
46974
46975  } else {
46976    eval { server_wait($config_file, $rfh) };
46977    if ($@) {
46978      warn($@);
46979      exit 1;
46980    }
46981
46982    exit 0;
46983  }
46984
46985  # Stop server
46986  server_stop($pid_file);
46987
46988  $self->assert_child_ok($pid);
46989
46990  eval {
46991    if (open(my $fh, "< $extlog_file")) {
46992      my $ok = 1;
46993
46994      while (my $line = <$fh>) {
46995        chomp($line);
46996
46997        if ($ENV{TEST_VERBOSE}) {
46998          print STDERR " - ExtendedLog: $line\n";
46999        }
47000
47001        # We don't expect to see any lines in this ExtendedLog for the SSH2
47002        # connection.
47003
47004        $ok = 0;
47005      }
47006
47007      close($fh);
47008
47009      unless ($ok) {
47010        die("Lines found unexpectedly in $extlog_file");
47011      }
47012
47013    } else {
47014      die("Can't read $extlog_file: $!");
47015    }
47016  };
47017  if ($@) {
47018    $ex = $@;
47019  }
47020
47021  if ($ex) {
47022    test_append_logfile($log_file, $ex);
47023    unlink($log_file);
47024
47025    die($ex);
47026  }
47027
47028  unlink($log_file);
47029}
47030
47031sub sftp_log_extlog_write_close {
47032  my $self = shift;
47033  my $tmpdir = $self->{tmpdir};
47034
47035  my $config_file = "$tmpdir/sftp.conf";
47036  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
47037  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
47038  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
47039
47040  my $log_file = test_get_logfile();
47041
47042  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
47043  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
47044
47045  my $user = 'proftpd';
47046  my $passwd = 'test';
47047  my $group = 'ftpd';
47048  my $home_dir = File::Spec->rel2abs($tmpdir);
47049  my $uid = 500;
47050  my $gid = 500;
47051
47052  # Make sure that, if we're running as root, that the home directory has
47053  # permissions/privs set for the account we create
47054  if ($< == 0) {
47055    unless (chmod(0755, $home_dir)) {
47056      die("Can't set perms on $home_dir to 0755: $!");
47057    }
47058
47059    unless (chown($uid, $gid, $home_dir)) {
47060      die("Can't set owner of $home_dir to $uid/$gid: $!");
47061    }
47062  }
47063
47064  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
47065    '/bin/bash');
47066  auth_group_write($auth_group_file, $group, $gid, $user);
47067
47068  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
47069  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
47070
47071  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
47072  if (open(my $fh, "> $test_file")) {
47073    print $fh "Hello, World!\n";
47074    unless (close($fh)) {
47075      die("Can't write $test_file: $!");
47076    }
47077
47078  } else {
47079    die("Can't open $test_file: $!");
47080  }
47081
47082  my $config = {
47083    PidFile => $pid_file,
47084    ScoreboardFile => $scoreboard_file,
47085    SystemLog => $log_file,
47086    TraceLog => $log_file,
47087    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
47088
47089    AuthUserFile => $auth_user_file,
47090    AuthGroupFile => $auth_group_file,
47091
47092    LogFormat => 'transfer "%m \"%F\""',
47093    ExtendedLog => "$extlog_file WRITE transfer",
47094
47095    IfModules => {
47096      'mod_delay.c' => {
47097        DelayEngine => 'off',
47098      },
47099
47100      'mod_sftp.c' => [
47101        "SFTPEngine on",
47102        "SFTPLog $log_file",
47103        "SFTPHostKey $rsa_host_key",
47104        "SFTPHostKey $dsa_host_key",
47105      ],
47106    },
47107  };
47108
47109  my ($port, $config_user, $config_group) = config_write($config_file, $config);
47110
47111  # Open pipes, for use between the parent and child processes.  Specifically,
47112  # the child will indicate when it's done with its test by writing a message
47113  # to the parent.
47114  my ($rfh, $wfh);
47115  unless (pipe($rfh, $wfh)) {
47116    die("Can't open pipe: $!");
47117  }
47118
47119  require Net::SSH2;
47120
47121  my $ex;
47122
47123  # Ignore SIGPIPE
47124  local $SIG{PIPE} = sub { };
47125
47126  # Fork child
47127  $self->handle_sigchld();
47128  defined(my $pid = fork()) or die("Can't fork: $!");
47129  if ($pid) {
47130    eval {
47131      my $ssh2 = Net::SSH2->new();
47132
47133      sleep(2);
47134
47135      unless ($ssh2->connect('127.0.0.1', $port)) {
47136        my ($err_code, $err_name, $err_str) = $ssh2->error();
47137        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
47138      }
47139
47140      unless ($ssh2->auth_password($user, $passwd)) {
47141        my ($err_code, $err_name, $err_str) = $ssh2->error();
47142        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
47143      }
47144
47145      my $sftp = $ssh2->sftp();
47146      unless ($sftp) {
47147        my ($err_code, $err_name, $err_str) = $ssh2->error();
47148        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
47149      }
47150
47151      my $fh = $sftp->open('test.txt', O_RDONLY);
47152      unless ($fh) {
47153        my ($err_code, $err_name) = $sftp->error();
47154        die("Can't open test.txt: [$err_name] ($err_code)");
47155      }
47156
47157      my $buf;
47158      my $read_len = 8192;
47159
47160      my $res = $fh->read($buf, $read_len);
47161      unless ($res) {
47162        my ($err_code, $err_name) = $sftp->error();
47163        if ($err_code != 0) {
47164          die("Can't read test.txt: [$err_name] ($err_code)");
47165
47166        } else {
47167          my $err_str;
47168          ($err_code, $err_name, $err_str) = $ssh2->error();
47169          die("SSH2 error: [$err_name] ($err_code) $err_str");
47170        }
47171      }
47172
47173      $fh = undef;
47174
47175      $sftp = undef;
47176      $ssh2->disconnect();
47177
47178      # Give a little time for the server to do its end-of-session thing.
47179      sleep(1);
47180    };
47181
47182    if ($@) {
47183      $ex = $@;
47184    }
47185
47186    $wfh->print("done\n");
47187    $wfh->flush();
47188
47189  } else {
47190    eval { server_wait($config_file, $rfh) };
47191    if ($@) {
47192      warn($@);
47193      exit 1;
47194    }
47195
47196    exit 0;
47197  }
47198
47199  # Stop server
47200  server_stop($pid_file);
47201
47202  $self->assert_child_ok($pid);
47203
47204  eval {
47205    if (open(my $fh, "< $extlog_file")) {
47206      my $ok = 1;
47207
47208      while (my $line = <$fh>) {
47209        chomp($line);
47210
47211        if ($ENV{TEST_VERBOSE}) {
47212          print STDERR " - ExtendedLog: $line\n";
47213        }
47214
47215        # We don't expect to see any lines in this ExtendedLog for the SSH2
47216        # connection.
47217
47218        $ok = 0;
47219      }
47220
47221      close($fh);
47222
47223      unless ($ok) {
47224        die("Lines found unexpectedly in $extlog_file");
47225      }
47226
47227    } else {
47228      die("Can't read $extlog_file: $!");
47229    }
47230  };
47231  if ($@) {
47232    $ex = $@;
47233  }
47234
47235  if ($ex) {
47236    test_append_logfile($log_file, $ex);
47237    unlink($log_file);
47238
47239    die($ex);
47240  }
47241
47242  unlink($log_file);
47243}
47244
47245sub sftp_log_extlog_var_s_reads {
47246  my $self = shift;
47247  my $tmpdir = $self->{tmpdir};
47248
47249  my $config_file = "$tmpdir/sftp.conf";
47250  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
47251  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
47252  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
47253
47254  my $log_file = test_get_logfile();
47255
47256  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
47257  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
47258
47259  my $user = 'proftpd';
47260  my $passwd = 'test';
47261  my $group = 'ftpd';
47262  my $home_dir = File::Spec->rel2abs($tmpdir);
47263  my $uid = 500;
47264  my $gid = 500;
47265
47266  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
47267  my $write_sz = 32;
47268
47269  # Make sure that, if we're running as root, that the home directory has
47270  # permissions/privs set for the account we create
47271  if ($< == 0) {
47272    unless (chmod(0755, $home_dir)) {
47273      die("Can't set perms on $home_dir to 0755: $!");
47274    }
47275
47276    unless (chown($uid, $gid, $home_dir)) {
47277      die("Can't set owner of $home_dir to $uid/$gid: $!");
47278    }
47279  }
47280
47281  # Create some files in the home directory to read
47282  for (my $i = 0; $i < 5; $i++) {
47283    my $path = File::Spec->rel2abs("$home_dir/$i.txt");
47284
47285    if (open(my $fh, "> $path")) {
47286      print $fh "ABCD\n" x 64;
47287
47288      unless (close($fh)) {
47289        die("Can't write $path: $!");
47290      }
47291
47292    } else {
47293      die("Can't open $path: $!");
47294    }
47295  }
47296
47297  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
47298    '/bin/bash');
47299  auth_group_write($auth_group_file, $group, $gid, $user);
47300
47301  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
47302  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
47303
47304  my $config = {
47305    PidFile => $pid_file,
47306    ScoreboardFile => $scoreboard_file,
47307    SystemLog => $log_file,
47308    TraceLog => $log_file,
47309    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
47310
47311    AuthUserFile => $auth_user_file,
47312    AuthGroupFile => $auth_group_file,
47313
47314    LogFormat => 'response "%r %s"',
47315    ExtendedLog => "$extlog_file READ response",
47316
47317    IfModules => {
47318      'mod_delay.c' => {
47319        DelayEngine => 'off',
47320      },
47321
47322      'mod_sftp.c' => [
47323        "SFTPEngine on",
47324        "SFTPLog $log_file",
47325        "SFTPHostKey $rsa_host_key",
47326        "SFTPHostKey $dsa_host_key",
47327      ],
47328    },
47329  };
47330
47331  my ($port, $config_user, $config_group) = config_write($config_file, $config);
47332
47333  # Open pipes, for use between the parent and child processes.  Specifically,
47334  # the child will indicate when it's done with its test by writing a message
47335  # to the parent.
47336  my ($rfh, $wfh);
47337  unless (pipe($rfh, $wfh)) {
47338    die("Can't open pipe: $!");
47339  }
47340
47341  require Net::SSH2;
47342
47343  my $ex;
47344
47345  # Ignore SIGPIPE
47346  local $SIG{PIPE} = sub { };
47347
47348  # Fork child
47349  $self->handle_sigchld();
47350  defined(my $pid = fork()) or die("Can't fork: $!");
47351  if ($pid) {
47352    eval {
47353      my $ssh2 = Net::SSH2->new();
47354
47355      sleep(1);
47356
47357      unless ($ssh2->connect('127.0.0.1', $port)) {
47358        my ($err_code, $err_name, $err_str) = $ssh2->error();
47359        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
47360      }
47361
47362      unless ($ssh2->auth_password($user, $passwd)) {
47363        my ($err_code, $err_name, $err_str) = $ssh2->error();
47364        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
47365      }
47366
47367      my $sftp = $ssh2->sftp();
47368      unless ($sftp) {
47369        my ($err_code, $err_name, $err_str) = $ssh2->error();
47370        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
47371      }
47372
47373      my $dir = $sftp->opendir('.');
47374      unless ($dir) {
47375        my ($err_code, $err_name) = $sftp->error();
47376        die("Can't open directory '.': [$err_name] ($err_code)");
47377      }
47378
47379      my $files = {};
47380
47381      my $file = $dir->read();
47382      while ($file) {
47383        $files->{$file->{name}} = $file;
47384
47385        $file = $dir->read();
47386      }
47387
47388      # To issue the FXP_CLOSE, we have to explicitly destroy the dirhandle
47389      $dir = undef;
47390
47391      foreach my $file (keys(%$files)) {
47392        next unless $file =~ /\.txt$/;
47393
47394        my $fh = $sftp->open($file, O_RDONLY);
47395        unless ($fh) {
47396          my ($err_code, $err_name) = $sftp->error();
47397          die("Can't open $file: [$err_name] ($err_code)");
47398        }
47399
47400        my $read_len = 32768;
47401        my $buf;
47402
47403        my $res = $fh->read($buf, $read_len);
47404        unless ($res) {
47405          my ($err_code, $err_name) = $sftp->error();
47406          if ($err_code != 0) {
47407            die("Can't read $file: [$err_name] ($err_code)");
47408
47409          } else {
47410            my $err_str;
47411            ($err_code, $err_name, $err_str) = $ssh2->error();
47412            die("SSH2 error: [$err_name] ($err_code) $err_str");
47413          }
47414        }
47415
47416        $fh = undef;
47417      }
47418
47419      # Explicitly disconnect without closing the file, simulating an
47420      # aborted transfer.
47421      $ssh2->disconnect();
47422
47423      # Give a little time for the server to do its end-of-session thing.
47424      sleep(1);
47425    };
47426
47427    if ($@) {
47428      $ex = $@;
47429    }
47430
47431    $wfh->print("done\n");
47432    $wfh->flush();
47433
47434  } else {
47435    eval { server_wait($config_file, $rfh) };
47436    if ($@) {
47437      warn($@);
47438      exit 1;
47439    }
47440
47441    exit 0;
47442  }
47443
47444  # Stop server
47445  server_stop($pid_file);
47446
47447  $self->assert_child_ok($pid);
47448
47449  if ($ex) {
47450    test_append_logfile($log_file, $ex);
47451    unlink($log_file);
47452
47453    die($ex);
47454  }
47455
47456  if (open(my $fh, "< $extlog_file")) {
47457    while (my $line = <$fh>) {
47458      chomp($line);
47459
47460      if ($line =~ /(\S+)\s+\S+\s+(\S+)$/) {
47461        my $cmd = $1;
47462        my $code = $2;
47463
47464        my $expected;
47465
47466        if ($cmd eq 'OPEN') {
47467          $expected = '-';
47468
47469        } elsif ($cmd eq 'CLOSE') {
47470          $expected = '0';
47471
47472        } elsif ($cmd eq 'READ') {
47473          $expected = '(-|1)';
47474
47475        } elsif ($cmd eq 'RETR') {
47476          $expected = '-';
47477
47478        } else {
47479          die("Unexpected command '$cmd' in $extlog_file");
47480        }
47481
47482        $self->assert(qr/$expected/, $code,
47483          test_msg("Expected '$expected', got '$code'"));
47484
47485      } else {
47486        die("Unexpected line '$line' in $extlog_file");
47487      }
47488    }
47489
47490    close($fh);
47491
47492  } else {
47493    die("Can't read $extlog_file: $!");
47494  }
47495
47496  unlink($log_file);
47497}
47498
47499sub sftp_log_extlog_var_s_writes {
47500  my $self = shift;
47501  my $tmpdir = $self->{tmpdir};
47502
47503  my $config_file = "$tmpdir/sftp.conf";
47504  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
47505  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
47506  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
47507
47508  my $log_file = test_get_logfile();
47509
47510  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
47511  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
47512
47513  my $user = 'proftpd';
47514  my $passwd = 'test';
47515  my $group = 'ftpd';
47516  my $home_dir = File::Spec->rel2abs($tmpdir);
47517  my $uid = 500;
47518  my $gid = 500;
47519
47520  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
47521  my $write_sz = 32;
47522
47523  # Make sure that, if we're running as root, that the home directory has
47524  # permissions/privs set for the account we create
47525  if ($< == 0) {
47526    unless (chmod(0755, $home_dir)) {
47527      die("Can't set perms on $home_dir to 0755: $!");
47528    }
47529
47530    unless (chown($uid, $gid, $home_dir)) {
47531      die("Can't set owner of $home_dir to $uid/$gid: $!");
47532    }
47533  }
47534
47535  # Create some files in the home directory to read
47536  for (my $i = 0; $i < 5; $i++) {
47537    my $path = File::Spec->rel2abs("$home_dir/$i.txt");
47538
47539    if (open(my $fh, "> $path")) {
47540      print $fh "ABCD\n" x 64;
47541
47542      unless (close($fh)) {
47543        die("Can't write $path: $!");
47544      }
47545
47546    } else {
47547      die("Can't open $path: $!");
47548    }
47549  }
47550
47551  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
47552    '/bin/bash');
47553  auth_group_write($auth_group_file, $group, $gid, $user);
47554
47555  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
47556  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
47557
47558  my $config = {
47559    PidFile => $pid_file,
47560    ScoreboardFile => $scoreboard_file,
47561    SystemLog => $log_file,
47562    TraceLog => $log_file,
47563    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
47564
47565    AuthUserFile => $auth_user_file,
47566    AuthGroupFile => $auth_group_file,
47567
47568    LogFormat => 'response "%r %s"',
47569    ExtendedLog => "$extlog_file WRITE response",
47570
47571    IfModules => {
47572      'mod_delay.c' => {
47573        DelayEngine => 'off',
47574      },
47575
47576      'mod_sftp.c' => [
47577        "SFTPEngine on",
47578        "SFTPLog $log_file",
47579        "SFTPHostKey $rsa_host_key",
47580        "SFTPHostKey $dsa_host_key",
47581      ],
47582    },
47583  };
47584
47585  my ($port, $config_user, $config_group) = config_write($config_file, $config);
47586
47587  if (open(my $fh, ">> $config_file")) {
47588    print $fh <<EOC;
47589<Limit FSETSTAT SETSTAT>
47590  DenyAll
47591</Limit>
47592EOC
47593    unless (close($fh)) {
47594      die("Can't write $config_file: $!");
47595    }
47596
47597  } else {
47598    die("Can't open $config_file: $!");
47599  }
47600
47601  # Open pipes, for use between the parent and child processes.  Specifically,
47602  # the child will indicate when it's done with its test by writing a message
47603  # to the parent.
47604  my ($rfh, $wfh);
47605  unless (pipe($rfh, $wfh)) {
47606    die("Can't open pipe: $!");
47607  }
47608
47609  require Net::SSH2;
47610
47611  my $ex;
47612
47613  # Ignore SIGPIPE
47614  local $SIG{PIPE} = sub { };
47615
47616  # Fork child
47617  $self->handle_sigchld();
47618  defined(my $pid = fork()) or die("Can't fork: $!");
47619  if ($pid) {
47620    eval {
47621      my $ssh2 = Net::SSH2->new();
47622
47623      sleep(1);
47624
47625      unless ($ssh2->connect('127.0.0.1', $port)) {
47626        my ($err_code, $err_name, $err_str) = $ssh2->error();
47627        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
47628      }
47629
47630      unless ($ssh2->auth_password($user, $passwd)) {
47631        my ($err_code, $err_name, $err_str) = $ssh2->error();
47632        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
47633      }
47634
47635      my $sftp = $ssh2->sftp();
47636      unless ($sftp) {
47637        my ($err_code, $err_name, $err_str) = $ssh2->error();
47638        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
47639      }
47640
47641      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT, 0644);
47642      unless ($fh) {
47643        my ($err_code, $err_name) = $sftp->error();
47644        die("Can't open 'test.txt': [$err_name] ($err_code)");
47645      }
47646
47647      # This is expected to fail because of the <Limit>
47648      $fh->setstat(atime => 0, mtime => 0);
47649
47650      print $fh "abcd" x 1024, "\n";
47651
47652      # This is expected to fail because of the <Limit>
47653      $fh->setstat(atime => 0, mtime => 0);
47654
47655      # Explicitly disconnect without closing the file, simulating an
47656      # aborted transfer.
47657      $ssh2->disconnect();
47658
47659      # Give a little time for the server to do its end-of-session thing.
47660      sleep(1);
47661    };
47662
47663    if ($@) {
47664      $ex = $@;
47665    }
47666
47667    $wfh->print("done\n");
47668    $wfh->flush();
47669
47670  } else {
47671    eval { server_wait($config_file, $rfh) };
47672    if ($@) {
47673      warn($@);
47674      exit 1;
47675    }
47676
47677    exit 0;
47678  }
47679
47680  # Stop server
47681  server_stop($pid_file);
47682
47683  $self->assert_child_ok($pid);
47684
47685  if ($ex) {
47686    test_append_logfile($log_file, $ex);
47687    unlink($log_file);
47688
47689    die($ex);
47690  }
47691
47692  if (open(my $fh, "< $extlog_file")) {
47693    while (my $line = <$fh>) {
47694      chomp($line);
47695
47696      if ($line =~ /(\S+)\s+\S+\s+(\S+)/) {
47697        my $cmd = $1;
47698        my $code = $2;
47699
47700        my $expected;
47701
47702        if ($cmd eq 'OPEN') {
47703          $expected = '-';
47704
47705        } elsif ($cmd eq 'CLOSE') {
47706          $expected = '0';
47707
47708        } elsif ($cmd eq 'WRITE') {
47709          $expected = '0';
47710
47711        } elsif ($cmd eq 'FSETSTAT') {
47712          $expected = '3';
47713
47714        } elsif ($cmd eq 'STOR') {
47715          $expected = '-';
47716
47717        } else {
47718          die("Unexpected command '$cmd' in $extlog_file");
47719        }
47720
47721        $self->assert(qr/$expected/, $code,
47722          test_msg("Expected '$expected', got '$code'"));
47723
47724      } else {
47725        die("Unexpected line '$line' in $extlog_file");
47726      }
47727    }
47728
47729    close($fh);
47730
47731  } else {
47732    die("Can't read $extlog_file: $!");
47733  }
47734
47735  unlink($log_file);
47736}
47737
47738sub sftp_log_extlog_file_modified_bug3457 {
47739  my $self = shift;
47740  my $tmpdir = $self->{tmpdir};
47741
47742  my $config_file = "$tmpdir/sftp.conf";
47743  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
47744  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
47745  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
47746
47747  my $log_file = test_get_logfile();
47748
47749  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
47750  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
47751
47752  my $user = 'proftpd';
47753  my $passwd = 'test';
47754  my $group = 'ftpd';
47755  my $home_dir = File::Spec->rel2abs($tmpdir);
47756  my $uid = 500;
47757  my $gid = 500;
47758
47759  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
47760  if (open(my $fh, "> $test_file")) {
47761    print $fh "Hello, World!\n";
47762    unless (close($fh)) {
47763      die("Can't write $test_file: $!");
47764    }
47765
47766  } else {
47767    die("Can't open $test_file: $!");
47768  }
47769
47770  # Make sure that, if we're running as root, that the home directory has
47771  # permissions/privs set for the account we create
47772  if ($< == 0) {
47773    unless (chmod(0755, $home_dir)) {
47774      die("Can't set perms on $home_dir to 0755: $!");
47775    }
47776
47777    unless (chown($uid, $gid, $home_dir)) {
47778      die("Can't set owner of $home_dir to $uid/$gid: $!");
47779    }
47780  }
47781
47782  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
47783    '/bin/bash');
47784  auth_group_write($auth_group_file, $group, $gid, $user);
47785
47786  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
47787  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
47788
47789  my $config = {
47790    PidFile => $pid_file,
47791    ScoreboardFile => $scoreboard_file,
47792    SystemLog => $log_file,
47793    TraceLog => $log_file,
47794    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
47795
47796    AuthUserFile => $auth_user_file,
47797    AuthGroupFile => $auth_group_file,
47798
47799    AllowOverwrite => 'on',
47800    LogFormat => 'custom "%{file-modified}"',
47801    ExtendedLog => "$extlog_file WRITE custom",
47802
47803    IfModules => {
47804      'mod_delay.c' => {
47805        DelayEngine => 'off',
47806      },
47807
47808      'mod_sftp.c' => [
47809        "SFTPEngine on",
47810        "SFTPLog $log_file",
47811        "SFTPHostKey $rsa_host_key",
47812        "SFTPHostKey $dsa_host_key",
47813      ],
47814    },
47815  };
47816
47817  my ($port, $config_user, $config_group) = config_write($config_file, $config);
47818
47819  # Open pipes, for use between the parent and child processes.  Specifically,
47820  # the child will indicate when it's done with its test by writing a message
47821  # to the parent.
47822  my ($rfh, $wfh);
47823  unless (pipe($rfh, $wfh)) {
47824    die("Can't open pipe: $!");
47825  }
47826
47827  require Net::SSH2;
47828
47829  my $ex;
47830
47831  # Ignore SIGPIPE
47832  local $SIG{PIPE} = sub { };
47833
47834  # Fork child
47835  $self->handle_sigchld();
47836  defined(my $pid = fork()) or die("Can't fork: $!");
47837  if ($pid) {
47838    eval {
47839      my $ssh2 = Net::SSH2->new();
47840
47841      sleep(1);
47842
47843      unless ($ssh2->connect('127.0.0.1', $port)) {
47844        my ($err_code, $err_name, $err_str) = $ssh2->error();
47845        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
47846      }
47847
47848      unless ($ssh2->auth_password($user, $passwd)) {
47849        my ($err_code, $err_name, $err_str) = $ssh2->error();
47850        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
47851      }
47852
47853      my $sftp = $ssh2->sftp();
47854      unless ($sftp) {
47855        my ($err_code, $err_name, $err_str) = $ssh2->error();
47856        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
47857      }
47858
47859      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT, 0644);
47860      unless ($fh) {
47861        my ($err_code, $err_name) = $sftp->error();
47862        die("Can't open 'test.txt': [$err_name] ($err_code)");
47863      }
47864
47865      $fh = undef;
47866      $sftp = undef;
47867      $ssh2->disconnect();
47868
47869      # Give a little time for the server to do its end-of-session thing.
47870      sleep(1);
47871    };
47872
47873    if ($@) {
47874      $ex = $@;
47875    }
47876
47877    $wfh->print("done\n");
47878    $wfh->flush();
47879
47880  } else {
47881    eval { server_wait($config_file, $rfh) };
47882    if ($@) {
47883      warn($@);
47884      exit 1;
47885    }
47886
47887    exit 0;
47888  }
47889
47890  # Stop server
47891  server_stop($pid_file);
47892
47893  $self->assert_child_ok($pid);
47894
47895  if ($ex) {
47896    test_append_logfile($log_file, $ex);
47897    unlink($log_file);
47898
47899    die($ex);
47900  }
47901
47902  if (open(my $fh, "< $extlog_file")) {
47903    while (my $line = <$fh>) {
47904      chomp($line);
47905
47906      my $expected = 'true';
47907      $self->assert($expected eq $line,
47908        test_msg("Expected '$expected', got '$line'"));
47909    }
47910
47911    close($fh);
47912
47913  } else {
47914    die("Can't read $extlog_file: $!");
47915  }
47916
47917  unlink($log_file);
47918}
47919
47920sub sftp_log_extlog_retr_file_size {
47921  my $self = shift;
47922  my $tmpdir = $self->{tmpdir};
47923
47924  my $config_file = "$tmpdir/sftp.conf";
47925  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
47926  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
47927  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
47928
47929  my $log_file = test_get_logfile();
47930
47931  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
47932  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
47933
47934  my $user = 'proftpd';
47935  my $passwd = 'test';
47936  my $group = 'ftpd';
47937  my $home_dir = File::Spec->rel2abs($tmpdir);
47938  my $uid = 500;
47939  my $gid = 500;
47940
47941  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
47942  my $test_sz = 32;
47943
47944  if (open(my $fh, "> $test_file")) {
47945    print $fh "A" x $test_sz;
47946    unless (close($fh)) {
47947      die("Can't write $test_file: $!");
47948    }
47949
47950  } else {
47951    die("Can't open $test_file: $!");
47952  }
47953
47954  # Make sure that, if we're running as root, that the home directory has
47955  # permissions/privs set for the account we create
47956  if ($< == 0) {
47957    unless (chmod(0755, $home_dir)) {
47958      die("Can't set perms on $home_dir to 0755: $!");
47959    }
47960
47961    unless (chown($uid, $gid, $home_dir)) {
47962      die("Can't set owner of $home_dir to $uid/$gid: $!");
47963    }
47964  }
47965
47966  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
47967    '/bin/bash');
47968  auth_group_write($auth_group_file, $group, $gid, $user);
47969
47970  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
47971  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
47972
47973  my $config = {
47974    PidFile => $pid_file,
47975    ScoreboardFile => $scoreboard_file,
47976    SystemLog => $log_file,
47977    TraceLog => $log_file,
47978    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
47979
47980    AuthUserFile => $auth_user_file,
47981    AuthGroupFile => $auth_group_file,
47982
47983    LogFormat => 'transfer "%m %b',
47984    ExtendedLog => "$extlog_file READ transfer",
47985
47986    IfModules => {
47987      'mod_delay.c' => {
47988        DelayEngine => 'off',
47989      },
47990
47991      'mod_sftp.c' => [
47992        "SFTPEngine on",
47993        "SFTPLog $log_file",
47994        "SFTPHostKey $rsa_host_key",
47995        "SFTPHostKey $dsa_host_key",
47996      ],
47997    },
47998  };
47999
48000  my ($port, $config_user, $config_group) = config_write($config_file, $config);
48001
48002  # Open pipes, for use between the parent and child processes.  Specifically,
48003  # the child will indicate when it's done with its test by writing a message
48004  # to the parent.
48005  my ($rfh, $wfh);
48006  unless (pipe($rfh, $wfh)) {
48007    die("Can't open pipe: $!");
48008  }
48009
48010  require Net::SSH2;
48011
48012  my $ex;
48013
48014  # Ignore SIGPIPE
48015  local $SIG{PIPE} = sub { };
48016
48017  # Fork child
48018  $self->handle_sigchld();
48019  defined(my $pid = fork()) or die("Can't fork: $!");
48020  if ($pid) {
48021    eval {
48022      my $ssh2 = Net::SSH2->new();
48023
48024      sleep(1);
48025
48026      unless ($ssh2->connect('127.0.0.1', $port)) {
48027        my ($err_code, $err_name, $err_str) = $ssh2->error();
48028        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
48029      }
48030
48031      unless ($ssh2->auth_password($user, $passwd)) {
48032        my ($err_code, $err_name, $err_str) = $ssh2->error();
48033        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
48034      }
48035
48036      my $sftp = $ssh2->sftp();
48037      unless ($sftp) {
48038        my ($err_code, $err_name, $err_str) = $ssh2->error();
48039        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
48040      }
48041
48042      my $fh = $sftp->open('test.txt', O_RDONLY);
48043      unless ($fh) {
48044        my ($err_code, $err_name) = $sftp->error();
48045        die("Can't open test.txt: [$err_name] ($err_code)");
48046      }
48047
48048      my $buf;
48049      my $size = 0;
48050
48051      my $res = $fh->read($buf, 8192);
48052      while ($res) {
48053        $size += $res;
48054
48055        $res = $fh->read($buf, 8192);
48056      }
48057
48058      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
48059      $fh = undef;
48060
48061      $sftp = undef;
48062      $ssh2->disconnect();
48063
48064      $self->assert($test_sz == $size,
48065        test_msg("Expected $test_sz, got $size"));
48066    };
48067
48068    if ($@) {
48069      $ex = $@;
48070    }
48071
48072    $wfh->print("done\n");
48073    $wfh->flush();
48074
48075  } else {
48076    eval { server_wait($config_file, $rfh) };
48077    if ($@) {
48078      warn($@);
48079      exit 1;
48080    }
48081
48082    exit 0;
48083  }
48084
48085  # Stop server
48086  server_stop($pid_file);
48087
48088  $self->assert_child_ok($pid);
48089
48090  if ($ex) {
48091    test_append_logfile($log_file, $ex);
48092    unlink($log_file);
48093
48094    die($ex);
48095  }
48096
48097  if (open(my $fh, "< $extlog_file")) {
48098    my $ok = 0;
48099
48100    while (my $line = <$fh>) {
48101      chomp($line);
48102
48103      if ($line =~ /^RETR (\d+)/) {
48104        my $xfer_sz = $1;
48105
48106        if ($xfer_sz == $test_sz) {
48107          $ok = 1;
48108          last;
48109        }
48110      }
48111    }
48112
48113    close($fh);
48114
48115    unless ($ok) {
48116      die("Missing expected RETR file size ($test_sz) in $extlog_file");
48117    }
48118
48119  } else {
48120    die("Can't read $extlog_file: $!");
48121  }
48122
48123  unlink($log_file);
48124}
48125
48126sub sftp_log_extlog_putty_mget_retr_file_size_bug3560 {
48127  my $self = shift;
48128  my $tmpdir = $self->{tmpdir};
48129
48130  my $config_file = "$tmpdir/sftp.conf";
48131  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
48132  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
48133  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
48134
48135  my $log_file = test_get_logfile();
48136
48137  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
48138  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
48139
48140  my $user = 'proftpd';
48141  my $passwd = 'test';
48142  my $group = 'ftpd';
48143  my $home_dir = File::Spec->rel2abs($tmpdir);
48144  my $uid = 500;
48145  my $gid = 500;
48146
48147  my $test_file1 = File::Spec->rel2abs("$tmpdir/test.txt");
48148  my $test_sz1 = 32;
48149
48150  if (open(my $fh, "> $test_file1")) {
48151    print $fh "A" x $test_sz1;
48152    unless (close($fh)) {
48153      die("Can't write $test_file1: $!");
48154    }
48155
48156  } else {
48157    die("Can't open $test_file1: $!");
48158  }
48159
48160  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
48161  my $test_sz2 = 64;
48162
48163  if (open(my $fh, "> $test_file2")) {
48164    print $fh "A" x $test_sz2;
48165    unless (close($fh)) {
48166      die("Can't write $test_file2: $!");
48167    }
48168
48169  } else {
48170    die("Can't open $test_file2: $!");
48171  }
48172
48173  # Make sure that, if we're running as root, that the home directory has
48174  # permissions/privs set for the account we create
48175  if ($< == 0) {
48176    unless (chmod(0755, $home_dir)) {
48177      die("Can't set perms on $home_dir to 0755: $!");
48178    }
48179
48180    unless (chown($uid, $gid, $home_dir)) {
48181      die("Can't set owner of $home_dir to $uid/$gid: $!");
48182    }
48183  }
48184
48185  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
48186    '/bin/bash');
48187  auth_group_write($auth_group_file, $group, $gid, $user);
48188
48189  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
48190  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
48191
48192  my $config = {
48193    PidFile => $pid_file,
48194    ScoreboardFile => $scoreboard_file,
48195    SystemLog => $log_file,
48196    TraceLog => $log_file,
48197    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
48198
48199    AuthUserFile => $auth_user_file,
48200    AuthGroupFile => $auth_group_file,
48201
48202    LogFormat => 'transfer "%m %b',
48203    ExtendedLog => "$extlog_file READ transfer",
48204
48205    IfModules => {
48206      'mod_delay.c' => {
48207        DelayEngine => 'off',
48208      },
48209
48210      'mod_sftp.c' => [
48211        "SFTPEngine on",
48212        "SFTPLog $log_file",
48213        "SFTPHostKey $rsa_host_key",
48214        "SFTPHostKey $dsa_host_key",
48215      ],
48216    },
48217  };
48218
48219  my ($port, $config_user, $config_group) = config_write($config_file, $config);
48220
48221  # Open pipes, for use between the parent and child processes.  Specifically,
48222  # the child will indicate when it's done with its test by writing a message
48223  # to the parent.
48224  my ($rfh, $wfh);
48225  unless (pipe($rfh, $wfh)) {
48226    die("Can't open pipe: $!");
48227  }
48228
48229  require Net::SSH2;
48230
48231  my $ex;
48232
48233  # Ignore SIGPIPE
48234  local $SIG{PIPE} = sub { };
48235
48236  # Fork child
48237  $self->handle_sigchld();
48238  defined(my $pid = fork()) or die("Can't fork: $!");
48239  if ($pid) {
48240    eval {
48241      my $ssh2 = Net::SSH2->new();
48242
48243      sleep(1);
48244
48245      unless ($ssh2->connect('127.0.0.1', $port)) {
48246        my ($err_code, $err_name, $err_str) = $ssh2->error();
48247        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
48248      }
48249
48250      unless ($ssh2->auth_password($user, $passwd)) {
48251        my ($err_code, $err_name, $err_str) = $ssh2->error();
48252        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
48253      }
48254
48255      my $sftp = $ssh2->sftp();
48256      unless ($sftp) {
48257        my ($err_code, $err_name, $err_str) = $ssh2->error();
48258        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
48259      }
48260
48261      # PuTTy's 'mget' does:
48262      #
48263      # OPENDIR
48264      # READDIR
48265      # <check for matching names>
48266      # OPEN matching name
48267      # READ
48268      # CLOSE
48269      # READDIR
48270      # OPEN matching name
48271      # READ
48272      # CLOSE
48273      # CLOSE <dirhandle>
48274
48275      # OPENDIR
48276      my $dir = $sftp->opendir('.');
48277      unless ($dir) {
48278        my ($err_code, $err_name) = $sftp->error();
48279        die("Can't open directory '.': [$err_name] ($err_code)");
48280      }
48281
48282      my $res = {};
48283
48284      # READDIR
48285      my $file = $dir->read();
48286      while ($file) {
48287        $res->{$file->{name}} = $file;
48288        $file = $dir->read();
48289      }
48290
48291      # OPEN file1
48292      my $fh = $sftp->open('test.txt', O_RDONLY);
48293      unless ($fh) {
48294        my ($err_code, $err_name) = $sftp->error();
48295        die("Can't open test.txt: [$err_name] ($err_code)");
48296      }
48297
48298      my $buf;
48299      my $size = 0;
48300
48301      # READ file1
48302      $res = $fh->read($buf, 8192);
48303      while ($res) {
48304        $size += $res;
48305
48306        $res = $fh->read($buf, 8192);
48307      }
48308
48309      # CLOSE file1
48310      $fh = undef;
48311
48312      # OPEN file2
48313      $fh = $sftp->open('test2.txt', O_RDONLY);
48314      unless ($fh) {
48315        my ($err_code, $err_name) = $sftp->error();
48316        die("Can't open test2.txt: [$err_name] ($err_code)");
48317      }
48318
48319      $buf = '';
48320      $size = 0;
48321
48322      # READ file2
48323      $res = $fh->read($buf, 8192);
48324      while ($res) {
48325        $size += $res;
48326
48327        $res = $fh->read($buf, 8192);
48328      }
48329
48330      # CLOSE file2
48331      $fh = undef;
48332
48333      # CLOSEDIR
48334      $dir = undef;
48335
48336      # CHANNEL_CLOSE
48337      $sftp = undef;
48338
48339      $ssh2->disconnect();
48340    };
48341
48342    if ($@) {
48343      $ex = $@;
48344    }
48345
48346    $wfh->print("done\n");
48347    $wfh->flush();
48348
48349  } else {
48350    eval { server_wait($config_file, $rfh) };
48351    if ($@) {
48352      warn($@);
48353      exit 1;
48354    }
48355
48356    exit 0;
48357  }
48358
48359  # Stop server
48360  server_stop($pid_file);
48361
48362  $self->assert_child_ok($pid);
48363
48364  if ($ex) {
48365    test_append_logfile($log_file, $ex);
48366    unlink($log_file);
48367
48368    die($ex);
48369  }
48370
48371  if (open(my $fh, "< $extlog_file")) {
48372    my $test_ok = 0;
48373    my $test2_ok = 0;
48374
48375    while (my $line = <$fh>) {
48376      chomp($line);
48377
48378      if ($line =~ /^RETR (\d+)/) {
48379        my $xfer_sz = $1;
48380
48381        if ($xfer_sz == $test_sz1) {
48382          $test_ok = 1;
48383          next;
48384        }
48385
48386        if ($xfer_sz == $test_sz2) {
48387          $test2_ok = 1;
48388          last;
48389        }
48390      }
48391    }
48392
48393    close($fh);
48394
48395    unless ($test_ok) {
48396      die("Missing expected RETR file size ($test_sz1) in $extlog_file");
48397    }
48398
48399    unless ($test2_ok) {
48400      die("Missing expected RETR file size ($test_sz2) in $extlog_file");
48401    }
48402
48403  } else {
48404    die("Can't read $extlog_file: $!");
48405  }
48406
48407  unlink($log_file);
48408}
48409
48410sub sftp_log_extlog_var_F_mkdir_rmdir_bug3591 {
48411  my $self = shift;
48412  my $tmpdir = $self->{tmpdir};
48413
48414  my $config_file = "$tmpdir/sftp.conf";
48415  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
48416  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
48417  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
48418
48419  my $log_file = test_get_logfile();
48420
48421  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
48422  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
48423
48424  my $user = 'proftpd';
48425  my $passwd = 'test';
48426  my $group = 'ftpd';
48427  my $home_dir = File::Spec->rel2abs($tmpdir);
48428  my $uid = 500;
48429  my $gid = 500;
48430
48431  # Make sure that, if we're running as root, that the home directory has
48432  # permissions/privs set for the account we create
48433  if ($< == 0) {
48434    unless (chmod(0755, $home_dir)) {
48435      die("Can't set perms on $home_dir to 0755: $!");
48436    }
48437
48438    unless (chown($uid, $gid, $home_dir)) {
48439      die("Can't set owner of $home_dir to $uid/$gid: $!");
48440    }
48441  }
48442
48443  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
48444    '/bin/bash');
48445  auth_group_write($auth_group_file, $group, $gid, $user);
48446
48447  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
48448  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
48449
48450  my $test_dir = File::Spec->rel2abs("$tmpdir/testdir");
48451
48452  my $config = {
48453    PidFile => $pid_file,
48454    ScoreboardFile => $scoreboard_file,
48455    SystemLog => $log_file,
48456    TraceLog => $log_file,
48457    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
48458
48459    AuthUserFile => $auth_user_file,
48460    AuthGroupFile => $auth_group_file,
48461    DefaultRoot => '~',
48462
48463    LogFormat => 'dirlog "%m %F"',
48464    ExtendedLog => "$extlog_file WRITE dirlog",
48465
48466    IfModules => {
48467      'mod_delay.c' => {
48468        DelayEngine => 'off',
48469      },
48470
48471      'mod_sftp.c' => [
48472        "SFTPEngine on",
48473        "SFTPLog $log_file",
48474        "SFTPHostKey $rsa_host_key",
48475        "SFTPHostKey $dsa_host_key",
48476      ],
48477    },
48478  };
48479
48480  my ($port, $config_user, $config_group) = config_write($config_file, $config);
48481
48482  # Open pipes, for use between the parent and child processes.  Specifically,
48483  # the child will indicate when it's done with its test by writing a message
48484  # to the parent.
48485  my ($rfh, $wfh);
48486  unless (pipe($rfh, $wfh)) {
48487    die("Can't open pipe: $!");
48488  }
48489
48490  require Net::SSH2;
48491
48492  my $ex;
48493
48494  # Ignore SIGPIPE
48495  local $SIG{PIPE} = sub { };
48496
48497  # Fork child
48498  $self->handle_sigchld();
48499  defined(my $pid = fork()) or die("Can't fork: $!");
48500  if ($pid) {
48501    eval {
48502      my $ssh2 = Net::SSH2->new();
48503
48504      sleep(1);
48505
48506      unless ($ssh2->connect('127.0.0.1', $port)) {
48507        my ($err_code, $err_name, $err_str) = $ssh2->error();
48508        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
48509      }
48510
48511      unless ($ssh2->auth_password($user, $passwd)) {
48512        my ($err_code, $err_name, $err_str) = $ssh2->error();
48513        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
48514      }
48515
48516      my $sftp = $ssh2->sftp();
48517      unless ($sftp) {
48518        my ($err_code, $err_name, $err_str) = $ssh2->error();
48519        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
48520      }
48521
48522      my $res = $sftp->mkdir('testdir');
48523      unless ($res) {
48524        my ($err_code, $err_name) = $sftp->error();
48525        die("Can't mkdir testdir: [$err_name] ($err_code)");
48526      }
48527
48528      $res = $sftp->rmdir('testdir');
48529      unless ($res) {
48530        my ($err_code, $err_name) = $sftp->error();
48531        die("Can't rmdir testdir: [$err_name] ($err_code)");
48532      }
48533
48534      $sftp = undef;
48535      $ssh2->disconnect();
48536
48537      if (-d $test_dir) {
48538        die("$test_dir directory exists unexpectedly");
48539      }
48540    };
48541
48542    if ($@) {
48543      $ex = $@;
48544    }
48545
48546    $wfh->print("done\n");
48547    $wfh->flush();
48548
48549  } else {
48550    eval { server_wait($config_file, $rfh) };
48551    if ($@) {
48552      warn($@);
48553      exit 1;
48554    }
48555
48556    exit 0;
48557  }
48558
48559  # Stop server
48560  server_stop($pid_file);
48561
48562  $self->assert_child_ok($pid);
48563
48564  if ($ex) {
48565    test_append_logfile($log_file, $ex);
48566    unlink($log_file);
48567
48568    die($ex);
48569  }
48570
48571  if (open(my $fh, "< $extlog_file")) {
48572    my $mkdir_ok = 0;
48573    my $rmdir_ok = 0;
48574
48575    while (my $line = <$fh>) {
48576      chomp($line);
48577
48578      if ($line =~ /(\S+)\s+(\S+)$/) {
48579        my $cmd = $1;
48580        my $dir_path = $2;
48581
48582        if ($cmd eq 'MKD' ||
48583            $cmd eq 'RMD') {
48584            my $expected = '/testdir';
48585
48586            $self->assert($expected eq $dir_path,
48587              test_msg("Expected '$expected', got '$dir_path'"));
48588
48589        } elsif ($cmd eq 'MKDIR') {
48590          $mkdir_ok = 1;
48591
48592        } elsif ($cmd eq 'RMDIR') {
48593          $rmdir_ok = 1;
48594
48595        } else {
48596          die("Unexpected command '$cmd' in $extlog_file");
48597        }
48598
48599      } else {
48600        die("Unexpected line '$line' in $extlog_file");
48601      }
48602    }
48603
48604    close($fh);
48605
48606    $self->assert($mkdir_ok == 1,
48607      test_msg("Expected to see 'MKDIR' command but it was missing"));
48608    $self->assert($rmdir_ok == 1,
48609      test_msg("Expected to see 'RMDIR' command but it was missing"));
48610
48611  } else {
48612    die("Can't read $extlog_file: $!");
48613  }
48614
48615  unlink($log_file);
48616}
48617
48618sub sftp_log_extlog_var_w_rename_bug3029 {
48619  my $self = shift;
48620  my $tmpdir = $self->{tmpdir};
48621
48622  my $config_file = "$tmpdir/sftp.conf";
48623  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
48624  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
48625  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
48626
48627  my $log_file = test_get_logfile();
48628
48629  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
48630  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
48631
48632  my $user = 'proftpd';
48633  my $passwd = 'test';
48634  my $group = 'ftpd';
48635  my $home_dir = File::Spec->rel2abs($tmpdir);
48636  my $uid = 500;
48637  my $gid = 500;
48638
48639  my $test_file1 = File::Spec->rel2abs("$tmpdir/test.txt");
48640  if (open(my $fh, "> $test_file1")) {
48641    print $fh "ABCD" x 8192;
48642
48643    unless (close($fh)) {
48644      die("Can't write $test_file1: $!");
48645    }
48646
48647  } else {
48648    die("Can't open $test_file1: $!");
48649  }
48650
48651  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
48652
48653  # Make sure that, if we're running as root, that the home directory has
48654  # permissions/privs set for the account we create
48655  if ($< == 0) {
48656    unless (chmod(0755, $home_dir)) {
48657      die("Can't set perms on $home_dir to 0755: $!");
48658    }
48659
48660    unless (chown($uid, $gid, $home_dir)) {
48661      die("Can't set owner of $home_dir to $uid/$gid: $!");
48662    }
48663  }
48664
48665  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
48666    '/bin/bash');
48667  auth_group_write($auth_group_file, $group, $gid, $user);
48668
48669  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
48670  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
48671
48672  my $config = {
48673    PidFile => $pid_file,
48674    ScoreboardFile => $scoreboard_file,
48675    SystemLog => $log_file,
48676    TraceLog => $log_file,
48677    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
48678
48679    AuthUserFile => $auth_user_file,
48680    AuthGroupFile => $auth_group_file,
48681
48682    LogFormat => 'rename "%m: %w %f"',
48683    ExtendedLog => "$extlog_file ALL rename",
48684
48685    IfModules => {
48686      'mod_delay.c' => {
48687        DelayEngine => 'off',
48688      },
48689
48690      'mod_sftp.c' => [
48691        "SFTPEngine on",
48692        "SFTPLog $log_file",
48693        "SFTPHostKey $rsa_host_key",
48694        "SFTPHostKey $dsa_host_key",
48695      ],
48696    },
48697  };
48698
48699  my ($port, $config_user, $config_group) = config_write($config_file, $config);
48700
48701  # Open pipes, for use between the parent and child processes.  Specifically,
48702  # the child will indicate when it's done with its test by writing a message
48703  # to the parent.
48704  my ($rfh, $wfh);
48705  unless (pipe($rfh, $wfh)) {
48706    die("Can't open pipe: $!");
48707  }
48708
48709  require Net::SSH2;
48710
48711  my $ex;
48712
48713  # Ignore SIGPIPE
48714  local $SIG{PIPE} = sub { };
48715
48716  # Fork child
48717  $self->handle_sigchld();
48718  defined(my $pid = fork()) or die("Can't fork: $!");
48719  if ($pid) {
48720    eval {
48721      my $ssh2 = Net::SSH2->new();
48722
48723      sleep(1);
48724
48725      unless ($ssh2->connect('127.0.0.1', $port)) {
48726        my ($err_code, $err_name, $err_str) = $ssh2->error();
48727        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
48728      }
48729
48730      unless ($ssh2->auth_password($user, $passwd)) {
48731        my ($err_code, $err_name, $err_str) = $ssh2->error();
48732        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
48733      }
48734
48735      my $sftp = $ssh2->sftp();
48736      unless ($sftp) {
48737        my ($err_code, $err_name, $err_str) = $ssh2->error();
48738        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
48739      }
48740
48741      my $res = $sftp->rename('test.txt', 'test2.txt');
48742      unless ($res) {
48743        my ($err_code, $err_name) = $sftp->error();
48744        die("Can't rename test.txt to test2.txt: [$err_name] ($err_code)");
48745      }
48746
48747      $sftp = undef;
48748      $ssh2->disconnect();
48749
48750      if (-f $test_file1) {
48751        die("$test_file1 file exists unexpectedly");
48752      }
48753
48754      unless (-f $test_file2) {
48755        die("$test_file2 file does not exist as expected");
48756      }
48757    };
48758
48759    if ($@) {
48760      $ex = $@;
48761    }
48762
48763    $wfh->print("done\n");
48764    $wfh->flush();
48765
48766  } else {
48767    eval { server_wait($config_file, $rfh) };
48768    if ($@) {
48769      warn($@);
48770      exit 1;
48771    }
48772
48773    exit 0;
48774  }
48775
48776  # Stop server
48777  server_stop($pid_file);
48778
48779  $self->assert_child_ok($pid);
48780
48781  if ($ex) {
48782    test_append_logfile($log_file, $ex);
48783    unlink($log_file);
48784
48785    die($ex);
48786  }
48787
48788  if (open(my $fh, "< $extlog_file")) {
48789    my $ok = 0;
48790
48791    while (my $line = <$fh>) {
48792      chomp($line);
48793
48794      if ($line =~ /(\S+):\s+(\S+)\s+(\S+)$/) {
48795        my $cmd = $1;
48796        my $whence = $2;
48797        my $whither = $3;
48798
48799        my $expected;
48800
48801        if ($cmd eq 'RNFR') {
48802
48803          $expected = '-';
48804          $self->assert($expected eq $whence,
48805            test_msg("Expected '$expected', got '$whence'"));
48806
48807          $expected = $test_file1;
48808          if ($^O eq 'darwin') {
48809            # MacOSX-specific hack to deal with how it handles tmp files
48810            $expected = ('/private' . $expected);
48811          }
48812
48813          $self->assert($expected eq $whither,
48814            test_msg("Expected '$expected', got '$whither'"));
48815
48816        } elsif ($cmd eq 'RNTO') {
48817          $expected = $test_file1;
48818          if ($^O eq 'darwin') {
48819            # MacOSX-specific hack to deal with how it handles tmp files
48820            $expected = ('/private' . $expected);
48821          }
48822
48823          $self->assert($expected eq $whence,
48824            test_msg("Expected '$expected', got '$whence'"));
48825
48826          $expected = $test_file2;
48827          if ($^O eq 'darwin') {
48828            # MacOSX-specific hack to deal with how it handles tmp files
48829            $expected = ('/private' . $expected);
48830          }
48831
48832          $self->assert($expected eq $whither,
48833            test_msg("Expected '$expected', got '$whither'"));
48834
48835        } elsif ($cmd eq 'RENAME') {
48836          $expected = '-';
48837
48838          $self->assert($expected eq $whence,
48839            test_msg("Expected '$expected', got '$whence'"));
48840          $self->assert($expected eq $whither,
48841            test_msg("Expected '$expected', got '$whither'"));
48842
48843          $ok = 1;
48844
48845        } else {
48846          next;
48847        }
48848
48849      } else {
48850        die("Unexpected line '$line' in $extlog_file");
48851      }
48852    }
48853
48854    close($fh);
48855
48856    $self->assert($ok, test_msg("Did not find expected ExtendedLog lines"));
48857
48858  } else {
48859    die("Can't read $extlog_file: $!");
48860  }
48861
48862  unlink($log_file);
48863}
48864
48865sub sftp_log_extlog_var_f_remove {
48866  my $self = shift;
48867  my $tmpdir = $self->{tmpdir};
48868
48869  my $config_file = "$tmpdir/sftp.conf";
48870  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
48871  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
48872  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
48873
48874  my $log_file = test_get_logfile();
48875
48876  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
48877  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
48878
48879  my $user = 'proftpd';
48880  my $passwd = 'test';
48881  my $group = 'ftpd';
48882  my $home_dir = File::Spec->rel2abs($tmpdir);
48883  my $uid = 500;
48884  my $gid = 500;
48885
48886  my $write_sz = 32;
48887
48888  # Make sure that, if we're running as root, that the home directory has
48889  # permissions/privs set for the account we create
48890  if ($< == 0) {
48891    unless (chmod(0755, $home_dir)) {
48892      die("Can't set perms on $home_dir to 0755: $!");
48893    }
48894
48895    unless (chown($uid, $gid, $home_dir)) {
48896      die("Can't set owner of $home_dir to $uid/$gid: $!");
48897    }
48898  }
48899
48900  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
48901  if (open(my $fh, "> $test_file")) {
48902    print $fh "ABCD\n" x 64;
48903
48904    unless (close($fh)) {
48905      die("Can't write $test_file: $!");
48906    }
48907
48908  } else {
48909    die("Can't open $test_file: $!");
48910  }
48911
48912  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
48913    '/bin/bash');
48914  auth_group_write($auth_group_file, $group, $gid, $user);
48915
48916  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
48917  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
48918
48919  my $config = {
48920    PidFile => $pid_file,
48921    ScoreboardFile => $scoreboard_file,
48922    SystemLog => $log_file,
48923    TraceLog => $log_file,
48924    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
48925
48926    AuthUserFile => $auth_user_file,
48927    AuthGroupFile => $auth_group_file,
48928
48929    LogFormat => 'delete "%m %f"',
48930    ExtendedLog => "$extlog_file WRITE delete",
48931
48932    IfModules => {
48933      'mod_delay.c' => {
48934        DelayEngine => 'off',
48935      },
48936
48937      'mod_sftp.c' => [
48938        "SFTPEngine on",
48939        "SFTPLog $log_file",
48940        "SFTPHostKey $rsa_host_key",
48941        "SFTPHostKey $dsa_host_key",
48942      ],
48943    },
48944  };
48945
48946  my ($port, $config_user, $config_group) = config_write($config_file, $config);
48947
48948  # Open pipes, for use between the parent and child processes.  Specifically,
48949  # the child will indicate when it's done with its test by writing a message
48950  # to the parent.
48951  my ($rfh, $wfh);
48952  unless (pipe($rfh, $wfh)) {
48953    die("Can't open pipe: $!");
48954  }
48955
48956  require Net::SSH2;
48957
48958  my $ex;
48959
48960  # Ignore SIGPIPE
48961  local $SIG{PIPE} = sub { };
48962
48963  # Fork child
48964  $self->handle_sigchld();
48965  defined(my $pid = fork()) or die("Can't fork: $!");
48966  if ($pid) {
48967    eval {
48968      my $ssh2 = Net::SSH2->new();
48969
48970      sleep(1);
48971
48972      unless ($ssh2->connect('127.0.0.1', $port)) {
48973        my ($err_code, $err_name, $err_str) = $ssh2->error();
48974        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
48975      }
48976
48977      unless ($ssh2->auth_password($user, $passwd)) {
48978        my ($err_code, $err_name, $err_str) = $ssh2->error();
48979        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
48980      }
48981
48982      my $sftp = $ssh2->sftp();
48983      unless ($sftp) {
48984        my ($err_code, $err_name, $err_str) = $ssh2->error();
48985        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
48986      }
48987
48988      my $res = $sftp->unlink('test.txt');
48989      unless ($res) {
48990        my ($err_code, $err_name) = $sftp->error();
48991        die("Can't remove test.txt: [$err_name] ($err_code)");
48992      }
48993
48994      $sftp = undef;
48995      $ssh2->disconnect();
48996
48997      if (-f $test_file) {
48998        die("$test_file file exists unexpectedly");
48999      }
49000    };
49001
49002    if ($@) {
49003      $ex = $@;
49004    }
49005
49006    $wfh->print("done\n");
49007    $wfh->flush();
49008
49009  } else {
49010    eval { server_wait($config_file, $rfh) };
49011    if ($@) {
49012      warn($@);
49013      exit 1;
49014    }
49015
49016    exit 0;
49017  }
49018
49019  # Stop server
49020  server_stop($pid_file);
49021
49022  $self->assert_child_ok($pid);
49023
49024  if ($ex) {
49025    test_append_logfile($log_file, $ex);
49026    unlink($log_file);
49027
49028    die($ex);
49029  }
49030
49031  if (open(my $fh, "< $extlog_file")) {
49032    my $ok = 0;
49033
49034    while (my $line = <$fh>) {
49035      chomp($line);
49036
49037      if ($line =~ /(\S+) (.*)$/) {
49038        my $cmd = $1;
49039        my $path = $2;
49040
49041        next unless $cmd eq 'DELE';
49042
49043        my $expected = $test_file;
49044        if ($^O eq 'darwin') {
49045          # MacOSX-specific hack to deal with how it handles tmp files
49046          $expected = ('/private' . $expected);
49047        }
49048
49049        $self->assert($expected eq $path,
49050          test_msg("Expected file '$expected', got '$path'"));
49051
49052        $ok = 1;
49053        last;
49054      }
49055    }
49056
49057    close($fh);
49058
49059    $self->assert($ok,
49060      test_msg("Expected ExtendedLog lines did not appear as expected"));
49061
49062  } else {
49063    die("Can't read $extlog_file: $!");
49064  }
49065
49066  unlink($log_file);
49067}
49068
49069sub sftp_log_extlog_var_f_write {
49070  my $self = shift;
49071  my $tmpdir = $self->{tmpdir};
49072
49073  my $config_file = "$tmpdir/sftp.conf";
49074  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
49075  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
49076  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
49077
49078  my $log_file = test_get_logfile();
49079
49080  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
49081  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
49082
49083  my $user = 'proftpd';
49084  my $passwd = 'test';
49085  my $group = 'ftpd';
49086  my $home_dir = File::Spec->rel2abs($tmpdir);
49087  my $uid = 500;
49088  my $gid = 500;
49089
49090  # Make sure that, if we're running as root, that the home directory has
49091  # permissions/privs set for the account we create
49092  if ($< == 0) {
49093    unless (chmod(0755, $home_dir)) {
49094      die("Can't set perms on $home_dir to 0755: $!");
49095    }
49096
49097    unless (chown($uid, $gid, $home_dir)) {
49098      die("Can't set owner of $home_dir to $uid/$gid: $!");
49099    }
49100  }
49101
49102  my $write_sz = 32;
49103  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
49104
49105  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
49106    '/bin/bash');
49107  auth_group_write($auth_group_file, $group, $gid, $user);
49108
49109  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
49110  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
49111
49112  my $config = {
49113    PidFile => $pid_file,
49114    ScoreboardFile => $scoreboard_file,
49115    SystemLog => $log_file,
49116    TraceLog => $log_file,
49117    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
49118
49119    AuthUserFile => $auth_user_file,
49120    AuthGroupFile => $auth_group_file,
49121
49122    LogFormat => 'writes "%f: %r"',
49123    ExtendedLog => "$extlog_file WRITE writes",
49124
49125    IfModules => {
49126      'mod_delay.c' => {
49127        DelayEngine => 'off',
49128      },
49129
49130      'mod_sftp.c' => [
49131        "SFTPEngine on",
49132        "SFTPLog $log_file",
49133        "SFTPHostKey $rsa_host_key",
49134        "SFTPHostKey $dsa_host_key",
49135      ],
49136    },
49137  };
49138
49139  my ($port, $config_user, $config_group) = config_write($config_file, $config);
49140
49141  # Open pipes, for use between the parent and child processes.  Specifically,
49142  # the child will indicate when it's done with its test by writing a message
49143  # to the parent.
49144  my ($rfh, $wfh);
49145  unless (pipe($rfh, $wfh)) {
49146    die("Can't open pipe: $!");
49147  }
49148
49149  require Net::SSH2;
49150
49151  my $ex;
49152
49153  # Ignore SIGPIPE
49154  local $SIG{PIPE} = sub { };
49155
49156  # Fork child
49157  $self->handle_sigchld();
49158  defined(my $pid = fork()) or die("Can't fork: $!");
49159  if ($pid) {
49160    eval {
49161      my $ssh2 = Net::SSH2->new();
49162
49163      sleep(1);
49164
49165      unless ($ssh2->connect('127.0.0.1', $port)) {
49166        my ($err_code, $err_name, $err_str) = $ssh2->error();
49167        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
49168      }
49169
49170      unless ($ssh2->auth_password($user, $passwd)) {
49171        my ($err_code, $err_name, $err_str) = $ssh2->error();
49172        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
49173      }
49174
49175      my $sftp = $ssh2->sftp();
49176      unless ($sftp) {
49177        my ($err_code, $err_name, $err_str) = $ssh2->error();
49178        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
49179      }
49180
49181      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
49182      unless ($fh) {
49183        my ($err_code, $err_name) = $sftp->error();
49184        die("Can't open test.txt: [$err_name] ($err_code)");
49185      }
49186
49187      my $count = 5;
49188      for (my $i = 0; $i < $count; $i++) {
49189        print $fh "ABCD" x 8;
49190      }
49191
49192      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
49193      $fh = undef;
49194
49195      $sftp = undef;
49196      $ssh2->disconnect();
49197    };
49198
49199    if ($@) {
49200      $ex = $@;
49201    }
49202
49203    $wfh->print("done\n");
49204    $wfh->flush();
49205
49206  } else {
49207    eval { server_wait($config_file, $rfh) };
49208    if ($@) {
49209      warn($@);
49210      exit 1;
49211    }
49212
49213    exit 0;
49214  }
49215
49216  # Stop server
49217  server_stop($pid_file);
49218
49219  $self->assert_child_ok($pid);
49220
49221  if ($ex) {
49222    test_append_logfile($log_file, $ex);
49223    unlink($log_file);
49224
49225    die($ex);
49226  }
49227
49228  if (open(my $fh, "< $extlog_file")) {
49229    my $ok = 0;
49230
49231    while (my $line = <$fh>) {
49232      chomp($line);
49233
49234      if ($line =~ /^(\S+):\s+(\S+)\s+(\S+)\s+(\d+)\s+(\d+)/) {
49235        my $path = $1;
49236        my $req = $2;
49237        my $handle = $3;
49238        my $offset = $4;
49239        my $chunklen = $5;
49240
49241        if ($req eq 'WRITE') {
49242          my $expected = $test_file;
49243          if ($^O eq 'darwin') {
49244            # MacOSX-specific hack to deal with how it handles tmp files
49245            $expected = ('/private' . $expected);
49246          }
49247
49248          if ($path eq $expected) {
49249            $ok = 1;
49250          }
49251        }
49252      }
49253    }
49254
49255    close($fh);
49256
49257    $self->assert($ok,
49258      test_msg("Expected ExtendedLog lines did not appear as expected"));
49259
49260  } else {
49261    die("Can't read $extlog_file: $!");
49262  }
49263
49264  unlink($log_file);
49265}
49266
49267sub sftp_log_extlog_var_f_write_chrooted {
49268  my $self = shift;
49269  my $tmpdir = $self->{tmpdir};
49270
49271  my $config_file = "$tmpdir/sftp.conf";
49272  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
49273  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
49274  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
49275
49276  my $log_file = test_get_logfile();
49277
49278  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
49279  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
49280
49281  my $user = 'proftpd';
49282  my $passwd = 'test';
49283  my $group = 'ftpd';
49284  my $home_dir = File::Spec->rel2abs($tmpdir);
49285  my $uid = 500;
49286  my $gid = 500;
49287
49288  # Make sure that, if we're running as root, that the home directory has
49289  # permissions/privs set for the account we create
49290  if ($< == 0) {
49291    unless (chmod(0755, $home_dir)) {
49292      die("Can't set perms on $home_dir to 0755: $!");
49293    }
49294
49295    unless (chown($uid, $gid, $home_dir)) {
49296      die("Can't set owner of $home_dir to $uid/$gid: $!");
49297    }
49298  }
49299
49300  my $write_sz = 32;
49301  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
49302
49303  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
49304    '/bin/bash');
49305  auth_group_write($auth_group_file, $group, $gid, $user);
49306
49307  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
49308  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
49309
49310  my $config = {
49311    PidFile => $pid_file,
49312    ScoreboardFile => $scoreboard_file,
49313    SystemLog => $log_file,
49314    TraceLog => $log_file,
49315    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
49316
49317    AuthUserFile => $auth_user_file,
49318    AuthGroupFile => $auth_group_file,
49319    DefaultRoot => '~',
49320
49321    LogFormat => 'writes "%f: %r"',
49322    ExtendedLog => "$extlog_file WRITE writes",
49323
49324    IfModules => {
49325      'mod_delay.c' => {
49326        DelayEngine => 'off',
49327      },
49328
49329      'mod_sftp.c' => [
49330        "SFTPEngine on",
49331        "SFTPLog $log_file",
49332        "SFTPHostKey $rsa_host_key",
49333        "SFTPHostKey $dsa_host_key",
49334      ],
49335    },
49336  };
49337
49338  my ($port, $config_user, $config_group) = config_write($config_file, $config);
49339
49340  # Open pipes, for use between the parent and child processes.  Specifically,
49341  # the child will indicate when it's done with its test by writing a message
49342  # to the parent.
49343  my ($rfh, $wfh);
49344  unless (pipe($rfh, $wfh)) {
49345    die("Can't open pipe: $!");
49346  }
49347
49348  require Net::SSH2;
49349
49350  my $ex;
49351
49352  # Ignore SIGPIPE
49353  local $SIG{PIPE} = sub { };
49354
49355  # Fork child
49356  $self->handle_sigchld();
49357  defined(my $pid = fork()) or die("Can't fork: $!");
49358  if ($pid) {
49359    eval {
49360      my $ssh2 = Net::SSH2->new();
49361
49362      sleep(1);
49363
49364      unless ($ssh2->connect('127.0.0.1', $port)) {
49365        my ($err_code, $err_name, $err_str) = $ssh2->error();
49366        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
49367      }
49368
49369      unless ($ssh2->auth_password($user, $passwd)) {
49370        my ($err_code, $err_name, $err_str) = $ssh2->error();
49371        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
49372      }
49373
49374      my $sftp = $ssh2->sftp();
49375      unless ($sftp) {
49376        my ($err_code, $err_name, $err_str) = $ssh2->error();
49377        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
49378      }
49379
49380      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
49381      unless ($fh) {
49382        my ($err_code, $err_name) = $sftp->error();
49383        die("Can't open test.txt: [$err_name] ($err_code)");
49384      }
49385
49386      my $count = 5;
49387      for (my $i = 0; $i < $count; $i++) {
49388        print $fh "ABCD" x 8;
49389      }
49390
49391      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
49392      $fh = undef;
49393
49394      $sftp = undef;
49395      $ssh2->disconnect();
49396    };
49397
49398    if ($@) {
49399      $ex = $@;
49400    }
49401
49402    $wfh->print("done\n");
49403    $wfh->flush();
49404
49405  } else {
49406    eval { server_wait($config_file, $rfh) };
49407    if ($@) {
49408      warn($@);
49409      exit 1;
49410    }
49411
49412    exit 0;
49413  }
49414
49415  # Stop server
49416  server_stop($pid_file);
49417
49418  $self->assert_child_ok($pid);
49419
49420  if ($ex) {
49421    test_append_logfile($log_file, $ex);
49422    unlink($log_file);
49423
49424    die($ex);
49425  }
49426
49427  if (open(my $fh, "< $extlog_file")) {
49428    my $ok = 0;
49429
49430    while (my $line = <$fh>) {
49431      chomp($line);
49432
49433      if ($line =~ /^(\S+):\s+(\S+)\s+(\S+)\s+(\d+)\s+(\d+)/) {
49434        my $path = $1;
49435        my $req = $2;
49436        my $handle = $3;
49437        my $offset = $4;
49438        my $chunklen = $5;
49439
49440        if ($req eq 'WRITE') {
49441          my $expected = $test_file;
49442          if ($^O eq 'darwin') {
49443            # MacOSX-specific hack to deal with how it handles tmp files
49444            $expected = ('/private' . $expected);
49445          }
49446
49447          if ($path eq $expected) {
49448            $ok = 1;
49449          }
49450        }
49451      }
49452    }
49453
49454    close($fh);
49455
49456    $self->assert($ok,
49457      test_msg("Expected ExtendedLog lines did not appear as expected"));
49458
49459  } else {
49460    die("Can't read $extlog_file: $!");
49461  }
49462
49463  unlink($log_file);
49464}
49465
49466sub sftp_log_extlog_var_r_write {
49467  my $self = shift;
49468  my $tmpdir = $self->{tmpdir};
49469
49470  my $config_file = "$tmpdir/sftp.conf";
49471  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
49472  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
49473  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
49474
49475  my $log_file = test_get_logfile();
49476
49477  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
49478  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
49479
49480  my $user = 'proftpd';
49481  my $passwd = 'test';
49482  my $group = 'ftpd';
49483  my $home_dir = File::Spec->rel2abs($tmpdir);
49484  my $uid = 500;
49485  my $gid = 500;
49486
49487  # Make sure that, if we're running as root, that the home directory has
49488  # permissions/privs set for the account we create
49489  if ($< == 0) {
49490    unless (chmod(0755, $home_dir)) {
49491      die("Can't set perms on $home_dir to 0755: $!");
49492    }
49493
49494    unless (chown($uid, $gid, $home_dir)) {
49495      die("Can't set owner of $home_dir to $uid/$gid: $!");
49496    }
49497  }
49498
49499  my $write_sz = 32;
49500  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
49501
49502  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
49503    '/bin/bash');
49504  auth_group_write($auth_group_file, $group, $gid, $user);
49505
49506  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
49507  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
49508
49509  my $config = {
49510    PidFile => $pid_file,
49511    ScoreboardFile => $scoreboard_file,
49512    SystemLog => $log_file,
49513    TraceLog => $log_file,
49514    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
49515
49516    AuthUserFile => $auth_user_file,
49517    AuthGroupFile => $auth_group_file,
49518
49519    LogFormat => 'writes "%r"',
49520    ExtendedLog => "$extlog_file WRITE writes",
49521
49522    IfModules => {
49523      'mod_delay.c' => {
49524        DelayEngine => 'off',
49525      },
49526
49527      'mod_sftp.c' => [
49528        "SFTPEngine on",
49529        "SFTPLog $log_file",
49530        "SFTPHostKey $rsa_host_key",
49531        "SFTPHostKey $dsa_host_key",
49532      ],
49533    },
49534  };
49535
49536  my ($port, $config_user, $config_group) = config_write($config_file, $config);
49537
49538  # Open pipes, for use between the parent and child processes.  Specifically,
49539  # the child will indicate when it's done with its test by writing a message
49540  # to the parent.
49541  my ($rfh, $wfh);
49542  unless (pipe($rfh, $wfh)) {
49543    die("Can't open pipe: $!");
49544  }
49545
49546  require Net::SSH2;
49547
49548  my $ex;
49549
49550  # Ignore SIGPIPE
49551  local $SIG{PIPE} = sub { };
49552
49553  # Fork child
49554  $self->handle_sigchld();
49555  defined(my $pid = fork()) or die("Can't fork: $!");
49556  if ($pid) {
49557    eval {
49558      my $ssh2 = Net::SSH2->new();
49559
49560      sleep(1);
49561
49562      unless ($ssh2->connect('127.0.0.1', $port)) {
49563        my ($err_code, $err_name, $err_str) = $ssh2->error();
49564        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
49565      }
49566
49567      unless ($ssh2->auth_password($user, $passwd)) {
49568        my ($err_code, $err_name, $err_str) = $ssh2->error();
49569        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
49570      }
49571
49572      my $sftp = $ssh2->sftp();
49573      unless ($sftp) {
49574        my ($err_code, $err_name, $err_str) = $ssh2->error();
49575        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
49576      }
49577
49578      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
49579      unless ($fh) {
49580        my ($err_code, $err_name) = $sftp->error();
49581        die("Can't open test.txt: [$err_name] ($err_code)");
49582      }
49583
49584      my $count = 5;
49585      for (my $i = 0; $i < $count; $i++) {
49586        print $fh "ABCD" x 8;
49587      }
49588
49589      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
49590      $fh = undef;
49591
49592      $sftp = undef;
49593      $ssh2->disconnect();
49594    };
49595
49596    if ($@) {
49597      $ex = $@;
49598    }
49599
49600    $wfh->print("done\n");
49601    $wfh->flush();
49602
49603  } else {
49604    eval { server_wait($config_file, $rfh) };
49605    if ($@) {
49606      warn($@);
49607      exit 1;
49608    }
49609
49610    exit 0;
49611  }
49612
49613  # Stop server
49614  server_stop($pid_file);
49615
49616  $self->assert_child_ok($pid);
49617
49618  if ($ex) {
49619    test_append_logfile($log_file, $ex);
49620    unlink($log_file);
49621
49622    die($ex);
49623  }
49624
49625  if (open(my $fh, "< $extlog_file")) {
49626    my $ok = 0;
49627
49628    while (my $line = <$fh>) {
49629      chomp($line);
49630
49631      if ($line =~ /^(\S+)\s+(\S+)\s+(\d+)\s+(\d+)/) {
49632        my $req = $1;
49633        my $handle = $2;
49634        my $offset = $3;
49635        my $chunklen = $4;
49636
49637        if ($req eq 'WRITE') {
49638          if ($chunklen == 32) {
49639            $ok = 1;
49640          }
49641        }
49642      }
49643    }
49644
49645    close($fh);
49646
49647    $self->assert($ok,
49648      test_msg("Expected ExtendedLog lines did not appear as expected"));
49649
49650  } else {
49651    die("Can't read $extlog_file: $!");
49652  }
49653
49654  unlink($log_file);
49655}
49656
49657sub sftp_log_extlog_var_note_bug3707 {
49658  my $self = shift;
49659  my $tmpdir = $self->{tmpdir};
49660
49661  my $config_file = "$tmpdir/sftp.conf";
49662  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
49663  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
49664  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
49665
49666  my $log_file = test_get_logfile();
49667
49668  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
49669  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
49670
49671  my $user = 'proftpd';
49672  my $passwd = 'test';
49673  my $group = 'ftpd';
49674  my $home_dir = File::Spec->rel2abs($tmpdir);
49675  my $uid = 500;
49676  my $gid = 500;
49677
49678  my $write_sz = 32;
49679
49680  my $test_file = File::Spec->rel2abs("$home_dir/test.txt");
49681  if (open(my $fh, "> $test_file")) {
49682    print $fh "ABCD\n" x 64;
49683
49684    unless (close($fh)) {
49685      die("Can't write $test_file: $!");
49686    }
49687
49688  } else {
49689    die("Can't open $test_file: $!");
49690  }
49691
49692  # Make sure that, if we're running as root, that the home directory has
49693  # permissions/privs set for the account we create
49694  if ($< == 0) {
49695    unless (chmod(0755, $home_dir)) {
49696      die("Can't set perms on $home_dir to 0755: $!");
49697    }
49698
49699    unless (chown($uid, $gid, $home_dir, $test_file)) {
49700      die("Can't set owner of $home_dir to $uid/$gid: $!");
49701    }
49702  }
49703
49704  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
49705    '/bin/bash');
49706  auth_group_write($auth_group_file, $group, $gid, $user);
49707
49708  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
49709  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
49710
49711  my $config = {
49712    PidFile => $pid_file,
49713    ScoreboardFile => $scoreboard_file,
49714    SystemLog => $log_file,
49715    TraceLog => $log_file,
49716    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
49717
49718    AuthUserFile => $auth_user_file,
49719    AuthGroupFile => $auth_group_file,
49720
49721    LogFormat => 'requestID "%m %f id=%{note:sftp.file-handle}"',
49722    ExtendedLog => "$extlog_file READ requestID",
49723
49724    IfModules => {
49725      'mod_delay.c' => {
49726        DelayEngine => 'off',
49727      },
49728
49729      'mod_sftp.c' => [
49730        "SFTPEngine on",
49731        "SFTPLog $log_file",
49732        "SFTPHostKey $rsa_host_key",
49733        "SFTPHostKey $dsa_host_key",
49734      ],
49735    },
49736  };
49737
49738  my ($port, $config_user, $config_group) = config_write($config_file, $config);
49739
49740  # Open pipes, for use between the parent and child processes.  Specifically,
49741  # the child will indicate when it's done with its test by writing a message
49742  # to the parent.
49743  my ($rfh, $wfh);
49744  unless (pipe($rfh, $wfh)) {
49745    die("Can't open pipe: $!");
49746  }
49747
49748  require Net::SSH2;
49749
49750  my $ex;
49751
49752  # Ignore SIGPIPE
49753  local $SIG{PIPE} = sub { };
49754
49755  # Fork child
49756  $self->handle_sigchld();
49757  defined(my $pid = fork()) or die("Can't fork: $!");
49758  if ($pid) {
49759    eval {
49760      my $ssh2 = Net::SSH2->new();
49761
49762      sleep(1);
49763
49764      unless ($ssh2->connect('127.0.0.1', $port)) {
49765        my ($err_code, $err_name, $err_str) = $ssh2->error();
49766        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
49767      }
49768
49769      unless ($ssh2->auth_password($user, $passwd)) {
49770        my ($err_code, $err_name, $err_str) = $ssh2->error();
49771        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
49772      }
49773
49774      my $sftp = $ssh2->sftp();
49775      unless ($sftp) {
49776        my ($err_code, $err_name, $err_str) = $ssh2->error();
49777        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
49778      }
49779
49780      my $fh = $sftp->open('test.txt', O_RDONLY);
49781      unless ($fh) {
49782        my ($err_code, $err_name) = $sftp->error();
49783        die("Can't open test.txt: [$err_name] ($err_code)");
49784      }
49785
49786      my $buf;
49787      my $size = 0;
49788
49789      my $res = $fh->read($buf, 8192);
49790      while ($res) {
49791        $size += $res;
49792
49793        $res = $fh->read($buf, 8192);
49794      }
49795
49796      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
49797      $fh = undef;
49798
49799      $sftp = undef;
49800      $ssh2->disconnect();
49801    };
49802
49803    if ($@) {
49804      $ex = $@;
49805    }
49806
49807    $wfh->print("done\n");
49808    $wfh->flush();
49809
49810  } else {
49811    eval { server_wait($config_file, $rfh) };
49812    if ($@) {
49813      warn($@);
49814      exit 1;
49815    }
49816
49817    exit 0;
49818  }
49819
49820  # Stop server
49821  server_stop($pid_file);
49822
49823  $self->assert_child_ok($pid);
49824
49825  if ($ex) {
49826    test_append_logfile($log_file, $ex);
49827    unlink($log_file);
49828
49829    die($ex);
49830  }
49831
49832  if (open(my $fh, "< $extlog_file")) {
49833    my $ok = 0;
49834
49835    if ($^O eq 'darwin') {
49836      # MacOSX-specific hack to deal with how it handles tmp files
49837      $test_file = ('/private' . $test_file);
49838    }
49839
49840    my $expected_id;
49841
49842    while (my $line = <$fh>) {
49843      chomp($line);
49844
49845      if ($line =~ /(\S+) (.*)? id=(.*)?$/) {
49846        my $cmd = $1;
49847        my $path = $2;
49848        my $id = $3;
49849
49850        if ($cmd eq 'OPEN') {
49851          $expected_id = $id;
49852
49853          $self->assert($test_file eq $path,
49854            test_msg("Expected '$test_file', got '$path'"));
49855
49856          next;
49857        }
49858
49859        if ($cmd eq 'READ') {
49860          $self->assert($test_file eq $path,
49861            test_msg("Expected '$test_file', got '$path'"));
49862          $self->assert($expected_id eq $id,
49863            test_msg("Expected sftp.file-name '$expected_id', got '$id'"));
49864
49865          next;
49866        }
49867
49868        if ($cmd eq 'CLOSE') {
49869          $self->assert($test_file eq $path,
49870            test_msg("Expected '$test_file', got '$path'"));
49871          $self->assert($expected_id eq $id,
49872            test_msg("Expected sftp.file-name '$expected_id', got '$id'"));
49873
49874          $ok = 1;
49875          last;
49876        }
49877      }
49878    }
49879
49880    close($fh);
49881
49882    $self->assert($ok,
49883      test_msg("Expected ExtendedLog lines did not appear as expected"));
49884
49885  } else {
49886    die("Can't read $extlog_file: $!");
49887  }
49888
49889  unlink($log_file);
49890}
49891
49892sub sftp_log_extlog_var_s_remove_bug3873 {
49893  my $self = shift;
49894  my $tmpdir = $self->{tmpdir};
49895
49896  my $config_file = "$tmpdir/sftp.conf";
49897  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
49898  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
49899  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
49900
49901  my $log_file = test_get_logfile();
49902
49903  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
49904  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
49905
49906  my $user = 'proftpd';
49907  my $passwd = 'test';
49908  my $group = 'ftpd';
49909  my $home_dir = File::Spec->rel2abs($tmpdir);
49910  my $uid = 500;
49911  my $gid = 500;
49912
49913  my $write_sz = 32;
49914
49915  # Make sure that, if we're running as root, that the home directory has
49916  # permissions/privs set for the account we create
49917  if ($< == 0) {
49918    unless (chmod(0755, $home_dir)) {
49919      die("Can't set perms on $home_dir to 0755: $!");
49920    }
49921
49922    unless (chown($uid, $gid, $home_dir)) {
49923      die("Can't set owner of $home_dir to $uid/$gid: $!");
49924    }
49925  }
49926
49927  my $test_file1 = File::Spec->rel2abs("$home_dir/test1.txt");
49928  if (open(my $fh, "> $test_file1")) {
49929    print $fh "Hello, World!\n";
49930
49931    unless (close($fh)) {
49932      die("Can't write $test_file1: $!");
49933    }
49934
49935  } else {
49936    die("Can't open $test_file1: $!");
49937  }
49938
49939  my $sub_dir = File::Spec->rel2abs("$home_dir/test.d");
49940  mkpath($sub_dir);
49941
49942  my $test_file2 = File::Spec->rel2abs("$sub_dir/test2.txt");
49943  if (open(my $fh, "> $test_file2")) {
49944    print $fh "Hello, World!\n";
49945
49946    unless (close($fh)) {
49947      die("Can't write $test_file2: $!");
49948    }
49949
49950  } else {
49951    die("Can't open $test_file2: $!");
49952  }
49953
49954  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
49955    '/bin/bash');
49956  auth_group_write($auth_group_file, $group, $gid, $user);
49957
49958  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
49959  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
49960
49961  my $config = {
49962    PidFile => $pid_file,
49963    ScoreboardFile => $scoreboard_file,
49964    SystemLog => $log_file,
49965    TraceLog => $log_file,
49966    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
49967
49968    AuthUserFile => $auth_user_file,
49969    AuthGroupFile => $auth_group_file,
49970
49971    LogFormat => 'delete "%m %f %s"',
49972    ExtendedLog => "$extlog_file WRITE delete",
49973
49974    IfModules => {
49975      'mod_delay.c' => {
49976        DelayEngine => 'off',
49977      },
49978
49979      'mod_sftp.c' => [
49980        "SFTPEngine on",
49981        "SFTPLog $log_file",
49982        "SFTPHostKey $rsa_host_key",
49983        "SFTPHostKey $dsa_host_key",
49984      ],
49985    },
49986  };
49987
49988  my ($port, $config_user, $config_group) = config_write($config_file, $config);
49989
49990  if (open(my $fh, ">> $config_file")) {
49991    print $fh <<EOC;
49992<Directory $sub_dir>
49993  <Limit DELE>
49994    DenyAll
49995  </Limit>
49996</Directory>
49997EOC
49998    unless (close($fh)) {
49999      die("Can't write $config_file: $!");
50000    }
50001
50002  } else {
50003    die("Can't open $config_file: $!");
50004  }
50005
50006  # Open pipes, for use between the parent and child processes.  Specifically,
50007  # the child will indicate when it's done with its test by writing a message
50008  # to the parent.
50009  my ($rfh, $wfh);
50010  unless (pipe($rfh, $wfh)) {
50011    die("Can't open pipe: $!");
50012  }
50013
50014  require Net::SSH2;
50015
50016  my $ex;
50017
50018  # Ignore SIGPIPE
50019  local $SIG{PIPE} = sub { };
50020
50021  # Fork child
50022  $self->handle_sigchld();
50023  defined(my $pid = fork()) or die("Can't fork: $!");
50024  if ($pid) {
50025    eval {
50026      my $ssh2 = Net::SSH2->new();
50027
50028      sleep(1);
50029
50030      unless ($ssh2->connect('127.0.0.1', $port)) {
50031        my ($err_code, $err_name, $err_str) = $ssh2->error();
50032        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50033      }
50034
50035      unless ($ssh2->auth_password($user, $passwd)) {
50036        my ($err_code, $err_name, $err_str) = $ssh2->error();
50037        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
50038      }
50039
50040      my $sftp = $ssh2->sftp();
50041      unless ($sftp) {
50042        my ($err_code, $err_name, $err_str) = $ssh2->error();
50043        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
50044      }
50045
50046      my $res = $sftp->unlink('test1.txt');
50047      unless ($res) {
50048        my ($err_code, $err_name, $err_str) = $ssh2->error();
50049        die("Can't unlink test1.txt: [$err_name] ($err_code) $err_str");
50050      }
50051
50052      if (-f $test_file1) {
50053        die("$test_file1 file exists unexpectedly");
50054      }
50055
50056      $res = $sftp->unlink('test.d/test2.txt');
50057      if ($res) {
50058        die("Unlinking test.d/test2.txt succeeded unexpectedly");
50059      }
50060
50061      my ($err_code, $err_name) = $sftp->error();
50062
50063      my $expected = 'SSH_FX_PERMISSION_DENIED';
50064      $self->assert($expected eq $err_name,
50065        test_msg("Expected error name '$expected', got '$err_name'"));
50066
50067      unless (-f $test_file2) {
50068        die("$test_file2 file does not exist as expected");
50069      }
50070
50071      $sftp = undef;
50072      $ssh2->disconnect();
50073    };
50074
50075    if ($@) {
50076      $ex = $@;
50077    }
50078
50079    $wfh->print("done\n");
50080    $wfh->flush();
50081
50082  } else {
50083    eval { server_wait($config_file, $rfh) };
50084    if ($@) {
50085      warn($@);
50086      exit 1;
50087    }
50088
50089    exit 0;
50090  }
50091
50092  # Stop server
50093  server_stop($pid_file);
50094
50095  $self->assert_child_ok($pid);
50096
50097  if ($ex) {
50098    test_append_logfile($log_file, $ex);
50099    unlink($log_file);
50100
50101    die($ex);
50102  }
50103
50104  if (open(my $fh, "< $extlog_file")) {
50105    my $have_success_dele = 0;
50106    my $have_failed_dele = 0;
50107
50108    while (my $line = <$fh>) {
50109      chomp($line);
50110
50111      if ($line =~ /^(\S+) (.*) (\d+)$/) {
50112        my $cmd = $1;
50113        my $path = $2;
50114        my $resp_code = $3;
50115
50116        next unless $cmd eq 'DELE';
50117
50118        if ($path eq $test_file1) {
50119          if ($resp_code == 250) {
50120            $have_success_dele = 1;
50121          }
50122
50123        } elsif ($path eq $test_file2) {
50124          if ($resp_code == 550) {
50125            $have_failed_dele = 1;
50126          }
50127        }
50128      }
50129    }
50130
50131    close($fh);
50132
50133    $self->assert($have_success_dele,
50134      test_msg("Expected ExtendedLog lines did not appear as expected for successful REMOVE"));
50135    $self->assert($have_failed_dele,
50136      test_msg("Expected ExtendedLog lines did not appear as expected for failed REMOVE"));
50137
50138
50139  } else {
50140    die("Can't read $extlog_file: $!");
50141  }
50142
50143  unlink($log_file);
50144}
50145
50146sub sftp_log_extlog_env_banner_bug4065 {
50147  my $self = shift;
50148  my $tmpdir = $self->{tmpdir};
50149
50150  my $config_file = "$tmpdir/sftp.conf";
50151  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
50152  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
50153  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
50154
50155  my $log_file = test_get_logfile();
50156
50157  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
50158  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
50159
50160  my $user = 'proftpd';
50161  my $passwd = 'test';
50162  my $group = 'ftpd';
50163  my $home_dir = File::Spec->rel2abs($tmpdir);
50164  my $uid = 500;
50165  my $gid = 500;
50166
50167  # Make sure that, if we're running as root, that the home directory has
50168  # permissions/privs set for the account we create
50169  if ($< == 0) {
50170    unless (chmod(0755, $home_dir)) {
50171      die("Can't set perms on $home_dir to 0755: $!");
50172    }
50173
50174    unless (chown($uid, $gid, $home_dir)) {
50175      die("Can't set owner of $home_dir to $uid/$gid: $!");
50176    }
50177  }
50178
50179  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
50180    '/bin/bash');
50181  auth_group_write($auth_group_file, $group, $gid, $user);
50182
50183  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
50184  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
50185
50186  my $config = {
50187    PidFile => $pid_file,
50188    ScoreboardFile => $scoreboard_file,
50189    SystemLog => $log_file,
50190    TraceLog => $log_file,
50191    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
50192
50193    AuthUserFile => $auth_user_file,
50194    AuthGroupFile => $auth_group_file,
50195
50196    LogFormat => 'banner "%m: banner=%{SFTP_CLIENT_BANNER}e"',
50197    ExtendedLog => "$extlog_file ALL banner",
50198
50199    IfModules => {
50200      'mod_delay.c' => {
50201        DelayEngine => 'off',
50202      },
50203
50204      'mod_sftp.c' => [
50205        "SFTPEngine on",
50206        "SFTPLog $log_file",
50207        "SFTPHostKey $rsa_host_key",
50208        "SFTPHostKey $dsa_host_key",
50209      ],
50210    },
50211  };
50212
50213  my ($port, $config_user, $config_group) = config_write($config_file, $config);
50214
50215  # Open pipes, for use between the parent and child processes.  Specifically,
50216  # the child will indicate when it's done with its test by writing a message
50217  # to the parent.
50218  my ($rfh, $wfh);
50219  unless (pipe($rfh, $wfh)) {
50220    die("Can't open pipe: $!");
50221  }
50222
50223  require Net::SSH2;
50224
50225  my $ex;
50226
50227  # Ignore SIGPIPE
50228  local $SIG{PIPE} = sub { };
50229
50230  # Fork child
50231  $self->handle_sigchld();
50232  defined(my $pid = fork()) or die("Can't fork: $!");
50233  if ($pid) {
50234    eval {
50235      my $ssh2 = Net::SSH2->new();
50236
50237      sleep(1);
50238
50239      unless ($ssh2->connect('127.0.0.1', $port)) {
50240        my ($err_code, $err_name, $err_str) = $ssh2->error();
50241        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50242      }
50243
50244      unless ($ssh2->auth_password($user, $passwd)) {
50245        my ($err_code, $err_name, $err_str) = $ssh2->error();
50246        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
50247      }
50248
50249      my $sftp = $ssh2->sftp();
50250      unless ($sftp) {
50251        my ($err_code, $err_name, $err_str) = $ssh2->error();
50252        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
50253      }
50254
50255      $sftp = undef;
50256      $ssh2->disconnect();
50257    };
50258
50259    if ($@) {
50260      $ex = $@;
50261    }
50262
50263    $wfh->print("done\n");
50264    $wfh->flush();
50265
50266  } else {
50267    eval { server_wait($config_file, $rfh) };
50268    if ($@) {
50269      warn($@);
50270      exit 1;
50271    }
50272
50273    exit 0;
50274  }
50275
50276  # Stop server
50277  server_stop($pid_file);
50278
50279  $self->assert_child_ok($pid);
50280
50281  eval {
50282    if (open(my $fh, "< $extlog_file")) {
50283      my $have_banner = 0;
50284
50285      while (my $line = <$fh>) {
50286        chomp($line);
50287
50288        if ($line =~ /^(\S+): banner=(.*)$/) {
50289          my $cmd = $1;
50290          my $banner = $2;
50291
50292          if ($banner =~ /^libssh2/) {
50293            $have_banner = 1;
50294            last;
50295          }
50296        }
50297      }
50298
50299      close($fh);
50300
50301      $self->assert($have_banner,
50302        test_msg("Expected ExtendedLog lines did not appear"));
50303
50304    } else {
50305      die("Can't read $extlog_file: $!");
50306    }
50307  };
50308  if ($@) {
50309    $ex = $@;
50310  }
50311
50312  if ($ex) {
50313    test_append_logfile($log_file, $ex);
50314    unlink($log_file);
50315
50316    die($ex);
50317  }
50318
50319  unlink($log_file);
50320}
50321
50322sub sftp_log_extlog_userauth_full_request {
50323  my $self = shift;
50324  my $tmpdir = $self->{tmpdir};
50325
50326  my $config_file = "$tmpdir/sftp.conf";
50327  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
50328  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
50329  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
50330
50331  my $log_file = test_get_logfile();
50332
50333  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
50334  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
50335
50336  my $user = 'proftpd';
50337  my $passwd = 'test';
50338  my $group = 'ftpd';
50339  my $home_dir = File::Spec->rel2abs($tmpdir);
50340  my $uid = 500;
50341  my $gid = 500;
50342
50343  # Make sure that, if we're running as root, that the home directory has
50344  # permissions/privs set for the account we create
50345  if ($< == 0) {
50346    unless (chmod(0755, $home_dir)) {
50347      die("Can't set perms on $home_dir to 0755: $!");
50348    }
50349
50350    unless (chown($uid, $gid, $home_dir)) {
50351      die("Can't set owner of $home_dir to $uid/$gid: $!");
50352    }
50353  }
50354
50355  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
50356    '/bin/bash');
50357  auth_group_write($auth_group_file, $group, $gid, $user);
50358
50359  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
50360  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
50361
50362  my $config = {
50363    PidFile => $pid_file,
50364    ScoreboardFile => $scoreboard_file,
50365    SystemLog => $log_file,
50366    TraceLog => $log_file,
50367    Trace => 'DEFAULT:10 ssh2:20 sftp:20',
50368
50369    AuthUserFile => $auth_user_file,
50370    AuthGroupFile => $auth_group_file,
50371
50372    LogFormat => 'userauth "%m: %r"',
50373    ExtendedLog => "$extlog_file AUTH userauth",
50374
50375    IfModules => {
50376      'mod_delay.c' => {
50377        DelayEngine => 'off',
50378      },
50379
50380      'mod_sftp.c' => [
50381        "SFTPEngine on",
50382        "SFTPLog $log_file",
50383        "SFTPHostKey $rsa_host_key",
50384        "SFTPHostKey $dsa_host_key",
50385      ],
50386    },
50387  };
50388
50389  my ($port, $config_user, $config_group) = config_write($config_file, $config);
50390
50391  # Open pipes, for use between the parent and child processes.  Specifically,
50392  # the child will indicate when it's done with its test by writing a message
50393  # to the parent.
50394  my ($rfh, $wfh);
50395  unless (pipe($rfh, $wfh)) {
50396    die("Can't open pipe: $!");
50397  }
50398
50399  require Net::SSH2;
50400
50401  my $ex;
50402
50403  # Ignore SIGPIPE
50404  local $SIG{PIPE} = sub { };
50405
50406  # Fork child
50407  $self->handle_sigchld();
50408  defined(my $pid = fork()) or die("Can't fork: $!");
50409  if ($pid) {
50410    eval {
50411      my $ssh2 = Net::SSH2->new();
50412
50413      sleep(1);
50414
50415      unless ($ssh2->connect('127.0.0.1', $port)) {
50416        my ($err_code, $err_name, $err_str) = $ssh2->error();
50417        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50418      }
50419
50420      unless ($ssh2->auth_password($user, $passwd)) {
50421        my ($err_code, $err_name, $err_str) = $ssh2->error();
50422        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
50423      }
50424
50425      my $sftp = $ssh2->sftp();
50426      unless ($sftp) {
50427        my ($err_code, $err_name, $err_str) = $ssh2->error();
50428        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
50429      }
50430
50431      $sftp = undef;
50432      $ssh2->disconnect();
50433    };
50434
50435    if ($@) {
50436      $ex = $@;
50437    }
50438
50439    $wfh->print("done\n");
50440    $wfh->flush();
50441
50442  } else {
50443    eval { server_wait($config_file, $rfh) };
50444    if ($@) {
50445      warn($@);
50446      exit 1;
50447    }
50448
50449    exit 0;
50450  }
50451
50452  # Stop server
50453  server_stop($pid_file);
50454
50455  $self->assert_child_ok($pid);
50456
50457  eval {
50458    if (open(my $fh, "< $extlog_file")) {
50459      my $have_req = 0;
50460
50461      while (my $line = <$fh>) {
50462        chomp($line);
50463
50464        if ($line =~ /^(\S+):\s+(\S+)\s+(\S+)\s+(\S+)/) {
50465          my $cmd = $1;
50466          my $cmd_req = $2;
50467          my $cmd_user = $3;
50468          my $cmd_meth = $4;
50469
50470          if ($cmd_meth eq 'password') {
50471            $have_req = 1;
50472            last;
50473          }
50474        }
50475      }
50476
50477      close($fh);
50478
50479      $self->assert($have_req,
50480        test_msg("Expected ExtendedLog lines did not appear"));
50481
50482    } else {
50483      die("Can't read $extlog_file: $!");
50484    }
50485  };
50486  if ($@) {
50487    $ex = $@;
50488  }
50489
50490  if ($ex) {
50491    test_append_logfile($log_file, $ex);
50492    unlink($log_file);
50493
50494    die($ex);
50495  }
50496
50497  unlink($log_file);
50498}
50499
50500sub sftp_sighup {
50501  my $self = shift;
50502  my $tmpdir = $self->{tmpdir};
50503
50504  my $config_file = "$tmpdir/sftp.conf";
50505  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
50506  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
50507
50508  my $log_file = test_get_logfile();
50509
50510  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
50511  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
50512
50513  my $user = 'proftpd';
50514  my $passwd = 'test';
50515  my $group = 'ftpd';
50516  my $home_dir = File::Spec->rel2abs($tmpdir);
50517  my $uid = 500;
50518  my $gid = 500;
50519
50520  # Make sure that, if we're running as root, that the home directory has
50521  # permissions/privs set for the account we create
50522  if ($< == 0) {
50523    unless (chmod(0755, $home_dir)) {
50524      die("Can't set perms on $home_dir to 0755: $!");
50525    }
50526
50527    unless (chown($uid, $gid, $home_dir)) {
50528      die("Can't set owner of $home_dir to $uid/$gid: $!");
50529    }
50530  }
50531
50532  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
50533    '/bin/bash');
50534  auth_group_write($auth_group_file, $group, $gid, $user);
50535
50536  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
50537  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
50538
50539  my $config = {
50540    PidFile => $pid_file,
50541    ScoreboardFile => $scoreboard_file,
50542    SystemLog => $log_file,
50543    TraceLog => $log_file,
50544    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20 event:10 regexp:10',
50545
50546    AuthUserFile => $auth_user_file,
50547    AuthGroupFile => $auth_group_file,
50548
50549    DenyFilter => '\*/',
50550
50551    IfModules => {
50552      'mod_delay.c' => {
50553        DelayEngine => 'off',
50554      },
50555
50556      'mod_sftp.c' => [
50557        "SFTPEngine on",
50558        "SFTPLog $log_file",
50559        "SFTPHostKey $rsa_host_key",
50560        "SFTPHostKey $dsa_host_key",
50561      ],
50562    },
50563  };
50564
50565  my ($port, $config_user, $config_group) = config_write($config_file, $config);
50566
50567  # First, start the server.
50568  server_start($config_file);
50569
50570  # Give it a second to start up, then send the SIGHUP signal
50571  sleep(2);
50572  server_restart($pid_file);
50573
50574  # Give it another second to start up again
50575  sleep(2);
50576
50577  # Open pipes, for use between the parent and child processes.  Specifically,
50578  # the child will indicate when it's done with its test by writing a message
50579  # to the parent.
50580  my ($rfh, $wfh);
50581  unless (pipe($rfh, $wfh)) {
50582    die("Can't open pipe: $!");
50583  }
50584
50585  require Net::SSH2;
50586
50587  my $ex;
50588
50589  # Fork child
50590  $self->handle_sigchld();
50591  defined(my $pid = fork()) or die("Can't fork: $!");
50592  if ($pid) {
50593    eval {
50594      my $ssh2 = Net::SSH2->new();
50595
50596      sleep(1);
50597
50598      unless ($ssh2->connect('127.0.0.1', $port)) {
50599        my ($err_code, $err_name, $err_str) = $ssh2->error();
50600        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50601      }
50602
50603      unless ($ssh2->auth_password($user, $passwd)) {
50604        my ($err_code, $err_name, $err_str) = $ssh2->error();
50605        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
50606      }
50607
50608      my $sftp = $ssh2->sftp();
50609      unless ($sftp) {
50610        my ($err_code, $err_name, $err_str) = $ssh2->error();
50611        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
50612      }
50613
50614      $sftp = undef;
50615      $ssh2->disconnect();
50616    };
50617
50618    if ($@) {
50619      $ex = $@;
50620    }
50621
50622    $wfh->print("done\n");
50623    $wfh->flush();
50624
50625  } else {
50626    # Wait until we receive word from the child that it has finished its test.
50627    while (my $msg = <$rfh>) {
50628      chomp($msg);
50629
50630      if ($msg eq 'done') {
50631        last;
50632      }
50633    }
50634
50635    exit 0;
50636  }
50637
50638  # Stop server
50639  server_stop($pid_file);
50640
50641  $self->assert_child_ok($pid);
50642
50643  if ($ex) {
50644    test_append_logfile($log_file, $ex);
50645    unlink($log_file);
50646
50647    die($ex);
50648  }
50649
50650  unlink($log_file);
50651}
50652
50653sub sftp_ifsess_protocols {
50654  my $self = shift;
50655  my $tmpdir = $self->{tmpdir};
50656
50657  my $config_file = "$tmpdir/sftp.conf";
50658  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
50659  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
50660
50661  my $log_file = test_get_logfile();
50662
50663  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
50664  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
50665
50666  my $user = 'proftpd';
50667  my $passwd = 'test';
50668  my $group = 'ftpd';
50669  my $home_dir = File::Spec->rel2abs($tmpdir);
50670  my $uid = 500;
50671  my $gid = 500;
50672
50673  # Make sure that, if we're running as root, that the home directory has
50674  # permissions/privs set for the account we create
50675  if ($< == 0) {
50676    unless (chmod(0755, $home_dir)) {
50677      die("Can't set perms on $home_dir to 0755: $!");
50678    }
50679
50680    unless (chown($uid, $gid, $home_dir)) {
50681      die("Can't set owner of $home_dir to $uid/$gid: $!");
50682    }
50683  }
50684
50685  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
50686    '/bin/bash');
50687  auth_group_write($auth_group_file, $group, $gid, $user);
50688
50689  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
50690  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
50691
50692  my $config = {
50693    PidFile => $pid_file,
50694    ScoreboardFile => $scoreboard_file,
50695    SystemLog => $log_file,
50696    TraceLog => $log_file,
50697    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
50698
50699    AuthUserFile => $auth_user_file,
50700    AuthGroupFile => $auth_group_file,
50701
50702    IfModules => {
50703      'mod_delay.c' => {
50704        DelayEngine => 'off',
50705      },
50706
50707      'mod_sftp.c' => [
50708        "SFTPEngine on",
50709        "SFTPLog $log_file",
50710        "SFTPHostKey $rsa_host_key",
50711        "SFTPHostKey $dsa_host_key",
50712      ],
50713    },
50714  };
50715
50716  my ($port, $config_user, $config_group) = config_write($config_file, $config);
50717
50718  if (open(my $fh, ">> $config_file")) {
50719    print $fh <<EOC;
50720<IfModule mod_ifsession.c>
50721  <IfUser foo>
50722    Protocols sftp scp
50723  </IfUser>
50724
50725  <IfUser $user>
50726    Protocols scp
50727  </IfUser>
50728</IfModule>
50729EOC
50730    unless (close($fh)) {
50731      die("Can't write $config_file: $!");
50732    }
50733
50734  } else {
50735    die("Can't open $config_file: $!");
50736  }
50737
50738  # Open pipes, for use between the parent and child processes.  Specifically,
50739  # the child will indicate when it's done with its test by writing a message
50740  # to the parent.
50741  my ($rfh, $wfh);
50742  unless (pipe($rfh, $wfh)) {
50743    die("Can't open pipe: $!");
50744  }
50745
50746  require Net::SSH2;
50747
50748  my $ex;
50749
50750  # Ignore SIGPIPE
50751  local $SIG{PIPE} = sub { };
50752
50753  # Fork child
50754  $self->handle_sigchld();
50755  defined(my $pid = fork()) or die("Can't fork: $!");
50756  if ($pid) {
50757    eval {
50758      my $ssh2 = Net::SSH2->new();
50759
50760      sleep(1);
50761
50762      unless ($ssh2->connect('127.0.0.1', $port)) {
50763        my ($err_code, $err_name, $err_str) = $ssh2->error();
50764        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50765      }
50766
50767      unless ($ssh2->auth_password($user, $passwd)) {
50768        my ($err_code, $err_name, $err_str) = $ssh2->error();
50769        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50770      }
50771
50772      my $sftp = $ssh2->sftp();
50773      if ($sftp) {
50774        die("SFTP subsystem started unexpectedly");
50775      }
50776
50777      my ($err_code, $err_name, $err_str) = $ssh2->error();
50778
50779      my $expected = 'LIBSSH2_ERROR_CHANNEL_FAILURE';
50780      $self->assert($expected eq $err_name,
50781        test_msg("Expected '$expected', got '$err_name'"));
50782
50783      $ssh2->disconnect();
50784    };
50785
50786    if ($@) {
50787      $ex = $@;
50788    }
50789
50790    $wfh->print("done\n");
50791    $wfh->flush();
50792
50793  } else {
50794    eval { server_wait($config_file, $rfh) };
50795    if ($@) {
50796      warn($@);
50797      exit 1;
50798    }
50799
50800    exit 0;
50801  }
50802
50803  # Stop server
50804  server_stop($pid_file);
50805
50806  $self->assert_child_ok($pid);
50807
50808  if ($ex) {
50809    test_append_logfile($log_file, $ex);
50810    unlink($log_file);
50811
50812    die($ex);
50813  }
50814
50815  unlink($log_file);
50816}
50817
50818sub sftp_wrap_login_allowed_bug3352 {
50819  my $self = shift;
50820  my $tmpdir = $self->{tmpdir};
50821
50822  my $config_file = "$tmpdir/sftp.conf";
50823  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
50824  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
50825
50826  my $log_file = test_get_logfile();
50827
50828  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
50829  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
50830
50831  my $fh;
50832  my $allow_file = File::Spec->rel2abs("$tmpdir/sftp.allow");
50833  if (open($fh, "> $allow_file")) {
50834    print $fh "proftpd: ALL\n";
50835
50836    unless (close($fh)) {
50837      die("Can't write $allow_file: $!");
50838    }
50839
50840  } else {
50841    die("Can't open $allow_file: $!");
50842  }
50843
50844  my $deny_file = File::Spec->rel2abs("$tmpdir/sftp.deny");
50845  if (open($fh, "> $deny_file")) {
50846    print $fh "ALL: ALL\n";
50847
50848    unless (close($fh)) {
50849      die("Can't write $deny_file: $!");
50850    }
50851
50852  } else {
50853    die("Can't open $deny_file: $!");
50854  }
50855
50856  my $user = 'proftpd';
50857  my $passwd = 'test';
50858  my $group = 'ftpd';
50859  my $home_dir = File::Spec->rel2abs($tmpdir);
50860  my $uid = 500;
50861  my $gid = 500;
50862
50863  # Make sure that, if we're running as root, that the home directory has
50864  # permissions/privs set for the account we create
50865  if ($< == 0) {
50866    unless (chmod(0755, $home_dir)) {
50867      die("Can't set perms on $home_dir to 0755: $!");
50868    }
50869
50870    unless (chown($uid, $gid, $home_dir)) {
50871      die("Can't set owner of $home_dir to $uid/$gid: $!");
50872    }
50873  }
50874
50875  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
50876    '/bin/bash');
50877  auth_group_write($auth_group_file, $group, $gid, $user);
50878
50879  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
50880  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
50881
50882  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
50883
50884  my $config = {
50885    PidFile => $pid_file,
50886    ScoreboardFile => $scoreboard_file,
50887    SystemLog => $log_file,
50888    TraceLog => $log_file,
50889    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
50890
50891    AuthUserFile => $auth_user_file,
50892    AuthGroupFile => $auth_group_file,
50893
50894    IfModules => {
50895      'mod_delay.c' => {
50896        DelayEngine => 'off',
50897      },
50898
50899      'mod_sftp.c' => [
50900        "SFTPEngine on",
50901        "SFTPLog $log_file",
50902        "SFTPHostKey $rsa_host_key",
50903        "SFTPHostKey $dsa_host_key",
50904      ],
50905
50906      'mod_wrap.c' => {
50907        TCPAccessFiles => "$allow_file $deny_file",
50908      },
50909    },
50910  };
50911
50912  my ($port, $config_user, $config_group) = config_write($config_file, $config);
50913
50914  # Open pipes, for use between the parent and child processes.  Specifically,
50915  # the child will indicate when it's done with its test by writing a message
50916  # to the parent.
50917  my ($rfh, $wfh);
50918  unless (pipe($rfh, $wfh)) {
50919    die("Can't open pipe: $!");
50920  }
50921
50922  require Net::SSH2;
50923
50924  my $ex;
50925
50926  # Fork child
50927  $self->handle_sigchld();
50928  defined(my $pid = fork()) or die("Can't fork: $!");
50929  if ($pid) {
50930    eval {
50931      my $ssh2 = Net::SSH2->new();
50932
50933      sleep(1);
50934
50935      unless ($ssh2->connect('127.0.0.1', $port)) {
50936        my ($err_code, $err_name, $err_str) = $ssh2->error();
50937        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
50938      }
50939
50940      if ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
50941        die("Publickey auth succeeded unexpectedly");
50942      }
50943
50944      unless ($ssh2->auth_password($user, $passwd)) {
50945        my ($err_code, $err_name, $err_str) = $ssh2->error();
50946        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
50947      }
50948
50949      my $sftp = $ssh2->sftp();
50950      unless ($sftp) {
50951        my ($err_code, $err_name, $err_str) = $ssh2->error();
50952        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
50953      }
50954
50955      $sftp = undef;
50956      $ssh2->disconnect();
50957    };
50958
50959    if ($@) {
50960      $ex = $@;
50961    }
50962
50963    $wfh->print("done\n");
50964    $wfh->flush();
50965
50966  } else {
50967    eval { server_wait($config_file, $rfh) };
50968    if ($@) {
50969      warn($@);
50970      exit 1;
50971    }
50972
50973    exit 0;
50974  }
50975
50976  # Stop server
50977  server_stop($pid_file);
50978
50979  $self->assert_child_ok($pid);
50980
50981  if ($ex) {
50982    test_append_logfile($log_file, $ex);
50983    unlink($log_file);
50984
50985    die($ex);
50986  }
50987
50988  unlink($log_file);
50989}
50990
50991sub sftp_wrap_login_denied_bug3352 {
50992  my $self = shift;
50993  my $tmpdir = $self->{tmpdir};
50994
50995  my $config_file = "$tmpdir/sftp.conf";
50996  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
50997  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
50998
50999  my $log_file = test_get_logfile();
51000
51001  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
51002  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
51003
51004  my $fh;
51005  my $allow_file = File::Spec->rel2abs("$tmpdir/sftp.allow");
51006  if (open($fh, "> $allow_file")) {
51007    # Leave this file empty
51008
51009  } else {
51010    die("Can't open $allow_file: $!");
51011  }
51012
51013  my $deny_file = File::Spec->rel2abs("$tmpdir/sftp.deny");
51014  if (open($fh, "> $deny_file")) {
51015    print $fh "ALL: ALL\n";
51016
51017    unless (close($fh)) {
51018      die("Can't write $deny_file: $!");
51019    }
51020
51021  } else {
51022    die("Can't open $deny_file: $!");
51023  }
51024
51025  my $user = 'proftpd';
51026  my $passwd = 'test';
51027  my $group = 'ftpd';
51028  my $home_dir = File::Spec->rel2abs($tmpdir);
51029  my $uid = 500;
51030  my $gid = 500;
51031
51032  # Make sure that, if we're running as root, that the home directory has
51033  # permissions/privs set for the account we create
51034  if ($< == 0) {
51035    unless (chmod(0755, $home_dir)) {
51036      die("Can't set perms on $home_dir to 0755: $!");
51037    }
51038
51039    unless (chown($uid, $gid, $home_dir)) {
51040      die("Can't set owner of $home_dir to $uid/$gid: $!");
51041    }
51042  }
51043
51044  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
51045    '/bin/bash');
51046  auth_group_write($auth_group_file, $group, $gid, $user);
51047
51048  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51049  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51050
51051  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
51052  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
51053
51054  my $config = {
51055    PidFile => $pid_file,
51056    ScoreboardFile => $scoreboard_file,
51057    SystemLog => $log_file,
51058    TraceLog => $log_file,
51059    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51060
51061    AuthUserFile => $auth_user_file,
51062    AuthGroupFile => $auth_group_file,
51063
51064    IfModules => {
51065      'mod_delay.c' => {
51066        DelayEngine => 'off',
51067      },
51068
51069      'mod_sftp.c' => [
51070        "SFTPEngine on",
51071        "SFTPLog $log_file",
51072        "SFTPHostKey $rsa_host_key",
51073        "SFTPHostKey $dsa_host_key",
51074      ],
51075
51076      'mod_wrap.c' => {
51077        TCPAccessFiles => "$allow_file $deny_file",
51078      },
51079    },
51080  };
51081
51082  my ($port, $config_user, $config_group) = config_write($config_file, $config);
51083
51084  # Open pipes, for use between the parent and child processes.  Specifically,
51085  # the child will indicate when it's done with its test by writing a message
51086  # to the parent.
51087  my ($rfh, $wfh);
51088  unless (pipe($rfh, $wfh)) {
51089    die("Can't open pipe: $!");
51090  }
51091
51092  require Net::SSH2;
51093
51094  my $ex;
51095
51096  # Fork child
51097  $self->handle_sigchld();
51098  defined(my $pid = fork()) or die("Can't fork: $!");
51099  if ($pid) {
51100    eval {
51101      my $ssh2 = Net::SSH2->new();
51102
51103      sleep(1);
51104
51105      unless ($ssh2->connect('127.0.0.1', $port)) {
51106        my ($err_code, $err_name, $err_str) = $ssh2->error();
51107        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51108      }
51109
51110      if ($ssh2->auth_publickey($user, $rsa_pub_key, $rsa_priv_key)) {
51111        die("Publickey auth succeeded unexpectedly");
51112      }
51113
51114      if ($ssh2->auth_password($user, $passwd)) {
51115        die("Logged in to SSH2 server unexpectedly");
51116      }
51117    };
51118
51119    if ($@) {
51120      $ex = $@;
51121    }
51122
51123    $wfh->print("done\n");
51124    $wfh->flush();
51125
51126  } else {
51127    eval { server_wait($config_file, $rfh) };
51128    if ($@) {
51129      warn($@);
51130      exit 1;
51131    }
51132
51133    exit 0;
51134  }
51135
51136  # Stop server
51137  server_stop($pid_file);
51138
51139  $self->assert_child_ok($pid);
51140
51141  if ($ex) {
51142    test_append_logfile($log_file, $ex);
51143    unlink($log_file);
51144
51145    die($ex);
51146  }
51147
51148  unlink($log_file);
51149}
51150
51151sub scp_upload {
51152  my $self = shift;
51153  my $tmpdir = $self->{tmpdir};
51154  my $setup = test_setup($tmpdir, 'scp');
51155
51156  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
51157
51158  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51159  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51160
51161  my $config = {
51162    PidFile => $setup->{pid_file},
51163    ScoreboardFile => $setup->{scoreboard_file},
51164    SystemLog => $setup->{log_file},
51165    TraceLog => $setup->{log_file},
51166    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51167
51168    AuthUserFile => $setup->{auth_user_file},
51169    AuthGroupFile => $setup->{auth_group_file},
51170
51171    IfModules => {
51172      'mod_delay.c' => {
51173        DelayEngine => 'off',
51174      },
51175
51176      'mod_sftp.c' => [
51177        "SFTPEngine on",
51178        "SFTPLog $setup->{log_file}",
51179        "SFTPHostKey $rsa_host_key",
51180        "SFTPHostKey $dsa_host_key",
51181      ],
51182    },
51183  };
51184
51185  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
51186    $config);
51187
51188  # Open pipes, for use between the parent and child processes.  Specifically,
51189  # the child will indicate when it's done with its test by writing a message
51190  # to the parent.
51191  my ($rfh, $wfh);
51192  unless (pipe($rfh, $wfh)) {
51193    die("Can't open pipe: $!");
51194  }
51195
51196  require Net::SSH2;
51197
51198  my $ex;
51199
51200  # Ignore SIGPIPE
51201  local $SIG{PIPE} = sub { };
51202
51203  # Fork child
51204  $self->handle_sigchld();
51205  defined(my $pid = fork()) or die("Can't fork: $!");
51206  if ($pid) {
51207    eval {
51208      my $ssh2 = Net::SSH2->new();
51209
51210      sleep(1);
51211
51212      unless ($ssh2->connect('127.0.0.1', $port)) {
51213        my ($err_code, $err_name, $err_str) = $ssh2->error();
51214        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51215      }
51216
51217      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
51218        my ($err_code, $err_name, $err_str) = $ssh2->error();
51219        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
51220      }
51221
51222      my $res = $ssh2->scp_put($setup->{config_file}, 'test.txt');
51223      unless ($res) {
51224        my ($err_code, $err_name, $err_str) = $ssh2->error();
51225        die("Can't upload $setup->{config_file} to server: [$err_name] ($err_code) $err_str");
51226      }
51227
51228      $ssh2->disconnect();
51229
51230      $self->assert(-f $test_file,
51231        test_msg("File $test_file does not exist as expected"));
51232    };
51233    if ($@) {
51234      $ex = $@;
51235    }
51236
51237    $wfh->print("done\n");
51238    $wfh->flush();
51239
51240  } else {
51241    eval { server_wait($setup->{config_file}, $rfh) };
51242    if ($@) {
51243      warn($@);
51244      exit 1;
51245    }
51246
51247    exit 0;
51248  }
51249
51250  # Stop server
51251  server_stop($setup->{pid_file});
51252  $self->assert_child_ok($pid);
51253
51254  test_cleanup($setup->{log_file}, $ex);
51255}
51256
51257sub scp_upload_zero_len_file {
51258  my $self = shift;
51259  my $tmpdir = $self->{tmpdir};
51260
51261  my $config_file = "$tmpdir/sftp.conf";
51262  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
51263  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
51264
51265  my $log_file = test_get_logfile();
51266
51267  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
51268  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
51269
51270  my $user = 'proftpd';
51271  my $passwd = 'test';
51272  my $group = 'ftpd';
51273  my $home_dir = File::Spec->rel2abs($tmpdir);
51274  my $uid = 500;
51275  my $gid = 500;
51276
51277  # Make sure that, if we're running as root, that the home directory has
51278  # permissions/privs set for the account we create
51279  if ($< == 0) {
51280    unless (chmod(0755, $home_dir)) {
51281      die("Can't set perms on $home_dir to 0755: $!");
51282    }
51283
51284    unless (chown($uid, $gid, $home_dir)) {
51285      die("Can't set owner of $home_dir to $uid/$gid: $!");
51286    }
51287  }
51288
51289  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
51290    '/bin/bash');
51291  auth_group_write($auth_group_file, $group, $gid, $user);
51292
51293  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51294  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51295
51296  my $empty_file = File::Spec->rel2abs("$tmpdir/empty.txt");
51297  if (open(my $fh, "> $empty_file")) {
51298    close($fh);
51299
51300  } else {
51301    die("Can't open $empty_file: $!");
51302  }
51303
51304  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
51305
51306  my $config = {
51307    PidFile => $pid_file,
51308    ScoreboardFile => $scoreboard_file,
51309    SystemLog => $log_file,
51310    TraceLog => $log_file,
51311    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51312
51313    AuthUserFile => $auth_user_file,
51314    AuthGroupFile => $auth_group_file,
51315
51316    IfModules => {
51317      'mod_delay.c' => {
51318        DelayEngine => 'off',
51319      },
51320
51321      'mod_sftp.c' => [
51322        "SFTPEngine on",
51323        "SFTPLog $log_file",
51324        "SFTPHostKey $rsa_host_key",
51325        "SFTPHostKey $dsa_host_key",
51326      ],
51327    },
51328  };
51329
51330  my ($port, $config_user, $config_group) = config_write($config_file, $config);
51331
51332  # Open pipes, for use between the parent and child processes.  Specifically,
51333  # the child will indicate when it's done with its test by writing a message
51334  # to the parent.
51335  my ($rfh, $wfh);
51336  unless (pipe($rfh, $wfh)) {
51337    die("Can't open pipe: $!");
51338  }
51339
51340  require Net::SSH2;
51341
51342  my $ex;
51343
51344  # Ignore SIGPIPE
51345  local $SIG{PIPE} = sub { };
51346
51347  # Fork child
51348  $self->handle_sigchld();
51349  defined(my $pid = fork()) or die("Can't fork: $!");
51350  if ($pid) {
51351    eval {
51352      my $ssh2 = Net::SSH2->new();
51353
51354      sleep(1);
51355
51356      unless ($ssh2->connect('127.0.0.1', $port)) {
51357        my ($err_code, $err_name, $err_str) = $ssh2->error();
51358        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51359      }
51360
51361      unless ($ssh2->auth_password($user, $passwd)) {
51362        my ($err_code, $err_name, $err_str) = $ssh2->error();
51363        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
51364      }
51365
51366      my $res = $ssh2->scp_put($empty_file, 'test.txt');
51367      unless ($res) {
51368        my ($err_code, $err_name, $err_str) = $ssh2->error();
51369        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
51370      }
51371
51372      $ssh2->disconnect();
51373
51374      unless (-f $test_file) {
51375        die("$test_file file does not exist as expected");
51376      }
51377
51378      my $size = -s $test_file;
51379      unless ($size == 0) {
51380        die("$test_file has size $size unexpectedly");
51381      }
51382    };
51383
51384    if ($@) {
51385      $ex = $@;
51386    }
51387
51388    $wfh->print("done\n");
51389    $wfh->flush();
51390
51391  } else {
51392    eval { server_wait($config_file, $rfh) };
51393    if ($@) {
51394      warn($@);
51395      exit 1;
51396    }
51397
51398    exit 0;
51399  }
51400
51401  # Stop server
51402  server_stop($pid_file);
51403
51404  $self->assert_child_ok($pid);
51405
51406  if ($ex) {
51407    test_append_logfile($log_file, $ex);
51408    unlink($log_file);
51409
51410    die($ex);
51411  }
51412
51413  unlink($log_file);
51414}
51415
51416sub scp_upload_largefile {
51417  my $self = shift;
51418  my $tmpdir = $self->{tmpdir};
51419  my $setup = test_setup($tmpdir, 'scp');
51420
51421  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
51422  if (open(my $fh, "> $test_file")) {
51423    # Make a file that's larger than the maximum SSH2 packet size, forcing
51424    # the scp code to loop properly entire the entire large file is sent.
51425    print $fh "ABCDefgh" x 16384;
51426    unless (close($fh)) {
51427      die("Can't write $test_file: $!");
51428    }
51429
51430  } else {
51431    die("Can't open $test_file: $!");
51432  }
51433
51434  # Calculate the MD5 checksum of this file, for comparison with the
51435  # downloaded file.
51436  my $ctx = Digest::MD5->new();
51437  my $expected_md5;
51438
51439  if (open(my $fh, "< $test_file")) {
51440    binmode($fh);
51441    $ctx->addfile($fh);
51442    $expected_md5 = $ctx->hexdigest();
51443    close($fh);
51444
51445  } else {
51446    die("Can't read $test_file: $!");
51447  }
51448
51449  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
51450
51451  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51452  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51453
51454  my $config = {
51455    PidFile => $setup->{pid_file},
51456    ScoreboardFile => $setup->{scoreboard_file},
51457    SystemLog => $setup->{log_file},
51458    TraceLog => $setup->{log_file},
51459    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51460
51461    AuthUserFile => $setup->{auth_user_file},
51462    AuthGroupFile => $setup->{auth_group_file},
51463
51464    IfModules => {
51465      'mod_delay.c' => {
51466        DelayEngine => 'off',
51467      },
51468
51469      'mod_sftp.c' => [
51470        "SFTPEngine on",
51471        "SFTPLog $setup->{log_file}",
51472        "SFTPHostKey $rsa_host_key",
51473        "SFTPHostKey $dsa_host_key",
51474      ],
51475    },
51476  };
51477
51478  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
51479    $config);
51480
51481  # Open pipes, for use between the parent and child processes.  Specifically,
51482  # the child will indicate when it's done with its test by writing a message
51483  # to the parent.
51484  my ($rfh, $wfh);
51485  unless (pipe($rfh, $wfh)) {
51486    die("Can't open pipe: $!");
51487  }
51488
51489  require Net::SSH2;
51490
51491  my $ex;
51492
51493  # Ignore SIGPIPE
51494  local $SIG{PIPE} = sub { };
51495
51496  # Fork child
51497  $self->handle_sigchld();
51498  defined(my $pid = fork()) or die("Can't fork: $!");
51499  if ($pid) {
51500    eval {
51501      my $ssh2 = Net::SSH2->new();
51502
51503      sleep(1);
51504
51505      unless ($ssh2->connect('127.0.0.1', $port)) {
51506        my ($err_code, $err_name, $err_str) = $ssh2->error();
51507        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51508      }
51509
51510      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
51511        my ($err_code, $err_name, $err_str) = $ssh2->error();
51512        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
51513      }
51514
51515      my $res = $ssh2->scp_put($test_file, 'test2.txt');
51516      unless ($res) {
51517        my ($err_code, $err_name, $err_str) = $ssh2->error();
51518        die("Can't download 'test.txt' from server: [$err_name] ($err_code) $err_str");
51519      }
51520
51521      $ssh2->disconnect();
51522
51523      $self->assert(-f $test_file2,
51524        test_msg("File $test_file2 does not exist as expected"));
51525    };
51526    if ($@) {
51527      $ex = $@;
51528    }
51529
51530    $wfh->print("done\n");
51531    $wfh->flush();
51532
51533  } else {
51534    eval { server_wait($setup->{config_file}, $rfh) };
51535    if ($@) {
51536      warn($@);
51537      exit 1;
51538    }
51539
51540    exit 0;
51541  }
51542
51543  # Stop server
51544  server_stop($setup->{pid_file});
51545  $self->assert_child_ok($pid);
51546
51547  if ($ex) {
51548    test_cleanup($setup->{log_file}, $ex);
51549  }
51550
51551  # Calculate the MD5 checksum of the uploaded file, for comparison with the
51552  # file that was uploaded.
51553  $ctx->reset();
51554  my $md5;
51555
51556  eval {
51557    if (open(my $fh, "< $test_file2")) {
51558      binmode($fh);
51559      $ctx->addfile($fh);
51560      $md5 = $ctx->hexdigest();
51561      close($fh);
51562
51563    } else {
51564      die("Can't read $test_file2: $!");
51565    }
51566
51567    $self->assert($expected_md5 eq $md5,
51568      test_msg("Expected '$expected_md5', got '$md5'"));
51569  };
51570  if ($@) {
51571    $ex = $@;
51572  }
51573
51574  test_cleanup($setup->{log_file}, $ex);
51575}
51576
51577sub scp_upload_abs_symlink {
51578  my $self = shift;
51579  my $tmpdir = $self->{tmpdir};
51580  my $setup = test_setup($tmpdir, 'scp');
51581
51582  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
51583  mkpath($test_dir);
51584
51585  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
51586  if (open(my $fh, "> $test_file")) {
51587    unless (close($fh)) {
51588      die("Can't write $test_file: $!");
51589    }
51590
51591  } else {
51592    die("Can't open $test_file: $!");
51593  }
51594
51595  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
51596
51597  my $dst_path = $test_file;
51598  if ($^O eq 'darwin') {
51599    # MacOSX-specific hack
51600    $dst_path = '/private' . $dst_path;
51601  }
51602
51603  unless (symlink($dst_path, $test_symlink)) {
51604    die("Can't symlink $test_symlink to $dst_path: $!");
51605  }
51606
51607  if ($< == 0) {
51608    unless (chmod(0755, $test_dir)) {
51609      die("Can't set perms on $test_dir to 0755: $!");
51610    }
51611
51612    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
51613      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
51614    }
51615  }
51616
51617  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51618  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51619
51620  my $config = {
51621    PidFile => $setup->{pid_file},
51622    ScoreboardFile => $setup->{scoreboard_file},
51623    SystemLog => $setup->{log_file},
51624    TraceLog => $setup->{log_file},
51625    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51626
51627    AuthUserFile => $setup->{auth_user_file},
51628    AuthGroupFile => $setup->{auth_group_file},
51629
51630    AllowOverwrite => 'on',
51631
51632    IfModules => {
51633      'mod_delay.c' => {
51634        DelayEngine => 'off',
51635      },
51636
51637      'mod_sftp.c' => [
51638        "SFTPEngine on",
51639        "SFTPLog $setup->{log_file}",
51640        "SFTPHostKey $rsa_host_key",
51641        "SFTPHostKey $dsa_host_key",
51642      ],
51643    },
51644  };
51645
51646  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
51647    $config);
51648
51649  # Open pipes, for use between the parent and child processes.  Specifically,
51650  # the child will indicate when it's done with its test by writing a message
51651  # to the parent.
51652  my ($rfh, $wfh);
51653  unless (pipe($rfh, $wfh)) {
51654    die("Can't open pipe: $!");
51655  }
51656
51657  require Net::SSH2;
51658
51659  my $ex;
51660
51661  # Ignore SIGPIPE
51662  local $SIG{PIPE} = sub { };
51663
51664  # Fork child
51665  $self->handle_sigchld();
51666  defined(my $pid = fork()) or die("Can't fork: $!");
51667  if ($pid) {
51668    eval {
51669      my $ssh2 = Net::SSH2->new();
51670
51671      sleep(1);
51672
51673      unless ($ssh2->connect('127.0.0.1', $port)) {
51674        my ($err_code, $err_name, $err_str) = $ssh2->error();
51675        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51676      }
51677
51678      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
51679        my ($err_code, $err_name, $err_str) = $ssh2->error();
51680        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
51681      }
51682
51683      my $path = 'test.d/test.lnk';
51684      my $res = $ssh2->scp_put($setup->{config_file}, $path);
51685      unless ($res) {
51686        my ($err_code, $err_name, $err_str) = $ssh2->error();
51687        die("Can't upload to $path on server: [$err_name] ($err_code) $err_str");
51688      }
51689
51690      $ssh2->disconnect();
51691
51692      my $file_size = -s $test_file;
51693      $self->assert($file_size > 0,
51694        test_msg("Expected non-zero file size, got $file_size"));
51695    };
51696    if ($@) {
51697      $ex = $@;
51698    }
51699
51700    $wfh->print("done\n");
51701    $wfh->flush();
51702
51703  } else {
51704    eval { server_wait($setup->{config_file}, $rfh) };
51705    if ($@) {
51706      warn($@);
51707      exit 1;
51708    }
51709
51710    exit 0;
51711  }
51712
51713  # Stop server
51714  server_stop($setup->{pid_file});
51715  $self->assert_child_ok($pid);
51716
51717  test_cleanup($setup->{log_file}, $ex);
51718}
51719
51720sub scp_upload_abs_symlink_chrooted_bug4219 {
51721  my $self = shift;
51722  my $tmpdir = $self->{tmpdir};
51723  my $setup = test_setup($tmpdir, 'scp');
51724
51725  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
51726  mkpath($test_dir);
51727
51728  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
51729  if (open(my $fh, "> $test_file")) {
51730    unless (close($fh)) {
51731      die("Can't write $test_file: $!");
51732    }
51733
51734  } else {
51735    die("Can't open $test_file: $!");
51736  }
51737
51738  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
51739
51740  my $dst_path = $test_file;
51741  if ($^O eq 'darwin') {
51742    # MacOSX-specific hack
51743    $dst_path = '/private' . $dst_path;
51744  }
51745
51746  unless (symlink($dst_path, $test_symlink)) {
51747    die("Can't symlink $test_symlink to $dst_path: $!");
51748  }
51749
51750  if ($< == 0) {
51751    unless (chmod(0755, $test_dir)) {
51752      die("Can't set perms on $test_dir to 0755: $!");
51753    }
51754
51755    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
51756      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
51757    }
51758  }
51759
51760  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51761  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51762
51763  my $config = {
51764    PidFile => $setup->{pid_file},
51765    ScoreboardFile => $setup->{scoreboard_file},
51766    SystemLog => $setup->{log_file},
51767    TraceLog => $setup->{log_file},
51768    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51769
51770    AuthUserFile => $setup->{auth_user_file},
51771    AuthGroupFile => $setup->{auth_group_file},
51772
51773    AllowOverwrite => 'on',
51774    DefaultRoot => '~',
51775
51776    IfModules => {
51777      'mod_delay.c' => {
51778        DelayEngine => 'off',
51779      },
51780
51781      'mod_sftp.c' => [
51782        "SFTPEngine on",
51783        "SFTPLog $setup->{log_file}",
51784        "SFTPHostKey $rsa_host_key",
51785        "SFTPHostKey $dsa_host_key",
51786      ],
51787    },
51788  };
51789
51790  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
51791    $config);
51792
51793  # Open pipes, for use between the parent and child processes.  Specifically,
51794  # the child will indicate when it's done with its test by writing a message
51795  # to the parent.
51796  my ($rfh, $wfh);
51797  unless (pipe($rfh, $wfh)) {
51798    die("Can't open pipe: $!");
51799  }
51800
51801  require Net::SSH2;
51802
51803  my $ex;
51804
51805  # Ignore SIGPIPE
51806  local $SIG{PIPE} = sub { };
51807
51808  # Fork child
51809  $self->handle_sigchld();
51810  defined(my $pid = fork()) or die("Can't fork: $!");
51811  if ($pid) {
51812    eval {
51813      my $ssh2 = Net::SSH2->new();
51814
51815      sleep(1);
51816
51817      unless ($ssh2->connect('127.0.0.1', $port)) {
51818        my ($err_code, $err_name, $err_str) = $ssh2->error();
51819        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51820      }
51821
51822      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
51823        my ($err_code, $err_name, $err_str) = $ssh2->error();
51824        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
51825      }
51826
51827      my $path = 'test.d/test.lnk';
51828      my $res = $ssh2->scp_put($setup->{config_file}, $path);
51829      unless ($res) {
51830        my ($err_code, $err_name, $err_str) = $ssh2->error();
51831        die("Can't upload to $path on server: [$err_name] ($err_code) $err_str");
51832      }
51833
51834      $ssh2->disconnect();
51835
51836      my $file_size = -s $test_file;
51837      $self->assert($file_size > 0,
51838        test_msg("Expected non-zero file size, got $file_size"));
51839    };
51840    if ($@) {
51841      $ex = $@;
51842    }
51843
51844    $wfh->print("done\n");
51845    $wfh->flush();
51846
51847  } else {
51848    eval { server_wait($setup->{config_file}, $rfh) };
51849    if ($@) {
51850      warn($@);
51851      exit 1;
51852    }
51853
51854    exit 0;
51855  }
51856
51857  # Stop server
51858  server_stop($setup->{pid_file});
51859  $self->assert_child_ok($pid);
51860
51861  test_cleanup($setup->{log_file}, $ex);
51862}
51863
51864sub scp_upload_rel_symlink {
51865  my $self = shift;
51866  my $tmpdir = $self->{tmpdir};
51867  my $setup = test_setup($tmpdir, 'scp');
51868
51869  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
51870  mkpath($test_dir);
51871
51872  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
51873  if (open(my $fh, "> $test_file")) {
51874    unless (close($fh)) {
51875      die("Can't write $test_file: $!");
51876    }
51877
51878  } else {
51879    die("Can't open $test_file: $!");
51880  }
51881
51882  # Change to the test directory in order to create a relative path in the
51883  # symlink we need
51884
51885  my $cwd = getcwd();
51886  unless (chdir($test_dir)) {
51887    die("Can't chdir to $test_dir: $!");
51888  }
51889
51890  unless (symlink('./test.txt', './test.lnk')) {
51891    die("Can't symlink 'test.lnk' to './test.txt': $!");
51892  }
51893
51894  unless (chdir($cwd)) {
51895    die("Can't chdir to $cwd: $!");
51896  }
51897
51898  if ($< == 0) {
51899    unless (chmod(0755, $test_dir)) {
51900      die("Can't set perms on $test_dir to 0755: $!");
51901    }
51902
51903    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
51904      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
51905    }
51906  }
51907
51908  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
51909  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
51910
51911  my $config = {
51912    PidFile => $setup->{pid_file},
51913    ScoreboardFile => $setup->{scoreboard_file},
51914    SystemLog => $setup->{log_file},
51915    TraceLog => $setup->{log_file},
51916    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
51917
51918    AuthUserFile => $setup->{auth_user_file},
51919    AuthGroupFile => $setup->{auth_group_file},
51920
51921    AllowOverwrite => 'on',
51922
51923    IfModules => {
51924      'mod_delay.c' => {
51925        DelayEngine => 'off',
51926      },
51927
51928      'mod_sftp.c' => [
51929        "SFTPEngine on",
51930        "SFTPLog $setup->{log_file}",
51931        "SFTPHostKey $rsa_host_key",
51932        "SFTPHostKey $dsa_host_key",
51933      ],
51934    },
51935  };
51936
51937  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
51938    $config);
51939
51940  # Open pipes, for use between the parent and child processes.  Specifically,
51941  # the child will indicate when it's done with its test by writing a message
51942  # to the parent.
51943  my ($rfh, $wfh);
51944  unless (pipe($rfh, $wfh)) {
51945    die("Can't open pipe: $!");
51946  }
51947
51948  require Net::SSH2;
51949
51950  my $ex;
51951
51952  # Ignore SIGPIPE
51953  local $SIG{PIPE} = sub { };
51954
51955  # Fork child
51956  $self->handle_sigchld();
51957  defined(my $pid = fork()) or die("Can't fork: $!");
51958  if ($pid) {
51959    eval {
51960      my $ssh2 = Net::SSH2->new();
51961
51962      sleep(1);
51963
51964      unless ($ssh2->connect('127.0.0.1', $port)) {
51965        my ($err_code, $err_name, $err_str) = $ssh2->error();
51966        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
51967      }
51968
51969      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
51970        my ($err_code, $err_name, $err_str) = $ssh2->error();
51971        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
51972      }
51973
51974      my $path = 'test.d/test.lnk';
51975      my $res = $ssh2->scp_put($setup->{config_file}, $path);
51976      unless ($res) {
51977        my ($err_code, $err_name, $err_str) = $ssh2->error();
51978        die("Can't upload to $path on server: [$err_name] ($err_code) $err_str");
51979      }
51980
51981      $ssh2->disconnect();
51982
51983      my $file_size = -s $test_file;
51984      $self->assert($file_size > 0,
51985        test_msg("Expected non-zero file size, got $file_size"));
51986    };
51987    if ($@) {
51988      $ex = $@;
51989    }
51990
51991    $wfh->print("done\n");
51992    $wfh->flush();
51993
51994  } else {
51995    eval { server_wait($setup->{config_file}, $rfh) };
51996    if ($@) {
51997      warn($@);
51998      exit 1;
51999    }
52000
52001    exit 0;
52002  }
52003
52004  # Stop server
52005  server_stop($setup->{pid_file});
52006  $self->assert_child_ok($pid);
52007
52008  test_cleanup($setup->{log_file}, $ex);
52009}
52010
52011sub scp_upload_rel_symlink_chrooted_bug4219 {
52012  my $self = shift;
52013  my $tmpdir = $self->{tmpdir};
52014  my $setup = test_setup($tmpdir, 'scp');
52015
52016  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
52017  mkpath($test_dir);
52018
52019  my $test_file = File::Spec->rel2abs("$test_dir/test.txt");
52020  if (open(my $fh, "> $test_file")) {
52021    unless (close($fh)) {
52022      die("Can't write $test_file: $!");
52023    }
52024
52025  } else {
52026    die("Can't open $test_file: $!");
52027  }
52028
52029  # Change to the test directory in order to create a relative path in the
52030  # symlink we need
52031
52032  my $cwd = getcwd();
52033  unless (chdir($test_dir)) {
52034    die("Can't chdir to $test_dir: $!");
52035  }
52036
52037  unless (symlink('./test.txt', './test.lnk')) {
52038    die("Can't symlink 'test.lnk' to './test.txt': $!");
52039  }
52040
52041  unless (chdir($cwd)) {
52042    die("Can't chdir to $cwd: $!");
52043  }
52044
52045  if ($< == 0) {
52046    unless (chmod(0755, $test_dir)) {
52047      die("Can't set perms on $test_dir to 0755: $!");
52048    }
52049
52050    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $test_file)) {
52051      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
52052    }
52053  }
52054
52055  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52056  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52057
52058  my $config = {
52059    PidFile => $setup->{pid_file},
52060    ScoreboardFile => $setup->{scoreboard_file},
52061    SystemLog => $setup->{log_file},
52062    TraceLog => $setup->{log_file},
52063    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
52064
52065    AuthUserFile => $setup->{auth_user_file},
52066    AuthGroupFile => $setup->{auth_group_file},
52067
52068    AllowOverwrite => 'on',
52069    DefaultRoot => '~',
52070
52071    IfModules => {
52072      'mod_delay.c' => {
52073        DelayEngine => 'off',
52074      },
52075
52076      'mod_sftp.c' => [
52077        "SFTPEngine on",
52078        "SFTPLog $setup->{log_file}",
52079        "SFTPHostKey $rsa_host_key",
52080        "SFTPHostKey $dsa_host_key",
52081      ],
52082    },
52083  };
52084
52085  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
52086    $config);
52087
52088  # Open pipes, for use between the parent and child processes.  Specifically,
52089  # the child will indicate when it's done with its test by writing a message
52090  # to the parent.
52091  my ($rfh, $wfh);
52092  unless (pipe($rfh, $wfh)) {
52093    die("Can't open pipe: $!");
52094  }
52095
52096  require Net::SSH2;
52097
52098  my $ex;
52099
52100  # Ignore SIGPIPE
52101  local $SIG{PIPE} = sub { };
52102
52103  # Fork child
52104  $self->handle_sigchld();
52105  defined(my $pid = fork()) or die("Can't fork: $!");
52106  if ($pid) {
52107    eval {
52108      my $ssh2 = Net::SSH2->new();
52109
52110      sleep(1);
52111
52112      unless ($ssh2->connect('127.0.0.1', $port)) {
52113        my ($err_code, $err_name, $err_str) = $ssh2->error();
52114        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
52115      }
52116
52117      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
52118        my ($err_code, $err_name, $err_str) = $ssh2->error();
52119        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
52120      }
52121
52122      my $path = 'test.d/test.lnk';
52123      my $res = $ssh2->scp_put($setup->{config_file}, $path);
52124      unless ($res) {
52125        my ($err_code, $err_name, $err_str) = $ssh2->error();
52126        die("Can't upload to $path on server: [$err_name] ($err_code) $err_str");
52127      }
52128
52129      $ssh2->disconnect();
52130
52131      my $file_size = -s $test_file;
52132      $self->assert($file_size > 0,
52133        test_msg("Expected non-zero file size, got $file_size"));
52134    };
52135    if ($@) {
52136      $ex = $@;
52137    }
52138
52139    $wfh->print("done\n");
52140    $wfh->flush();
52141
52142  } else {
52143    eval { server_wait($setup->{config_file}, $rfh) };
52144    if ($@) {
52145      warn($@);
52146      exit 1;
52147    }
52148
52149    exit 0;
52150  }
52151
52152  # Stop server
52153  server_stop($setup->{pid_file});
52154  $self->assert_child_ok($pid);
52155
52156  test_cleanup($setup->{log_file}, $ex);
52157}
52158
52159sub scp_upload_subdir_enoent {
52160  my $self = shift;
52161  my $tmpdir = $self->{tmpdir};
52162
52163  my $config_file = "$tmpdir/sftp.conf";
52164  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
52165  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
52166
52167  my $log_file = test_get_logfile();
52168
52169  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
52170  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
52171
52172  my $user = 'proftpd';
52173  my $passwd = 'test';
52174  my $group = 'ftpd';
52175  my $home_dir = File::Spec->rel2abs($tmpdir);
52176  my $uid = 500;
52177  my $gid = 500;
52178
52179  my $subdir = File::Spec->rel2abs("$tmpdir/subdir");
52180
52181  # Make sure that, if we're running as root, that the home directory has
52182  # permissions/privs set for the account we create
52183  if ($< == 0) {
52184    unless (chmod(0755, $home_dir)) {
52185      die("Can't set perms on $home_dir to 0755: $!");
52186    }
52187
52188    unless (chown($uid, $gid, $home_dir)) {
52189      die("Can't set owner of $home_dir to $uid/$gid: $!");
52190    }
52191  }
52192
52193  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
52194    '/bin/bash');
52195  auth_group_write($auth_group_file, $group, $gid, $user);
52196
52197  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52198  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52199
52200  my $test_file = File::Spec->rel2abs("$subdir/test.txt");
52201
52202  my $config = {
52203    PidFile => $pid_file,
52204    ScoreboardFile => $scoreboard_file,
52205    SystemLog => $log_file,
52206    TraceLog => $log_file,
52207    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
52208
52209    AuthUserFile => $auth_user_file,
52210    AuthGroupFile => $auth_group_file,
52211
52212    IfModules => {
52213      'mod_delay.c' => {
52214        DelayEngine => 'off',
52215      },
52216
52217      'mod_sftp.c' => [
52218        "SFTPEngine on",
52219        "SFTPLog $log_file",
52220        "SFTPHostKey $rsa_host_key",
52221        "SFTPHostKey $dsa_host_key",
52222      ],
52223    },
52224  };
52225
52226  my ($port, $config_user, $config_group) = config_write($config_file, $config);
52227
52228  # Open pipes, for use between the parent and child processes.  Specifically,
52229  # the child will indicate when it's done with its test by writing a message
52230  # to the parent.
52231  my ($rfh, $wfh);
52232  unless (pipe($rfh, $wfh)) {
52233    die("Can't open pipe: $!");
52234  }
52235
52236  require Net::SSH2;
52237
52238  my $ex;
52239
52240  # Ignore SIGPIPE
52241  local $SIG{PIPE} = sub { };
52242
52243  # Fork child
52244  $self->handle_sigchld();
52245  defined(my $pid = fork()) or die("Can't fork: $!");
52246  if ($pid) {
52247    eval {
52248      my $ssh2 = Net::SSH2->new();
52249
52250      sleep(1);
52251
52252      unless ($ssh2->connect('127.0.0.1', $port)) {
52253        my ($err_code, $err_name, $err_str) = $ssh2->error();
52254        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
52255      }
52256
52257      unless ($ssh2->auth_password($user, $passwd)) {
52258        my ($err_code, $err_name, $err_str) = $ssh2->error();
52259        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
52260      }
52261
52262      my $res = $ssh2->scp_put($config_file, 'subdir/test.txt');
52263      if ($res) {
52264        die("Upload of $config_file succeeded unexpectedly");
52265      }
52266
52267      if (-f $test_file) {
52268        die("$test_file file exists unexpectedly");
52269      }
52270
52271      $ssh2->disconnect();
52272    };
52273
52274    if ($@) {
52275      $ex = $@;
52276    }
52277
52278    $wfh->print("done\n");
52279    $wfh->flush();
52280
52281  } else {
52282    eval { server_wait($config_file, $rfh) };
52283    if ($@) {
52284      warn($@);
52285      exit 1;
52286    }
52287
52288    exit 0;
52289  }
52290
52291  # Stop server
52292  server_stop($pid_file);
52293
52294  $self->assert_child_ok($pid);
52295
52296  if ($ex) {
52297    test_append_logfile($log_file, $ex);
52298    unlink($log_file);
52299
52300    die($ex);
52301  }
52302
52303  unlink($log_file);
52304}
52305
52306sub scp_upload_subdir_enoent_with_limits {
52307  my $self = shift;
52308  my $tmpdir = $self->{tmpdir};
52309
52310  my $config_file = "$tmpdir/sftp.conf";
52311  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
52312  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
52313
52314  my $log_file = test_get_logfile();
52315
52316  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
52317  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
52318
52319  my $user = 'proftpd';
52320  my $passwd = 'test';
52321  my $group = 'ftpd';
52322  my $home_dir = File::Spec->rel2abs($tmpdir);
52323  my $uid = 500;
52324  my $gid = 500;
52325
52326  my $subdir = File::Spec->rel2abs("$tmpdir/subdir");
52327
52328  # Make sure that, if we're running as root, that the home directory has
52329  # permissions/privs set for the account we create
52330  if ($< == 0) {
52331    unless (chmod(0755, $home_dir)) {
52332      die("Can't set perms on $home_dir to 0755: $!");
52333    }
52334
52335    unless (chown($uid, $gid, $home_dir)) {
52336      die("Can't set owner of $home_dir to $uid/$gid: $!");
52337    }
52338  }
52339
52340  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
52341    '/bin/bash');
52342  auth_group_write($auth_group_file, $group, $gid, $user);
52343
52344  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52345  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52346
52347  my $test_file = File::Spec->rel2abs("$subdir/test.txt");
52348
52349  my $config = {
52350    PidFile => $pid_file,
52351    ScoreboardFile => $scoreboard_file,
52352    SystemLog => $log_file,
52353    TraceLog => $log_file,
52354    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
52355
52356    AuthUserFile => $auth_user_file,
52357    AuthGroupFile => $auth_group_file,
52358
52359    DefaultRoot => '~',
52360
52361    IfModules => {
52362      'mod_delay.c' => {
52363        DelayEngine => 'off',
52364      },
52365
52366      'mod_sftp.c' => [
52367        "SFTPEngine on",
52368        "SFTPLog $log_file",
52369        "SFTPHostKey $rsa_host_key",
52370        "SFTPHostKey $dsa_host_key",
52371      ],
52372    },
52373  };
52374
52375  my ($port, $config_user, $config_group) = config_write($config_file, $config);
52376
52377  if (open(my $fh, ">> $config_file")) {
52378    print $fh <<EOL;
52379<Directory ~>
52380  <Limit MKD XMKD RMD RNFR RNTO>
52381    Order allow,deny
52382    DenyAll
52383  </Limit>
52384  <Limit STOR>
52385    Order allow,deny
52386    AllowUser foo
52387    DenyAll
52388  </Limit>
52389  <Limit RETR DELE>
52390    Order allow,deny
52391    AllowUser foo
52392    DenyAll
52393  </Limit>
52394</Directory>
52395EOL
52396    unless (close($fh)) {
52397      die("Can't write $config_file: $!");
52398    }
52399
52400  } else {
52401    die("Can't open $config_file: $!");
52402  }
52403
52404  # Open pipes, for use between the parent and child processes.  Specifically,
52405  # the child will indicate when it's done with its test by writing a message
52406  # to the parent.
52407  my ($rfh, $wfh);
52408  unless (pipe($rfh, $wfh)) {
52409    die("Can't open pipe: $!");
52410  }
52411
52412  require Net::SSH2;
52413
52414  my $ex;
52415
52416  # Ignore SIGPIPE
52417  local $SIG{PIPE} = sub { };
52418
52419  # Fork child
52420  $self->handle_sigchld();
52421  defined(my $pid = fork()) or die("Can't fork: $!");
52422  if ($pid) {
52423    eval {
52424      my $ssh2 = Net::SSH2->new();
52425
52426      sleep(1);
52427
52428      unless ($ssh2->connect('127.0.0.1', $port)) {
52429        my ($err_code, $err_name, $err_str) = $ssh2->error();
52430        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
52431      }
52432
52433      unless ($ssh2->auth_password($user, $passwd)) {
52434        my ($err_code, $err_name, $err_str) = $ssh2->error();
52435        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
52436      }
52437
52438      my $res = $ssh2->scp_put($config_file, 'subdir/');
52439      if ($res) {
52440        die("Upload of $config_file succeeded unexpectedly");
52441      }
52442
52443      if (-f $test_file) {
52444        die("$test_file file exists unexpectedly");
52445      }
52446
52447      $ssh2->disconnect();
52448    };
52449
52450    if ($@) {
52451      $ex = $@;
52452    }
52453
52454    $wfh->print("done\n");
52455    $wfh->flush();
52456
52457  } else {
52458    eval { server_wait($config_file, $rfh) };
52459    if ($@) {
52460      warn($@);
52461      exit 1;
52462    }
52463
52464    exit 0;
52465  }
52466
52467  # Stop server
52468  server_stop($pid_file);
52469
52470  $self->assert_child_ok($pid);
52471
52472  if ($ex) {
52473    test_append_logfile($log_file, $ex);
52474    unlink($log_file);
52475
52476    die($ex);
52477  }
52478
52479  unlink($log_file);
52480}
52481
52482sub scp_upload_fifo_bug3312 {
52483  my $self = shift;
52484  my $tmpdir = $self->{tmpdir};
52485
52486  my $config_file = "$tmpdir/sftp.conf";
52487  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
52488  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
52489
52490  my $log_file = test_get_logfile();
52491
52492  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
52493  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
52494
52495  my $user = 'proftpd';
52496  my $passwd = 'test';
52497  my $group = 'ftpd';
52498  my $home_dir = File::Spec->rel2abs($tmpdir);
52499  my $uid = 500;
52500  my $gid = 500;
52501
52502  # Make sure that, if we're running as root, that the home directory has
52503  # permissions/privs set for the account we create
52504  if ($< == 0) {
52505    unless (chmod(0755, $home_dir)) {
52506      die("Can't set perms on $home_dir to 0755: $!");
52507    }
52508
52509    unless (chown($uid, $gid, $home_dir)) {
52510      die("Can't set owner of $home_dir to $uid/$gid: $!");
52511    }
52512  }
52513
52514  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
52515    '/bin/bash');
52516  auth_group_write($auth_group_file, $group, $gid, $user);
52517
52518  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52519  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52520
52521  my $fifo = File::Spec->rel2abs("$tmpdir/test.fifo");
52522  unless (POSIX::mkfifo($fifo, 0666)) {
52523    die("Can't create fifo $fifo: $!");
52524  }
52525
52526  my $config = {
52527    PidFile => $pid_file,
52528    ScoreboardFile => $scoreboard_file,
52529    SystemLog => $log_file,
52530    TraceLog => $log_file,
52531    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
52532
52533    AuthUserFile => $auth_user_file,
52534    AuthGroupFile => $auth_group_file,
52535    AllowOverwrite => 'on',
52536
52537    IfModules => {
52538      'mod_delay.c' => {
52539        DelayEngine => 'off',
52540      },
52541
52542      'mod_sftp.c' => [
52543        "SFTPEngine on",
52544        "SFTPLog $log_file",
52545        "SFTPHostKey $rsa_host_key",
52546        "SFTPHostKey $dsa_host_key",
52547      ],
52548    },
52549  };
52550
52551  my ($port, $config_user, $config_group) = config_write($config_file, $config);
52552
52553  # Open pipes, for use between the parent and child processes.  Specifically,
52554  # the child will indicate when it's done with its test by writing a message
52555  # to the parent.
52556  my ($rfh, $wfh);
52557  unless (pipe($rfh, $wfh)) {
52558    die("Can't open pipe: $!");
52559  }
52560
52561  require Net::SSH2;
52562
52563  my $ex;
52564
52565  # Ignore SIGPIPE
52566  local $SIG{PIPE} = sub { };
52567
52568  # Fork child
52569  $self->handle_sigchld();
52570  defined(my $pid = fork()) or die("Can't fork: $!");
52571  if ($pid) {
52572    eval {
52573      my $ssh2 = Net::SSH2->new();
52574
52575      sleep(1);
52576
52577      unless ($ssh2->connect('127.0.0.1', $port)) {
52578        my ($err_code, $err_name, $err_str) = $ssh2->error();
52579        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
52580      }
52581
52582      unless ($ssh2->auth_password($user, $passwd)) {
52583        my ($err_code, $err_name, $err_str) = $ssh2->error();
52584        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
52585      }
52586
52587      if ($ssh2->scp_put($config_file, 'test.fifo')) {
52588        die("Upload of $config_file to server succeeded unexpectedly");
52589      }
52590
52591      my ($err_code, $err_name, $err_str) = $ssh2->error();
52592
52593      $ssh2->disconnect();
52594
52595      if ($err_code) {
52596        chomp($err_str);
52597        my $expected = '(test.fifo: (No such device or address|Device not configured))|(failed to send file)$';
52598
52599        $self->assert(qr/$expected/, $err_str,
52600          test_msg("Expected '$expected', got '$err_str'"));
52601      }
52602    };
52603
52604    if ($@) {
52605      $ex = $@;
52606    }
52607
52608    $wfh->print("done\n");
52609    $wfh->flush();
52610
52611  } else {
52612    eval { server_wait($config_file, $rfh) };
52613    if ($@) {
52614      warn($@);
52615      exit 1;
52616    }
52617
52618    exit 0;
52619  }
52620
52621  # Stop server
52622  server_stop($pid_file);
52623
52624  $self->assert_child_ok($pid);
52625
52626  if ($ex) {
52627    test_append_logfile($log_file, $ex);
52628    unlink($log_file);
52629
52630    die($ex);
52631  }
52632
52633  unlink($log_file);
52634}
52635
52636sub scp_upload_fifo_bug3313 {
52637  my $self = shift;
52638  my $tmpdir = $self->{tmpdir};
52639
52640  my $config_file = "$tmpdir/sftp.conf";
52641  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
52642  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
52643
52644  my $log_file = test_get_logfile();
52645
52646  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
52647  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
52648
52649  my $user = 'proftpd';
52650  my $passwd = 'test';
52651  my $group = 'ftpd';
52652  my $home_dir = File::Spec->rel2abs($tmpdir);
52653  my $uid = 500;
52654  my $gid = 500;
52655
52656  # Make sure that, if we're running as root, that the home directory has
52657  # permissions/privs set for the account we create
52658  if ($< == 0) {
52659    unless (chmod(0755, $home_dir)) {
52660      die("Can't set perms on $home_dir to 0755: $!");
52661    }
52662
52663    unless (chown($uid, $gid, $home_dir)) {
52664      die("Can't set owner of $home_dir to $uid/$gid: $!");
52665    }
52666  }
52667
52668  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
52669    '/bin/bash');
52670  auth_group_write($auth_group_file, $group, $gid, $user);
52671
52672  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52673  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52674
52675  my $fifo = File::Spec->rel2abs("/tmp/test.fifo");
52676
52677  my $config = {
52678    PidFile => $pid_file,
52679    ScoreboardFile => $scoreboard_file,
52680    SystemLog => $log_file,
52681    TraceLog => $log_file,
52682    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
52683
52684    AuthUserFile => $auth_user_file,
52685    AuthGroupFile => $auth_group_file,
52686    AllowOverwrite => 'on',
52687
52688    IfModules => {
52689      'mod_delay.c' => {
52690        DelayEngine => 'off',
52691      },
52692
52693      'mod_sftp.c' => [
52694        "SFTPEngine on",
52695        "SFTPLog $log_file",
52696        "SFTPHostKey $rsa_host_key",
52697        "SFTPHostKey $dsa_host_key",
52698      ],
52699    },
52700  };
52701
52702  my ($port, $config_user, $config_group) = config_write($config_file, $config);
52703
52704  # Open pipes, for use between the parent and child processes.  Specifically,
52705  # the child will indicate when it's done with its test by writing a message
52706  # to the parent.
52707  my ($rfh, $wfh);
52708  unless (pipe($rfh, $wfh)) {
52709    die("Can't open pipe: $!");
52710  }
52711
52712  require Net::SSH2;
52713
52714  my $ex;
52715
52716  # Ignore SIGPIPE
52717  local $SIG{PIPE} = sub { };
52718
52719  # Fork child
52720  $self->handle_sigchld();
52721  defined(my $pid = fork()) or die("Can't fork: $!");
52722  if ($pid) {
52723    eval {
52724      my $ssh2 = Net::SSH2->new();
52725
52726      sleep(1);
52727
52728      unless ($ssh2->connect('127.0.0.1', $port)) {
52729        my ($err_code, $err_name, $err_str) = $ssh2->error();
52730        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
52731      }
52732
52733      unless ($ssh2->auth_password($user, $passwd)) {
52734        my ($err_code, $err_name, $err_str) = $ssh2->error();
52735        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
52736      }
52737
52738      my $res = $ssh2->scp_put($config_file, $fifo);
52739      unless ($res) {
52740        my ($err_code, $err_name, $err_str) = $ssh2->error();
52741        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
52742      }
52743
52744      $ssh2->disconnect();
52745    };
52746
52747    if ($@) {
52748      $ex = $@;
52749    }
52750
52751    $wfh->print("done\n");
52752    $wfh->flush();
52753
52754  } else {
52755    eval { server_wait($config_file, $rfh) };
52756    if ($@) {
52757      warn($@);
52758      exit 1;
52759    }
52760
52761    exit 0;
52762  }
52763
52764  # Stop server
52765  server_stop($pid_file);
52766
52767  $self->assert_child_ok($pid);
52768
52769  if ($ex) {
52770    test_append_logfile($log_file, $ex);
52771    unlink($log_file);
52772
52773    die($ex);
52774  }
52775
52776  unlink($log_file);
52777}
52778
52779sub scp_ext_null_ptr_issue1043 {
52780  my $self = shift;
52781  my $tmpdir = $self->{tmpdir};
52782  my $setup = test_setup($tmpdir, 'scp');
52783
52784  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52785  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52786
52787  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
52788  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
52789
52790  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
52791  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
52792    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
52793  }
52794
52795  my $config = {
52796    PidFile => $setup->{pid_file},
52797    ScoreboardFile => $setup->{scoreboard_file},
52798    SystemLog => $setup->{log_file},
52799    TraceLog => $setup->{log_file},
52800    Trace => 'DEFAULT:10 ssh2:20 scp:20',
52801
52802    AuthUserFile => $setup->{auth_user_file},
52803    AuthGroupFile => $setup->{auth_group_file},
52804
52805    IfModules => {
52806      'mod_delay.c' => {
52807        DelayEngine => 'off',
52808      },
52809
52810      'mod_sftp.c' => [
52811        "SFTPEngine on",
52812        "SFTPLog $setup->{log_file}",
52813        "SFTPHostKey $rsa_host_key",
52814        "SFTPHostKey $dsa_host_key",
52815        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
52816      ],
52817    },
52818  };
52819
52820  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
52821    $config);
52822
52823  # Open pipes, for use between the parent and child processes.  Specifically,
52824  # the child will indicate when it's done with its test by writing a message
52825  # to the parent.
52826  my ($rfh, $wfh);
52827  unless (pipe($rfh, $wfh)) {
52828    die("Can't open pipe: $!");
52829  }
52830
52831  require Net::SSH2;
52832
52833  my $ex;
52834
52835  # Ignore SIGPIPE
52836  local $SIG{PIPE} = sub { };
52837
52838  # Fork child
52839  $self->handle_sigchld();
52840  defined(my $pid = fork()) or die("Can't fork: $!");
52841  if ($pid) {
52842    eval {
52843      my @cmd = (
52844        'ssh',
52845        '-vv',
52846        '-oBatchMode=yes',
52847        '-oCheckHostIP=no',
52848        "-oPort=$port",
52849        "-oIdentityFile=$rsa_priv_key",
52850        '-oPubkeyAuthentication=yes',
52851        '-oStrictHostKeyChecking=no',
52852        "$setup->{user}\@127.0.0.1",
52853        'scp'
52854      );
52855
52856      my $scp_rh = IO::Handle->new();
52857      my $scp_wh = IO::Handle->new();
52858      my $scp_eh = IO::Handle->new();
52859
52860      $scp_wh->autoflush(1);
52861
52862      sleep(1);
52863
52864      local $SIG{CHLD} = 'DEFAULT';
52865
52866      # Make sure that the perms on the priv key are what OpenSSH wants
52867      unless (chmod(0400, $rsa_priv_key)) {
52868        die("Can't set perms on $rsa_priv_key to 0400: $!");
52869      }
52870
52871      if ($ENV{TEST_VERBOSE}) {
52872        print STDERR "Executing: ", join(' ', @cmd), "\n";
52873      }
52874
52875      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
52876      waitpid($scp_pid, 0);
52877      my $exit_status = $?;
52878
52879      # Restore the perms on the priv key
52880      unless (chmod(0644, $rsa_priv_key)) {
52881        die("Can't set perms on $rsa_priv_key to 0644: $!");
52882      }
52883
52884      my ($res, $errstr);
52885      if ($exit_status >> 8 == 0) {
52886        $errstr = join('', <$scp_eh>);
52887        $res = 0;
52888
52889      } else {
52890        $errstr = join('', <$scp_eh>);
52891        if ($ENV{TEST_VERBOSE}) {
52892          print STDERR "Stderr: $errstr\n";
52893        }
52894
52895        $res = 1;
52896      }
52897
52898      if ($res == 0) {
52899        die("'scp' command succeeded unexpectedly");
52900      }
52901    };
52902    if ($@) {
52903      $ex = $@;
52904    }
52905
52906    $wfh->print("done\n");
52907    $wfh->flush();
52908
52909  } else {
52910    eval { server_wait($setup->{config_file}, $rfh) };
52911    if ($@) {
52912      warn($@);
52913      exit 1;
52914    }
52915
52916    exit 0;
52917  }
52918
52919  # Stop server
52920  server_stop($setup->{pid_file});
52921  $self->assert_child_ok($pid);
52922
52923  eval {
52924    if (open(my $fh, "< $setup->{log_file}")) {
52925      my $ok = 0;
52926
52927      while (my $line = <$fh>) {
52928        if ($line =~ /request provided no paths/) {
52929          $ok = 1;
52930          last;
52931        }
52932      }
52933
52934      close($fh);
52935      $self->assert($ok, test_msg("Did not see expected SCP error in logs"));
52936
52937    } else {
52938      die("Can't read $setup->{log_file}: $!");
52939    }
52940  };
52941  if ($@) {
52942    $ex = $@;
52943  }
52944
52945  test_cleanup($setup->{log_file}, $ex);
52946}
52947
52948sub scp_ext_upload_recursive_dir_bug3447 {
52949  my $self = shift;
52950  my $tmpdir = $self->{tmpdir};
52951
52952  my $config_file = "$tmpdir/sftp.conf";
52953  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
52954  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
52955
52956  my $log_file = test_get_logfile();
52957
52958  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
52959  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
52960
52961  my $user = 'proftpd';
52962  my $passwd = 'test';
52963  my $group = 'ftpd';
52964  my $home_dir = File::Spec->rel2abs($tmpdir);
52965  my $uid = 500;
52966  my $gid = 500;
52967
52968  # Make sure that, if we're running as root, that the home directory has
52969  # permissions/privs set for the account we create
52970  if ($< == 0) {
52971    unless (chmod(0755, $home_dir)) {
52972      die("Can't set perms on $home_dir to 0755: $!");
52973    }
52974
52975    unless (chown($uid, $gid, $home_dir)) {
52976      die("Can't set owner of $home_dir to $uid/$gid: $!");
52977    }
52978  }
52979
52980  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
52981    '/bin/bash');
52982  auth_group_write($auth_group_file, $group, $gid, $user);
52983
52984  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
52985  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
52986
52987  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
52988  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
52989
52990  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
52991  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
52992    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
52993  }
52994
52995  # For this test, we need the following directory structure:
52996  #
52997  #  src/
52998  #    files
52999  #    subdir1/
53000  #      files
53001  #    subdir2
53002  #      files
53003  #
53004  # The bug happened because mod_sftp was expecting the end-of-directory
53005  # marker under the wrong conditions.  The triggering of the bug depends
53006  # on the order in which the client sends its control messages, which in
53007  # turn (in the case of OpenSSH) is depending on the order of directory
53008  # entries returned by readdir(2).
53009
53010  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
53011  mkpath($src_dir);
53012
53013  my $count = 25;
53014  for (my $i = 0; $i < $count; $i++) {
53015    my $filename = (chr(97 + $i)) . sprintf("%03s", $i);
53016    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
53017
53018    if (open(my $fh, "> $src_file")) {
53019      print $fh "ABCDefgh" x 7891;
53020
53021      unless (close($fh)) {
53022        die("Can't write $src_file: $!");
53023    }
53024
53025    } else {
53026      die("Can't open $src_file: $!");
53027    }
53028  }
53029
53030  for (my $i = 0; $i < $count; $i++) {
53031    my $filename = (chr(65 + $i)) . sprintf("%03s", $i);
53032    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
53033
53034    if (open(my $fh, "> $src_file")) {
53035      print $fh "ABCDefgh" x 6458;
53036
53037      unless (close($fh)) {
53038        die("Can't write $src_file: $!");
53039    }
53040
53041    } else {
53042      die("Can't open $src_file: $!");
53043    }
53044  }
53045
53046  my $src_subdir = File::Spec->rel2abs("$src_dir/cd.d");
53047  mkpath($src_subdir);
53048
53049  for (my $i = 0; $i < $count; $i++) {
53050    my $filename = 'aa' . sprintf("%03s", $i);
53051    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
53052
53053    if (open(my $fh, "> $src_file")) {
53054      print $fh "ABCDefgh" x 9802;
53055
53056      unless (close($fh)) {
53057        die("Can't write $src_file: $!");
53058    }
53059
53060    } else {
53061      die("Can't open $src_file: $!");
53062    }
53063  }
53064
53065  $src_subdir = File::Spec->rel2abs("$src_dir/wx.d");
53066  mkpath($src_subdir);
53067
53068  for (my $i = 0; $i < $count; $i++) {
53069    my $filename = 'aa' . sprintf("%03s", $i);
53070    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
53071
53072    if (open(my $fh, "> $src_file")) {
53073      print $fh "ABCDefgh" x 8192;
53074
53075      unless (close($fh)) {
53076        die("Can't write $src_file: $!");
53077    }
53078
53079    } else {
53080      die("Can't open $src_file: $!");
53081    }
53082  }
53083
53084  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
53085  mkpath($dst_dir);
53086
53087  my $config = {
53088    PidFile => $pid_file,
53089    ScoreboardFile => $scoreboard_file,
53090    SystemLog => $log_file,
53091    TraceLog => $log_file,
53092    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
53093
53094    AuthUserFile => $auth_user_file,
53095    AuthGroupFile => $auth_group_file,
53096
53097    IfModules => {
53098      'mod_delay.c' => {
53099        DelayEngine => 'off',
53100      },
53101
53102      'mod_sftp.c' => [
53103        "SFTPEngine on",
53104        "SFTPLog $log_file",
53105        "SFTPHostKey $rsa_host_key",
53106        "SFTPHostKey $dsa_host_key",
53107        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
53108      ],
53109    },
53110  };
53111
53112  my ($port, $config_user, $config_group) = config_write($config_file, $config);
53113
53114  # Open pipes, for use between the parent and child processes.  Specifically,
53115  # the child will indicate when it's done with its test by writing a message
53116  # to the parent.
53117  my ($rfh, $wfh);
53118  unless (pipe($rfh, $wfh)) {
53119    die("Can't open pipe: $!");
53120  }
53121
53122  require Net::SSH2;
53123
53124  my $ex;
53125
53126  # Ignore SIGPIPE
53127  local $SIG{PIPE} = sub { };
53128
53129  # Fork child
53130  $self->handle_sigchld();
53131  defined(my $pid = fork()) or die("Can't fork: $!");
53132  if ($pid) {
53133    eval {
53134      my @cmd = (
53135        'scp',
53136        '-r',
53137        '-v',
53138        '-oBatchMode=yes',
53139        '-oCheckHostIP=no',
53140        "-oPort=$port",
53141        "-oIdentityFile=$rsa_priv_key",
53142        '-oPubkeyAuthentication=yes',
53143        '-oStrictHostKeyChecking=no',
53144        "$src_dir/",
53145        "$user\@127.0.0.1:dst.d/",
53146      );
53147
53148      my $scp_rh = IO::Handle->new();
53149      my $scp_wh = IO::Handle->new();
53150      my $scp_eh = IO::Handle->new();
53151
53152      $scp_wh->autoflush(1);
53153
53154      sleep(1);
53155
53156      local $SIG{CHLD} = 'DEFAULT';
53157
53158      # Make sure that the perms on the priv key are what OpenSSH wants
53159      unless (chmod(0400, $rsa_priv_key)) {
53160        die("Can't set perms on $rsa_priv_key to 0400: $!");
53161      }
53162
53163      if ($ENV{TEST_VERBOSE}) {
53164        print STDERR "Executing: ", join(' ', @cmd), "\n";
53165      }
53166
53167      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
53168      waitpid($scp_pid, 0);
53169      my $exit_status = $?;
53170
53171      # Restore the perms on the priv key
53172      unless (chmod(0644, $rsa_priv_key)) {
53173        die("Can't set perms on $rsa_priv_key to 0644: $!");
53174      }
53175
53176      my ($res, $errstr);
53177      if ($exit_status >> 8 == 0) {
53178        $errstr = join('', <$scp_eh>);
53179        $res = 0;
53180
53181      } else {
53182        $errstr = join('', <$scp_eh>);
53183        if ($ENV{TEST_VERBOSE}) {
53184          print STDERR "Stderr: $errstr\n";
53185        }
53186
53187        $res = 1;
53188      }
53189
53190      unless ($res == 0) {
53191        die("Can't upload $src_dir to server: $errstr");
53192      }
53193
53194      if ($^O eq 'darwin') {
53195        $dst_dir = '/private' . $dst_dir;
53196      }
53197
53198      unless (-d "$dst_dir/src.d") {
53199        die("Directory '$dst_dir/src.d' does not exist as expected");
53200      }
53201
53202      unless (-f "$dst_dir/src.d/y024") {
53203        die("File '$dst_dir/src.d/y024' does not exist as expected");
53204      }
53205
53206      unless (-f "$dst_dir/src.d/Y024") {
53207        die("File '$dst_dir/src.d/Y024' does not exist as expected");
53208      }
53209
53210      unless (-d "$dst_dir/src.d/cd.d") {
53211        die("Directory '$dst_dir/src.d/cd.d' does not exist as expected");
53212      }
53213
53214      unless (-f "$dst_dir/src.d/cd.d/aa024") {
53215        die("File '$dst_dir/src.d/cd.d/aa024' does not exist as expected");
53216      }
53217
53218      unless (-d "$dst_dir/src.d/wx.d") {
53219        die("Directory '$dst_dir/src.d/wx.d' does not exist as expected");
53220      }
53221
53222      unless (-f "$dst_dir/src.d/wx.d/aa024") {
53223        die("File '$dst_dir/src.d/wx.d/aa024' does not exist as expected");
53224      }
53225
53226    };
53227
53228    if ($@) {
53229      $ex = $@;
53230    }
53231
53232    $wfh->print("done\n");
53233    $wfh->flush();
53234
53235  } else {
53236    eval { server_wait($config_file, $rfh) };
53237    if ($@) {
53238      warn($@);
53239      exit 1;
53240    }
53241
53242    exit 0;
53243  }
53244
53245  # Stop server
53246  server_stop($pid_file);
53247
53248  $self->assert_child_ok($pid);
53249
53250  if ($ex) {
53251    test_append_logfile($log_file, $ex);
53252    unlink($log_file);
53253
53254    die($ex);
53255  }
53256
53257  unlink($log_file);
53258}
53259
53260sub scp_ext_upload_recursive_dir_bug3792 {
53261  my $self = shift;
53262  my $tmpdir = $self->{tmpdir};
53263
53264  my $config_file = "$tmpdir/sftp.conf";
53265  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
53266  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
53267
53268  my $log_file = test_get_logfile();
53269
53270  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
53271  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
53272
53273  my $user = 'proftpd';
53274  my $passwd = 'test';
53275  my $group = 'ftpd';
53276  my $home_dir = File::Spec->rel2abs($tmpdir);
53277  my $uid = 500;
53278  my $gid = 500;
53279
53280  # Make sure that, if we're running as root, that the home directory has
53281  # permissions/privs set for the account we create
53282  if ($< == 0) {
53283    unless (chmod(0755, $home_dir)) {
53284      die("Can't set perms on $home_dir to 0755: $!");
53285    }
53286
53287    unless (chown($uid, $gid, $home_dir)) {
53288      die("Can't set owner of $home_dir to $uid/$gid: $!");
53289    }
53290  }
53291
53292  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
53293    '/bin/bash');
53294  auth_group_write($auth_group_file, $group, $gid, $user);
53295
53296  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
53297  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
53298
53299  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
53300  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
53301  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
53302
53303  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
53304  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
53305    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
53306  }
53307
53308  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
53309  mkpath($src_dir);
53310
53311  my $count = 25;
53312  for (my $i = 0; $i < $count; $i++) {
53313    my $filename = (chr(65 + $i)) . sprintf("%03s", $i);
53314    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
53315
53316    if (open(my $fh, "> $src_file")) {
53317      print $fh "ABCDefgh" x 6458;
53318
53319      unless (close($fh)) {
53320        die("Can't write $src_file: $!");
53321      }
53322
53323    } else {
53324      die("Can't open $src_file: $!");
53325    }
53326
53327    $filename = (chr(97 + $i)) . sprintf("%03s", $i);
53328    $src_file = File::Spec->rel2abs("$src_dir/$filename");
53329    if (open(my $fh, "> $src_file")) {
53330      print $fh "ABCDefgh" x 7891;
53331
53332      unless (close($fh)) {
53333        die("Can't write $src_file: $!");
53334      }
53335
53336      chmod(0404, $src_file);
53337
53338    } else {
53339      die("Can't open $src_file: $!");
53340    }
53341  }
53342
53343  my $src_subdir = File::Spec->rel2abs("$src_dir/cd.d");
53344  mkpath($src_subdir);
53345
53346  for (my $i = 0; $i < $count; $i++) {
53347    my $filename = 'aa' . sprintf("%03s", $i);
53348    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
53349
53350    if (open(my $fh, "> $src_file")) {
53351      print $fh "ABCDefgh" x 9802;
53352
53353      unless (close($fh)) {
53354        die("Can't write $src_file: $!");
53355      }
53356
53357    } else {
53358      die("Can't open $src_file: $!");
53359    }
53360  }
53361
53362  $src_subdir = File::Spec->rel2abs("$src_dir/wx.d");
53363  mkpath($src_subdir);
53364
53365  for (my $i = 0; $i < $count; $i++) {
53366    my $filename = 'aa' . sprintf("%03s", $i);
53367    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
53368
53369    if (open(my $fh, "> $src_file")) {
53370      print $fh "ABCDefgh" x 8192;
53371
53372      unless (close($fh)) {
53373        die("Can't write $src_file: $!");
53374      }
53375
53376    } else {
53377      die("Can't open $src_file: $!");
53378    }
53379  }
53380
53381  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
53382  mkpath($dst_dir);
53383
53384  my $config = {
53385    PidFile => $pid_file,
53386    ScoreboardFile => $scoreboard_file,
53387    SystemLog => $log_file,
53388    TraceLog => $log_file,
53389    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
53390
53391    AuthUserFile => $auth_user_file,
53392    AuthGroupFile => $auth_group_file,
53393
53394    IfModules => {
53395      'mod_delay.c' => {
53396        DelayEngine => 'off',
53397      },
53398
53399      'mod_sftp.c' => [
53400        "SFTPEngine on",
53401        "SFTPLog $log_file",
53402        "SFTPHostKey $rsa_host_key",
53403        "SFTPHostKey $dsa_host_key",
53404        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
53405        "SFTPTrafficPolicy none",
53406      ],
53407    },
53408  };
53409
53410  my ($port, $config_user, $config_group) = config_write($config_file, $config);
53411
53412  # Open pipes, for use between the parent and child processes.  Specifically,
53413  # the child will indicate when it's done with its test by writing a message
53414  # to the parent.
53415  my ($rfh, $wfh);
53416  unless (pipe($rfh, $wfh)) {
53417    die("Can't open pipe: $!");
53418  }
53419
53420  require Net::SSH2;
53421
53422  my $ex;
53423
53424  # Ignore SIGPIPE
53425  local $SIG{PIPE} = sub { };
53426
53427  # Fork child
53428  $self->handle_sigchld();
53429  defined(my $pid = fork()) or die("Can't fork: $!");
53430  if ($pid) {
53431    eval {
53432      my @cmd = (
53433        'scp',
53434        '-r',
53435        '-v',
53436        '-p',
53437        '-oBatchMode=yes',
53438        '-oCheckHostIP=no',
53439        "-oPort=$port",
53440        "-oIdentityFile=$rsa_priv_key",
53441        '-oPubkeyAuthentication=yes',
53442        '-oStrictHostKeyChecking=no',
53443        "$src_dir/",
53444        "$user\@127.0.0.1:dst.d/",
53445      );
53446
53447      my $scp_rh = IO::Handle->new();
53448      my $scp_wh = IO::Handle->new();
53449      my $scp_eh = IO::Handle->new();
53450
53451      $scp_wh->autoflush(1);
53452
53453      sleep(1);
53454
53455      local $SIG{CHLD} = 'DEFAULT';
53456
53457      # Make sure that the perms on the priv key are what OpenSSH wants
53458      unless (chmod(0400, $rsa_priv_key)) {
53459        die("Can't set perms on $rsa_priv_key to 0400: $!");
53460      }
53461
53462      if ($ENV{TEST_VERBOSE}) {
53463        print STDERR "Executing: ", join(' ', @cmd), "\n";
53464      }
53465
53466      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
53467      waitpid($scp_pid, 0);
53468      my $exit_status = $?;
53469
53470      # Restore the perms on the priv key
53471      unless (chmod(0644, $rsa_priv_key)) {
53472        die("Can't set perms on $rsa_priv_key to 0644: $!");
53473      }
53474
53475      my ($res, $errstr);
53476      if ($exit_status >> 8 == 0) {
53477        $errstr = join('', <$scp_eh>);
53478        $res = 0;
53479
53480      } else {
53481        $errstr = join('', <$scp_eh>);
53482        if ($ENV{TEST_VERBOSE}) {
53483          print STDERR "Stderr: $errstr\n";
53484        }
53485
53486        $res = 1;
53487      }
53488
53489      unless ($res == 0) {
53490        die("Can't upload $src_dir to server: $errstr");
53491      }
53492
53493      unless (-d "$dst_dir/src.d") {
53494        die("Directory '$dst_dir/src.d' does not exist as expected");
53495      }
53496
53497      unless (-f "$dst_dir/src.d/y024") {
53498        die("File '$dst_dir/src.d/y024' does not exist as expected");
53499      }
53500
53501      my $file_mode = sprintf("%lo", (stat "$dst_dir/src.d/y024")[2] & 07777);
53502      unless ($file_mode eq '404') {
53503        die("File '$dst_dir/src.d/y024' does not have mode 404 as expected, got '$file_mode'");
53504      }
53505
53506      unless (-f "$dst_dir/src.d/Y024") {
53507        die("File '$dst_dir/src.d/Y024' does not exist as expected");
53508      }
53509
53510      unless (-d "$dst_dir/src.d/cd.d") {
53511        die("Directory '$dst_dir/src.d/cd.d' does not exist as expected");
53512      }
53513
53514      unless (-f "$dst_dir/src.d/cd.d/aa024") {
53515        die("File '$dst_dir/src.d/cd.d/aa024' does not exist as expected");
53516      }
53517
53518      unless (-d "$dst_dir/src.d/wx.d") {
53519        die("Directory '$dst_dir/src.d/wx.d' does not exist as expected");
53520      }
53521
53522      unless (-f "$dst_dir/src.d/wx.d/aa024") {
53523        die("File '$dst_dir/src.d/wx.d/aa024' does not exist as expected");
53524      }
53525
53526    };
53527
53528    if ($@) {
53529      $ex = $@;
53530    }
53531
53532    $wfh->print("done\n");
53533    $wfh->flush();
53534
53535  } else {
53536    eval { server_wait($config_file, $rfh, 30) };
53537    if ($@) {
53538      warn($@);
53539      exit 1;
53540    }
53541
53542    exit 0;
53543  }
53544
53545  # Stop server
53546  server_stop($pid_file);
53547
53548  $self->assert_child_ok($pid);
53549
53550  if ($ex) {
53551    test_append_logfile($log_file, $ex);
53552    unlink($log_file);
53553
53554    die($ex);
53555  }
53556
53557  unlink($log_file);
53558}
53559
53560sub scp_ext_upload_recursive_dir_bug4004 {
53561  my $self = shift;
53562  my $tmpdir = $self->{tmpdir};
53563
53564  my $config_file = "$tmpdir/sftp.conf";
53565  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
53566  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
53567
53568  my $log_file = test_get_logfile();
53569
53570  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
53571  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
53572
53573  my $user = 'proftpd';
53574  my $passwd = 'test';
53575  my $group = 'ftpd';
53576  my $home_dir = File::Spec->rel2abs($tmpdir);
53577  my $uid = 500;
53578  my $gid = 500;
53579
53580  # Make sure that, if we're running as root, that the home directory has
53581  # permissions/privs set for the account we create
53582  if ($< == 0) {
53583    unless (chmod(0755, $home_dir)) {
53584      die("Can't set perms on $home_dir to 0755: $!");
53585    }
53586
53587    unless (chown($uid, $gid, $home_dir)) {
53588      die("Can't set owner of $home_dir to $uid/$gid: $!");
53589    }
53590  }
53591
53592  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
53593    '/bin/bash');
53594  auth_group_write($auth_group_file, $group, $gid, $user);
53595
53596  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
53597  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
53598
53599  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
53600  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
53601
53602  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
53603  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
53604    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
53605  }
53606
53607  # For this test, we need the following directory structure:
53608  #
53609  #  src/
53610  #    files
53611  #    subdir1/
53612  #      files
53613  #    subdir2
53614  #      files
53615  #
53616  # The bug happened because mod_sftp was setting permissions on
53617  # directories, despite the IgnoreSCPUploadPerms option.
53618
53619  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
53620  mkpath($src_dir);
53621
53622  my $count = 25;
53623  for (my $i = 0; $i < $count; $i++) {
53624    my $filename = (chr(97 + $i)) . sprintf("%03s", $i);
53625    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
53626
53627    if (open(my $fh, "> $src_file")) {
53628      print $fh "ABCDefgh" x 7891;
53629
53630      unless (close($fh)) {
53631        die("Can't write $src_file: $!");
53632    }
53633
53634    } else {
53635      die("Can't open $src_file: $!");
53636    }
53637  }
53638
53639  for (my $i = 0; $i < $count; $i++) {
53640    my $filename = (chr(65 + $i)) . sprintf("%03s", $i);
53641    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
53642
53643    if (open(my $fh, "> $src_file")) {
53644      print $fh "ABCDefgh" x 6458;
53645
53646      unless (close($fh)) {
53647        die("Can't write $src_file: $!");
53648    }
53649
53650    } else {
53651      die("Can't open $src_file: $!");
53652    }
53653  }
53654
53655  my $src_subdir = File::Spec->rel2abs("$src_dir/cd.d");
53656  mkpath($src_subdir);
53657
53658  for (my $i = 0; $i < $count; $i++) {
53659    my $filename = 'aa' . sprintf("%03s", $i);
53660    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
53661
53662    if (open(my $fh, "> $src_file")) {
53663      print $fh "ABCDefgh" x 9802;
53664
53665      unless (close($fh)) {
53666        die("Can't write $src_file: $!");
53667    }
53668
53669    } else {
53670      die("Can't open $src_file: $!");
53671    }
53672  }
53673
53674  $src_subdir = File::Spec->rel2abs("$src_dir/wx.d");
53675  mkpath($src_subdir);
53676
53677  for (my $i = 0; $i < $count; $i++) {
53678    my $filename = 'aa' . sprintf("%03s", $i);
53679    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
53680
53681    if (open(my $fh, "> $src_file")) {
53682      print $fh "ABCDefgh" x 8192;
53683
53684      unless (close($fh)) {
53685        die("Can't write $src_file: $!");
53686    }
53687
53688    } else {
53689      die("Can't open $src_file: $!");
53690    }
53691  }
53692
53693  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
53694  mkpath($dst_dir);
53695
53696  my $config = {
53697    PidFile => $pid_file,
53698    ScoreboardFile => $scoreboard_file,
53699    SystemLog => $log_file,
53700    TraceLog => $log_file,
53701    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
53702
53703    AuthUserFile => $auth_user_file,
53704    AuthGroupFile => $auth_group_file,
53705    Umask => '002',
53706
53707    IfModules => {
53708      'mod_delay.c' => {
53709        DelayEngine => 'off',
53710      },
53711
53712      'mod_sftp.c' => [
53713        "SFTPEngine on",
53714        "SFTPLog $log_file",
53715        "SFTPHostKey $rsa_host_key",
53716        "SFTPHostKey $dsa_host_key",
53717        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
53718        "SFTPOptions IgnoreSCPUploadPerms",
53719      ],
53720    },
53721  };
53722
53723  my ($port, $config_user, $config_group) = config_write($config_file, $config);
53724
53725  # Open pipes, for use between the parent and child processes.  Specifically,
53726  # the child will indicate when it's done with its test by writing a message
53727  # to the parent.
53728  my ($rfh, $wfh);
53729  unless (pipe($rfh, $wfh)) {
53730    die("Can't open pipe: $!");
53731  }
53732
53733  require Net::SSH2;
53734
53735  my $ex;
53736
53737  # Ignore SIGPIPE
53738  local $SIG{PIPE} = sub { };
53739
53740  # Fork child
53741  $self->handle_sigchld();
53742  defined(my $pid = fork()) or die("Can't fork: $!");
53743  if ($pid) {
53744    eval {
53745      my @cmd = (
53746        'scp',
53747        '-r',
53748        '-p',
53749        '-v',
53750        '-oBatchMode=yes',
53751        '-oCheckHostIP=no',
53752        "-oPort=$port",
53753        "-oIdentityFile=$rsa_priv_key",
53754        '-oPubkeyAuthentication=yes',
53755        '-oStrictHostKeyChecking=no',
53756        "$src_dir/",
53757        "$user\@127.0.0.1:dst.d/",
53758      );
53759
53760      my $scp_rh = IO::Handle->new();
53761      my $scp_wh = IO::Handle->new();
53762      my $scp_eh = IO::Handle->new();
53763
53764      $scp_wh->autoflush(1);
53765
53766      sleep(1);
53767
53768      local $SIG{CHLD} = 'DEFAULT';
53769
53770      # Make sure that the perms on the priv key are what OpenSSH wants
53771      unless (chmod(0400, $rsa_priv_key)) {
53772        die("Can't set perms on $rsa_priv_key to 0400: $!");
53773      }
53774
53775      if ($ENV{TEST_VERBOSE}) {
53776        print STDERR "Executing: ", join(' ', @cmd), "\n";
53777      }
53778
53779      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
53780      waitpid($scp_pid, 0);
53781      my $exit_status = $?;
53782
53783      # Restore the perms on the priv key
53784      unless (chmod(0644, $rsa_priv_key)) {
53785        die("Can't set perms on $rsa_priv_key to 0644: $!");
53786      }
53787
53788      my ($res, $errstr);
53789      if ($exit_status >> 8 == 0) {
53790        $errstr = join('', <$scp_eh>);
53791        $res = 0;
53792
53793      } else {
53794        $errstr = join('', <$scp_eh>);
53795        if ($ENV{TEST_VERBOSE}) {
53796          print STDERR "Stderr: $errstr\n";
53797        }
53798
53799        $res = 1;
53800      }
53801
53802      unless ($res == 0) {
53803        die("Can't upload $src_dir to server: $errstr");
53804      }
53805
53806      my $path = "$dst_dir/src.d";
53807      $self->assert(-d $path,
53808        test_msg("Directory '$path' does not exist as expected"));
53809
53810      my $expected;
53811
53812      my $mode = sprintf("%lo", ((stat($path))[2] & 07777));
53813      $expected = '775';
53814      $self->assert($expected eq $mode,
53815        test_msg("Expected mode '$expected', got '$mode'"));
53816
53817      $path = "$dst_dir/src.d/y024";
53818      $self->assert(-f $path,
53819        test_msg("File '$path' does not exist as expected"));
53820
53821      $mode = sprintf("%lo", ((stat($path))[2] & 07777));
53822      $expected = '664';
53823      $self->assert($expected eq $mode,
53824        test_msg("Expected mode '$expected', got '$mode'"));
53825
53826      $path = "$dst_dir/src.d/Y024";
53827      $self->assert(-f $path,
53828        test_msg("File '$path' does not exist as expected"));
53829
53830      $mode = sprintf("%lo", ((stat($path))[2] & 07777));
53831      $expected = '664';
53832      $self->assert($expected eq $mode,
53833        test_msg("Expected mode '$expected', got '$mode'"));
53834
53835      $path = "$dst_dir/src.d/cd.d";
53836      $self->assert(-d $path,
53837        test_msg("Directory '$path' does not exist as expected"));
53838
53839      $expected = '775';
53840
53841      $path = "$dst_dir/src.d/cd.d/aa024";
53842      $self->assert(-f $path,
53843        test_msg("File '$path' does not exist as expected"));
53844
53845      $mode = sprintf("%lo", ((stat($path))[2] & 07777));
53846      $expected = '664';
53847      $self->assert($expected eq $mode,
53848        test_msg("Expected mode '$expected', got '$mode'"));
53849
53850      $path = "$dst_dir/src.d/wx.d";
53851      $self->assert(-d $path,
53852        test_msg("Directory '$path' does not exist as expected"));
53853
53854      $expected = '775';
53855
53856      $path = "$dst_dir/src.d/wx.d/aa024";
53857      $self->assert(-f $path,
53858        test_msg("File '$path' does not exist as expected"));
53859
53860      $mode = sprintf("%lo", ((stat($path))[2] & 07777));
53861      $expected = '664';
53862      $self->assert($expected eq $mode,
53863        test_msg("Expected mode '$expected', got '$mode'"));
53864    };
53865
53866    if ($@) {
53867      $ex = $@;
53868    }
53869
53870    $wfh->print("done\n");
53871    $wfh->flush();
53872
53873  } else {
53874    eval { server_wait($config_file, $rfh) };
53875    if ($@) {
53876      warn($@);
53877      exit 1;
53878    }
53879
53880    exit 0;
53881  }
53882
53883  # Stop server
53884  server_stop($pid_file);
53885
53886  $self->assert_child_ok($pid);
53887
53888  if ($ex) {
53889    test_append_logfile($log_file, $ex);
53890    unlink($log_file);
53891
53892    die($ex);
53893  }
53894
53895  unlink($log_file);
53896}
53897
53898sub scp_ext_upload_recursive_dirs_bug4257 {
53899  my $self = shift;
53900  my $tmpdir = $self->{tmpdir};
53901  my $setup = test_setup($tmpdir, 'scp');
53902
53903  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
53904  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
53905
53906  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
53907  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
53908
53909  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
53910  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
53911    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
53912  }
53913
53914  # For this test, we need the following directory structure:
53915  #
53916  #  src1.d/
53917  #    file1.dat
53918  #  src2.d/
53919  #    file2.dat
53920  #  src3.d/
53921  #    file3.dat
53922  #  src4.d/
53923  #
53924
53925  my $src1_dir = File::Spec->rel2abs("$tmpdir/src1.d");
53926  my $src2_dir = File::Spec->rel2abs("$tmpdir/src2.d");
53927  my $src3_dir = File::Spec->rel2abs("$tmpdir/src3.d");
53928  my $src4_dir = File::Spec->rel2abs("$tmpdir/src4.d");
53929  mkpath($src1_dir, $src2_dir, $src3_dir, $src4_dir, {
53930    mode => 0755,
53931  });
53932
53933  my $count = 3;
53934  for (my $i = 1; $i <= $count; $i++) {
53935    my $dirname = 'src' . $i . '.d';
53936    my $filename = 'file' . $i . '.dat';
53937    my $src_file = File::Spec->rel2abs("$tmpdir/$dirname/$filename");
53938
53939    if (open(my $fh, "> $src_file")) {
53940      print $fh "ABCDefgh" x 7891;
53941
53942      unless (close($fh)) {
53943        die("Can't write $src_file: $!");
53944    }
53945
53946    } else {
53947      die("Can't open $src_file: $!");
53948    }
53949  }
53950
53951  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
53952  mkpath($dst_dir);
53953
53954  my $config = {
53955    PidFile => $setup->{pid_file},
53956    ScoreboardFile => $setup->{scoreboard_file},
53957    SystemLog => $setup->{log_file},
53958    TraceLog => $setup->{log_file},
53959    Trace => 'ssh2:20 scp:20',
53960
53961    AuthUserFile => $setup->{auth_user_file},
53962    AuthGroupFile => $setup->{auth_group_file},
53963    Umask => '002',
53964
53965    IfModules => {
53966      'mod_delay.c' => {
53967        DelayEngine => 'off',
53968      },
53969
53970      'mod_sftp.c' => [
53971        "SFTPEngine on",
53972        "SFTPLog $setup->{log_file}",
53973        "SFTPHostKey $rsa_host_key",
53974        "SFTPHostKey $dsa_host_key",
53975        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
53976      ],
53977    },
53978  };
53979
53980  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
53981    $config);
53982
53983  # Open pipes, for use between the parent and child processes.  Specifically,
53984  # the child will indicate when it's done with its test by writing a message
53985  # to the parent.
53986  my ($rfh, $wfh);
53987  unless (pipe($rfh, $wfh)) {
53988    die("Can't open pipe: $!");
53989  }
53990
53991  require Net::SSH2;
53992
53993  my $ex;
53994
53995  # Ignore SIGPIPE
53996  local $SIG{PIPE} = sub { };
53997
53998  # Fork child
53999  $self->handle_sigchld();
54000  defined(my $pid = fork()) or die("Can't fork: $!");
54001  if ($pid) {
54002    eval {
54003      my @cmd = (
54004        'scp',
54005        '-r',
54006        '-p',
54007        '-v',
54008        '-oBatchMode=yes',
54009        '-oCheckHostIP=no',
54010        "-oPort=$port",
54011        "-oIdentityFile=$rsa_priv_key",
54012        '-oPubkeyAuthentication=yes',
54013        '-oStrictHostKeyChecking=no',
54014        "$src1_dir",
54015        "$src2_dir",
54016        "$src3_dir",
54017        "$src4_dir",
54018        "$setup->{user}\@127.0.0.1:dst.d/",
54019      );
54020
54021      my $scp_rh = IO::Handle->new();
54022      my $scp_wh = IO::Handle->new();
54023      my $scp_eh = IO::Handle->new();
54024
54025      $scp_wh->autoflush(1);
54026
54027      sleep(1);
54028
54029      local $SIG{CHLD} = 'DEFAULT';
54030
54031      # Make sure that the perms on the priv key are what OpenSSH wants
54032      unless (chmod(0400, $rsa_priv_key)) {
54033        die("Can't set perms on $rsa_priv_key to 0400: $!");
54034      }
54035
54036      if ($ENV{TEST_VERBOSE}) {
54037        print STDERR "Executing: ", join(' ', @cmd), "\n";
54038      }
54039
54040      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
54041      waitpid($scp_pid, 0);
54042      my $exit_status = $?;
54043
54044      # Restore the perms on the priv key
54045      unless (chmod(0644, $rsa_priv_key)) {
54046        die("Can't set perms on $rsa_priv_key to 0644: $!");
54047      }
54048
54049      my ($res, $errstr);
54050      if ($exit_status >> 8 == 0) {
54051        $errstr = join('', <$scp_eh>);
54052        $res = 0;
54053
54054      } else {
54055        $errstr = join('', <$scp_eh>);
54056        if ($ENV{TEST_VERBOSE}) {
54057          print STDERR "Stderr: $errstr\n";
54058        }
54059
54060        $res = 1;
54061      }
54062
54063      unless ($res == 0) {
54064        die("Can't upload dirs to server: $errstr");
54065      }
54066
54067      my $path = "$dst_dir/src1.d";
54068      $self->assert(-d $path,
54069        test_msg("Directory '$path' does not exist as expected"));
54070
54071      $path = "$dst_dir/src1.d/file1.dat";
54072      $self->assert(-f $path,
54073        test_msg("File '$path' does not exist as expected"));
54074
54075      $path = "$dst_dir/src2.d";
54076      $self->assert(-d $path,
54077        test_msg("Directory '$path' does not exist as expected"));
54078
54079      $path = "$dst_dir/src2.d/file2.dat";
54080      $self->assert(-f $path,
54081        test_msg("File '$path' does not exist as expected"));
54082
54083      $path = "$dst_dir/src3.d";
54084      $self->assert(-d $path,
54085        test_msg("Directory '$path' does not exist as expected"));
54086
54087      $path = "$dst_dir/src3.d/file3.dat";
54088      $self->assert(-f $path,
54089        test_msg("File '$path' does not exist as expected"));
54090
54091      $path = "$dst_dir/src4.d";
54092      $self->assert(-d $path,
54093        test_msg("Directory '$path' does not exist as expected"));
54094    };
54095
54096    if ($@) {
54097      $ex = $@;
54098    }
54099
54100    $wfh->print("done\n");
54101    $wfh->flush();
54102
54103  } else {
54104    eval { server_wait($setup->{config_file}, $rfh) };
54105    if ($@) {
54106      warn($@);
54107      exit 1;
54108    }
54109
54110    exit 0;
54111  }
54112
54113  # Stop server
54114  server_stop($setup->{pid_file});
54115  $self->assert_child_ok($pid);
54116
54117  test_cleanup($setup->{log_file}, $ex);
54118}
54119
54120sub scp_ext_upload_different_name_bug3425 {
54121  my $self = shift;
54122  my $tmpdir = $self->{tmpdir};
54123
54124  my $config_file = "$tmpdir/sftp.conf";
54125  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
54126  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
54127
54128  my $log_file = test_get_logfile();
54129
54130  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
54131  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
54132
54133  my $user = 'proftpd';
54134  my $passwd = 'test';
54135  my $group = 'ftpd';
54136  my $home_dir = File::Spec->rel2abs($tmpdir);
54137  my $uid = 500;
54138  my $gid = 500;
54139
54140  # Make sure that, if we're running as root, that the home directory has
54141  # permissions/privs set for the account we create
54142  if ($< == 0) {
54143    unless (chmod(0755, $home_dir)) {
54144      die("Can't set perms on $home_dir to 0755: $!");
54145    }
54146
54147    unless (chown($uid, $gid, $home_dir)) {
54148      die("Can't set owner of $home_dir to $uid/$gid: $!");
54149    }
54150  }
54151
54152  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
54153    '/bin/bash');
54154  auth_group_write($auth_group_file, $group, $gid, $user);
54155
54156  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
54157  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
54158
54159  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
54160  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
54161
54162  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
54163  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
54164    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
54165  }
54166
54167  my $src_file = File::Spec->rel2abs("$tmpdir/foo.txt");
54168  if (open(my $fh, "> $src_file")) {
54169    print $fh "Hello, world!\n";
54170    unless (close($fh)) {
54171      die("Can't write $src_file: $!");
54172    }
54173
54174  } else {
54175    die("Can't open $src_file: $!");
54176  }
54177
54178  my $dst_file = File::Spec->rel2abs("$tmpdir/bar.txt");
54179
54180  my $config = {
54181    PidFile => $pid_file,
54182    ScoreboardFile => $scoreboard_file,
54183    SystemLog => $log_file,
54184    TraceLog => $log_file,
54185    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
54186
54187    AuthUserFile => $auth_user_file,
54188    AuthGroupFile => $auth_group_file,
54189
54190    IfModules => {
54191      'mod_delay.c' => {
54192        DelayEngine => 'off',
54193      },
54194
54195      'mod_sftp.c' => [
54196        "SFTPEngine on",
54197        "SFTPLog $log_file",
54198        "SFTPHostKey $rsa_host_key",
54199        "SFTPHostKey $dsa_host_key",
54200        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
54201      ],
54202    },
54203  };
54204
54205  my ($port, $config_user, $config_group) = config_write($config_file, $config);
54206
54207  # Open pipes, for use between the parent and child processes.  Specifically,
54208  # the child will indicate when it's done with its test by writing a message
54209  # to the parent.
54210  my ($rfh, $wfh);
54211  unless (pipe($rfh, $wfh)) {
54212    die("Can't open pipe: $!");
54213  }
54214
54215  require Net::SSH2;
54216
54217  my $ex;
54218
54219  # Ignore SIGPIPE
54220  local $SIG{PIPE} = sub { };
54221
54222  # Fork child
54223  $self->handle_sigchld();
54224  defined(my $pid = fork()) or die("Can't fork: $!");
54225  if ($pid) {
54226    eval {
54227      my @cmd = (
54228        'scp',
54229        '-v',
54230        '-oBatchMode=yes',
54231        '-oCheckHostIP=no',
54232        "-oPort=$port",
54233        "-oIdentityFile=$rsa_priv_key",
54234        '-oPubkeyAuthentication=yes',
54235        '-oStrictHostKeyChecking=no',
54236        "$src_file",
54237        "$user\@127.0.0.1:bar.txt",
54238      );
54239
54240      my $scp_rh = IO::Handle->new();
54241      my $scp_wh = IO::Handle->new();
54242      my $scp_eh = IO::Handle->new();
54243
54244      $scp_wh->autoflush(1);
54245
54246      sleep(1);
54247
54248      local $SIG{CHLD} = 'DEFAULT';
54249
54250      # Make sure that the perms on the priv key are what OpenSSH wants
54251      unless (chmod(0400, $rsa_priv_key)) {
54252        die("Can't set perms on $rsa_priv_key to 0400: $!");
54253      }
54254
54255      if ($ENV{TEST_VERBOSE}) {
54256        print STDERR "Executing: ", join(' ', @cmd), "\n";
54257      }
54258
54259      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
54260      waitpid($scp_pid, 0);
54261      my $exit_status = $?;
54262
54263      # Restore the perms on the priv key
54264      unless (chmod(0644, $rsa_priv_key)) {
54265        die("Can't set perms on $rsa_priv_key to 0644: $!");
54266      }
54267
54268      my ($res, $errstr);
54269      if ($exit_status >> 8 == 0) {
54270        $errstr = join('', <$scp_eh>);
54271        $res = 0;
54272
54273      } else {
54274        $errstr = join('', <$scp_eh>);
54275        if ($ENV{TEST_VERBOSE}) {
54276          print STDERR "Stderr: $errstr\n";
54277        }
54278
54279        $res = 1;
54280      }
54281
54282      unless ($res == 0) {
54283        die("Can't upload $src_file to server: $errstr");
54284      }
54285
54286      unless (-f $dst_file) {
54287        die("File '$dst_file' does not exist as expected");
54288      }
54289    };
54290
54291    if ($@) {
54292      $ex = $@;
54293    }
54294
54295    $wfh->print("done\n");
54296    $wfh->flush();
54297
54298  } else {
54299    eval { server_wait($config_file, $rfh) };
54300    if ($@) {
54301      warn($@);
54302      exit 1;
54303    }
54304
54305    exit 0;
54306  }
54307
54308  # Stop server
54309  server_stop($pid_file);
54310
54311  $self->assert_child_ok($pid);
54312
54313  if ($ex) {
54314    test_append_logfile($log_file, $ex);
54315    unlink($log_file);
54316
54317    die($ex);
54318  }
54319
54320  unlink($log_file);
54321}
54322
54323sub scp_ext_upload_recursive_empty_dir {
54324  my $self = shift;
54325  my $tmpdir = $self->{tmpdir};
54326
54327  my $config_file = "$tmpdir/sftp.conf";
54328  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
54329  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
54330
54331  my $log_file = test_get_logfile();
54332
54333  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
54334  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
54335
54336  my $user = 'proftpd';
54337  my $passwd = 'test';
54338  my $group = 'ftpd';
54339  my $home_dir = File::Spec->rel2abs($tmpdir);
54340  my $uid = 500;
54341  my $gid = 500;
54342
54343  # Make sure that, if we're running as root, that the home directory has
54344  # permissions/privs set for the account we create
54345  if ($< == 0) {
54346    unless (chmod(0755, $home_dir)) {
54347      die("Can't set perms on $home_dir to 0755: $!");
54348    }
54349
54350    unless (chown($uid, $gid, $home_dir)) {
54351      die("Can't set owner of $home_dir to $uid/$gid: $!");
54352    }
54353  }
54354
54355  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
54356    '/bin/bash');
54357  auth_group_write($auth_group_file, $group, $gid, $user);
54358
54359  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
54360  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
54361
54362  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
54363  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
54364  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
54365
54366  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
54367  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
54368    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
54369  }
54370
54371  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
54372  mkpath($src_dir);
54373
54374  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
54375  mkpath($dst_dir);
54376
54377  my $config = {
54378    PidFile => $pid_file,
54379    ScoreboardFile => $scoreboard_file,
54380    SystemLog => $log_file,
54381    TraceLog => $log_file,
54382    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
54383
54384    AuthUserFile => $auth_user_file,
54385    AuthGroupFile => $auth_group_file,
54386
54387    IfModules => {
54388      'mod_delay.c' => {
54389        DelayEngine => 'off',
54390      },
54391
54392      'mod_sftp.c' => [
54393        "SFTPEngine on",
54394        "SFTPLog $log_file",
54395        "SFTPHostKey $rsa_host_key",
54396        "SFTPHostKey $dsa_host_key",
54397        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
54398      ],
54399    },
54400  };
54401
54402  my ($port, $config_user, $config_group) = config_write($config_file, $config);
54403
54404  # Open pipes, for use between the parent and child processes.  Specifically,
54405  # the child will indicate when it's done with its test by writing a message
54406  # to the parent.
54407  my ($rfh, $wfh);
54408  unless (pipe($rfh, $wfh)) {
54409    die("Can't open pipe: $!");
54410  }
54411
54412  require Net::SSH2;
54413
54414  my $ex;
54415
54416  # Ignore SIGPIPE
54417  local $SIG{PIPE} = sub { };
54418
54419  # Fork child
54420  $self->handle_sigchld();
54421  defined(my $pid = fork()) or die("Can't fork: $!");
54422  if ($pid) {
54423    eval {
54424      my @cmd = (
54425        'scp',
54426        '-r',
54427        '-v',
54428        '-oBatchMode=yes',
54429        '-oCheckHostIP=no',
54430        "-oPort=$port",
54431        "-oIdentityFile=$rsa_priv_key",
54432        '-oPubkeyAuthentication=yes',
54433        '-oStrictHostKeyChecking=no',
54434        "$src_dir/",
54435        "$user\@127.0.0.1:dst.d/",
54436      );
54437
54438      my $scp_rh = IO::Handle->new();
54439      my $scp_wh = IO::Handle->new();
54440      my $scp_eh = IO::Handle->new();
54441
54442      $scp_wh->autoflush(1);
54443
54444      sleep(1);
54445
54446      local $SIG{CHLD} = 'DEFAULT';
54447
54448      # Make sure that the perms on the priv key are what OpenSSH wants
54449      unless (chmod(0400, $rsa_priv_key)) {
54450        die("Can't set perms on $rsa_priv_key to 0400: $!");
54451      }
54452
54453      if ($ENV{TEST_VERBOSE}) {
54454        print STDERR "Executing: ", join(' ', @cmd), "\n";
54455      }
54456
54457      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
54458      waitpid($scp_pid, 0);
54459      my $exit_status = $?;
54460
54461      # Restore the perms on the priv key
54462      unless (chmod(0644, $rsa_priv_key)) {
54463        die("Can't set perms on $rsa_priv_key to 0644: $!");
54464      }
54465
54466      my ($res, $errstr);
54467
54468      $errstr = join('', <$scp_eh>);
54469      if ($exit_status >> 8 == 0) {
54470        $res = 0;
54471
54472      } else {
54473        $errstr = join('', <$scp_eh>);
54474        if ($ENV{TEST_VERBOSE}) {
54475          print STDERR "Stderr: $errstr\n";
54476        }
54477
54478        $res = 1;
54479      }
54480
54481      unless ($res == 0) {
54482        die("Can't upload $src_dir to server: $errstr");
54483      }
54484
54485      unless (-d "$dst_dir/src.d") {
54486        die("Directory '$dst_dir/src.d' does not exist as expected");
54487      }
54488    };
54489
54490    if ($@) {
54491      $ex = $@;
54492    }
54493
54494    $wfh->print("done\n");
54495    $wfh->flush();
54496
54497  } else {
54498    eval { server_wait($config_file, $rfh) };
54499    if ($@) {
54500      warn($@);
54501      exit 1;
54502    }
54503
54504    exit 0;
54505  }
54506
54507  # Stop server
54508  server_stop($pid_file);
54509
54510  $self->assert_child_ok($pid);
54511
54512  if ($ex) {
54513    test_append_logfile($log_file, $ex);
54514    unlink($log_file);
54515
54516    die($ex);
54517  }
54518
54519  unlink($log_file);
54520}
54521
54522sub scp_ext_upload_shorter_file_bug4013 {
54523  my $self = shift;
54524  my $tmpdir = $self->{tmpdir};
54525
54526  my $config_file = "$tmpdir/sftp.conf";
54527  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
54528  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
54529
54530  my $log_file = test_get_logfile();
54531
54532  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
54533  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
54534
54535  my $user = 'proftpd';
54536  my $passwd = 'test';
54537  my $group = 'ftpd';
54538  my $home_dir = File::Spec->rel2abs($tmpdir);
54539  my $uid = 500;
54540  my $gid = 500;
54541
54542  # Make sure that, if we're running as root, that the home directory has
54543  # permissions/privs set for the account we create
54544  if ($< == 0) {
54545    unless (chmod(0755, $home_dir)) {
54546      die("Can't set perms on $home_dir to 0755: $!");
54547    }
54548
54549    unless (chown($uid, $gid, $home_dir)) {
54550      die("Can't set owner of $home_dir to $uid/$gid: $!");
54551    }
54552  }
54553
54554  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
54555    '/bin/bash');
54556  auth_group_write($auth_group_file, $group, $gid, $user);
54557
54558  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
54559  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
54560
54561  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
54562  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
54563  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
54564
54565  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
54566  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
54567    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
54568  }
54569
54570  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
54571  if (open(my $fh, "> $test_file")) {
54572    print $fh "ABCDefgh\n";
54573    unless (close($fh)) {
54574      die("Can't write $test_file: $!");
54575    }
54576
54577  } else {
54578    die("Can't open $test_file: $!");
54579  }
54580
54581  my $sub_dir = File::Spec->rel2abs("$tmpdir/test.d");
54582  mkpath($sub_dir);
54583
54584  my $test_file2 = File::Spec->rel2abs("$sub_dir/test.txt");
54585  if (open(my $fh, "> $test_file2")) {
54586    print $fh "ABCD\n";
54587    unless (close($fh)) {
54588      die("Can't write $test_file2: $!");
54589    }
54590
54591  } else {
54592    die("Can't open $test_file2: $!");
54593  }
54594
54595  my $expected_size = -s $test_file2;
54596
54597  my $config = {
54598    PidFile => $pid_file,
54599    ScoreboardFile => $scoreboard_file,
54600    SystemLog => $log_file,
54601    TraceLog => $log_file,
54602    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
54603
54604    AuthUserFile => $auth_user_file,
54605    AuthGroupFile => $auth_group_file,
54606    AllowOverwrite => 'on',
54607
54608    IfModules => {
54609      'mod_delay.c' => {
54610        DelayEngine => 'off',
54611      },
54612
54613      'mod_sftp.c' => [
54614        "SFTPEngine on",
54615        "SFTPLog $log_file",
54616        "SFTPHostKey $rsa_host_key",
54617        "SFTPHostKey $dsa_host_key",
54618        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
54619      ],
54620    },
54621  };
54622
54623  my ($port, $config_user, $config_group) = config_write($config_file, $config);
54624
54625  # Open pipes, for use between the parent and child processes.  Specifically,
54626  # the child will indicate when it's done with its test by writing a message
54627  # to the parent.
54628  my ($rfh, $wfh);
54629  unless (pipe($rfh, $wfh)) {
54630    die("Can't open pipe: $!");
54631  }
54632
54633  require Net::SSH2;
54634
54635  my $ex;
54636
54637  # Ignore SIGPIPE
54638  local $SIG{PIPE} = sub { };
54639
54640  # Fork child
54641  $self->handle_sigchld();
54642  defined(my $pid = fork()) or die("Can't fork: $!");
54643  if ($pid) {
54644    eval {
54645      my @cmd = (
54646        'scp',
54647        '-v',
54648        '-oBatchMode=yes',
54649        '-oCheckHostIP=no',
54650        "-oPort=$port",
54651        "-oIdentityFile=$rsa_priv_key",
54652        '-oPubkeyAuthentication=yes',
54653        '-oStrictHostKeyChecking=no',
54654        "$test_file2",
54655        "$user\@127.0.0.1:.",
54656      );
54657
54658      my $scp_rh = IO::Handle->new();
54659      my $scp_wh = IO::Handle->new();
54660      my $scp_eh = IO::Handle->new();
54661
54662      $scp_wh->autoflush(1);
54663
54664      sleep(1);
54665
54666      local $SIG{CHLD} = 'DEFAULT';
54667
54668      # Make sure that the perms on the priv key are what OpenSSH wants
54669      unless (chmod(0400, $rsa_priv_key)) {
54670        die("Can't set perms on $rsa_priv_key to 0400: $!");
54671      }
54672
54673      if ($ENV{TEST_VERBOSE}) {
54674        print STDERR "Executing: ", join(' ', @cmd), "\n";
54675      }
54676
54677      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
54678      waitpid($scp_pid, 0);
54679      my $exit_status = $?;
54680
54681      # Restore the perms on the priv key
54682      unless (chmod(0644, $rsa_priv_key)) {
54683        die("Can't set perms on $rsa_priv_key to 0644: $!");
54684      }
54685
54686      my ($res, $errstr);
54687
54688      $errstr = join('', <$scp_eh>);
54689      if ($exit_status >> 8 == 0) {
54690        $res = 0;
54691
54692      } else {
54693        $errstr = join('', <$scp_eh>);
54694        if ($ENV{TEST_VERBOSE}) {
54695          print STDERR "Stderr: $errstr\n";
54696        }
54697
54698        $res = 1;
54699      }
54700
54701      unless ($res == 0) {
54702        die("Can't upload $test_file2 to server: $errstr");
54703      }
54704
54705      my $size = -s $test_file;
54706      $self->assert($expected_size == $size,
54707        test_msg("Expected size $expected_size, got $size"));
54708    };
54709
54710    if ($@) {
54711      $ex = $@;
54712    }
54713
54714    $wfh->print("done\n");
54715    $wfh->flush();
54716
54717  } else {
54718    eval { server_wait($config_file, $rfh) };
54719    if ($@) {
54720      warn($@);
54721      exit 1;
54722    }
54723
54724    exit 0;
54725  }
54726
54727  # Stop server
54728  server_stop($pid_file);
54729
54730  $self->assert_child_ok($pid);
54731
54732  if ($ex) {
54733    test_append_logfile($log_file, $ex);
54734    unlink($log_file);
54735
54736    die($ex);
54737  }
54738
54739  unlink($log_file);
54740}
54741
54742sub scp_ext_upload_file_with_timestamp_bug4026 {
54743  my $self = shift;
54744  my $tmpdir = $self->{tmpdir};
54745
54746  my $config_file = "$tmpdir/sftp.conf";
54747  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
54748  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
54749
54750  my $log_file = test_get_logfile();
54751
54752  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
54753  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
54754
54755  my $user = 'proftpd';
54756  my $passwd = 'test';
54757  my $group = 'ftpd';
54758  my $home_dir = File::Spec->rel2abs($tmpdir);
54759  my $uid = 500;
54760  my $gid = 500;
54761
54762  my $sub_dir = File::Spec->rel2abs("$tmpdir/sub.d");
54763  mkpath($sub_dir);
54764
54765  # Make sure that, if we're running as root, that the home directory has
54766  # permissions/privs set for the account we create
54767  if ($< == 0) {
54768    unless (chmod(0755, $home_dir, $sub_dir)) {
54769      die("Can't set perms on $home_dir to 0755: $!");
54770    }
54771
54772    unless (chown($uid, $gid, $home_dir, $sub_dir)) {
54773      die("Can't set owner of $home_dir to $uid/$gid: $!");
54774    }
54775  }
54776
54777  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
54778    '/bin/bash');
54779  auth_group_write($auth_group_file, $group, $gid, $user);
54780
54781  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
54782  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
54783
54784  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
54785  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
54786  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
54787
54788  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
54789  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
54790    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
54791  }
54792
54793  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
54794  if (open(my $fh, "> $src_file")) {
54795    print $fh "ABCDefgh\n";
54796    unless (close($fh)) {
54797      die("Can't write $src_file: $!");
54798    }
54799
54800  } else {
54801    die("Can't open $src_file: $!");
54802  }
54803
54804  unless (utime(0, 0, $src_file)) {
54805    die("Can't set timestamps on $src_file: $!");
54806  }
54807
54808  my $dst_file = File::Spec->rel2abs("$sub_dir/dst.txt");
54809
54810  my $config = {
54811    PidFile => $pid_file,
54812    ScoreboardFile => $scoreboard_file,
54813    SystemLog => $log_file,
54814    TraceLog => $log_file,
54815    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
54816
54817    AuthUserFile => $auth_user_file,
54818    AuthGroupFile => $auth_group_file,
54819    AllowOverwrite => 'on',
54820    DefaultRoot => '~',
54821
54822    IfModules => {
54823      'mod_delay.c' => {
54824        DelayEngine => 'off',
54825      },
54826
54827      'mod_sftp.c' => [
54828        "SFTPEngine on",
54829        "SFTPLog $log_file",
54830        "SFTPHostKey $rsa_host_key",
54831        "SFTPHostKey $dsa_host_key",
54832        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
54833      ],
54834    },
54835  };
54836
54837  my ($port, $config_user, $config_group) = config_write($config_file, $config);
54838
54839  # Open pipes, for use between the parent and child processes.  Specifically,
54840  # the child will indicate when it's done with its test by writing a message
54841  # to the parent.
54842  my ($rfh, $wfh);
54843  unless (pipe($rfh, $wfh)) {
54844    die("Can't open pipe: $!");
54845  }
54846
54847  require Net::SSH2;
54848
54849  my $ex;
54850
54851  # Ignore SIGPIPE
54852  local $SIG{PIPE} = sub { };
54853
54854  # Fork child
54855  $self->handle_sigchld();
54856  defined(my $pid = fork()) or die("Can't fork: $!");
54857  if ($pid) {
54858    eval {
54859      my @cmd = (
54860        'scp',
54861        '-v',
54862        '-p',
54863        '-oBatchMode=yes',
54864        '-oCheckHostIP=no',
54865        "-oPort=$port",
54866        "-oIdentityFile=$rsa_priv_key",
54867        '-oPubkeyAuthentication=yes',
54868        '-oStrictHostKeyChecking=no',
54869        "$src_file",
54870        "$user\@127.0.0.1:sub.d/dst.txt",
54871      );
54872
54873      my $scp_rh = IO::Handle->new();
54874      my $scp_wh = IO::Handle->new();
54875      my $scp_eh = IO::Handle->new();
54876
54877      $scp_wh->autoflush(1);
54878
54879      sleep(1);
54880
54881      local $SIG{CHLD} = 'DEFAULT';
54882
54883      # Make sure that the perms on the priv key are what OpenSSH wants
54884      unless (chmod(0400, $rsa_priv_key)) {
54885        die("Can't set perms on $rsa_priv_key to 0400: $!");
54886      }
54887
54888      if ($ENV{TEST_VERBOSE}) {
54889        print STDERR "Executing: ", join(' ', @cmd), "\n";
54890      }
54891
54892      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
54893      waitpid($scp_pid, 0);
54894      my $exit_status = $?;
54895
54896      # Restore the perms on the priv key
54897      unless (chmod(0644, $rsa_priv_key)) {
54898        die("Can't set perms on $rsa_priv_key to 0644: $!");
54899      }
54900
54901      my ($res, $errstr);
54902
54903      $errstr = join('', <$scp_eh>);
54904      if ($exit_status >> 8 == 0) {
54905        $res = 0;
54906
54907      } else {
54908        $errstr = join('', <$scp_eh>);
54909        if ($ENV{TEST_VERBOSE}) {
54910          print STDERR "Stderr: $errstr\n";
54911        }
54912
54913        $res = 1;
54914      }
54915
54916      unless ($res == 0) {
54917        die("Can't upload $src_file to server: $errstr");
54918      }
54919
54920      $self->assert(-f $dst_file,
54921        test_msg("File $dst_file does not exist as expected"));
54922
54923      my ($atime, $mtime) = (stat($dst_file))[8,9];
54924      $self->assert($atime == 0, test_msg("Expected atime 0, got $atime"));
54925      $self->assert($mtime == 0, test_msg("Expected mtime 0, got $mtime"));
54926    };
54927
54928    if ($@) {
54929      $ex = $@;
54930    }
54931
54932    $wfh->print("done\n");
54933    $wfh->flush();
54934
54935  } else {
54936    eval { server_wait($config_file, $rfh) };
54937    if ($@) {
54938      warn($@);
54939      exit 1;
54940    }
54941
54942    exit 0;
54943  }
54944
54945  # Stop server
54946  server_stop($pid_file);
54947
54948  $self->assert_child_ok($pid);
54949
54950  if ($ex) {
54951    test_append_logfile($log_file, $ex);
54952    unlink($log_file);
54953
54954    die($ex);
54955  }
54956
54957  unlink($log_file);
54958}
54959
54960sub scp_download {
54961  my $self = shift;
54962  my $tmpdir = $self->{tmpdir};
54963  my $setup = test_setup($tmpdir, 'scp');
54964
54965  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
54966
54967  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
54968  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
54969
54970  my $config = {
54971    PidFile => $setup->{pid_file},
54972    ScoreboardFile => $setup->{scoreboard_file},
54973    SystemLog => $setup->{log_file},
54974    TraceLog => $setup->{log_file},
54975    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
54976
54977    AuthUserFile => $setup->{auth_user_file},
54978    AuthGroupFile => $setup->{auth_group_file},
54979
54980    IfModules => {
54981      'mod_delay.c' => {
54982        DelayEngine => 'off',
54983      },
54984
54985      'mod_sftp.c' => [
54986        "SFTPEngine on",
54987        "SFTPLog $setup->{log_file}",
54988        "SFTPHostKey $rsa_host_key",
54989        "SFTPHostKey $dsa_host_key",
54990      ],
54991    },
54992  };
54993
54994  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
54995    $config);
54996
54997  # Open pipes, for use between the parent and child processes.  Specifically,
54998  # the child will indicate when it's done with its test by writing a message
54999  # to the parent.
55000  my ($rfh, $wfh);
55001  unless (pipe($rfh, $wfh)) {
55002    die("Can't open pipe: $!");
55003  }
55004
55005  require Net::SSH2;
55006
55007  my $ex;
55008
55009  # Ignore SIGPIPE
55010  local $SIG{PIPE} = sub { };
55011
55012  # Fork child
55013  $self->handle_sigchld();
55014  defined(my $pid = fork()) or die("Can't fork: $!");
55015  if ($pid) {
55016    eval {
55017      my $ssh2 = Net::SSH2->new();
55018
55019      sleep(1);
55020
55021      unless ($ssh2->connect('127.0.0.1', $port)) {
55022        my ($err_code, $err_name, $err_str) = $ssh2->error();
55023        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55024      }
55025
55026      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
55027        my ($err_code, $err_name, $err_str) = $ssh2->error();
55028        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55029      }
55030
55031      my $src_path = 'scp.conf';
55032      my $res = $ssh2->scp_get($src_path, $test_file);
55033      unless ($res) {
55034        my ($err_code, $err_name, $err_str) = $ssh2->error();
55035        die("Can't download $src_path from server: [$err_name] ($err_code) $err_str");
55036      }
55037
55038      $ssh2->disconnect();
55039
55040      $self->assert(-f $test_file,
55041        test_msg("File $test_file file does not exist"));
55042    };
55043    if ($@) {
55044      $ex = $@;
55045    }
55046
55047    $wfh->print("done\n");
55048    $wfh->flush();
55049
55050  } else {
55051    eval { server_wait($setup->{config_file}, $rfh) };
55052    if ($@) {
55053      warn($@);
55054      exit 1;
55055    }
55056
55057    exit 0;
55058  }
55059
55060  # Stop server
55061  server_stop($setup->{pid_file});
55062  $self->assert_child_ok($pid);
55063
55064  test_cleanup($setup->{log_file}, $ex);
55065}
55066
55067sub scp_download_enoent_bug3798 {
55068  my $self = shift;
55069  my $tmpdir = $self->{tmpdir};
55070
55071  my $config_file = "$tmpdir/sftp.conf";
55072  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
55073  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
55074
55075  my $log_file = test_get_logfile();
55076
55077  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
55078  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
55079
55080  my $user = 'proftpd';
55081  my $passwd = 'test';
55082  my $group = 'ftpd';
55083  my $home_dir = File::Spec->rel2abs($tmpdir);
55084  my $uid = 500;
55085  my $gid = 500;
55086
55087  # Make sure that, if we're running as root, that the home directory has
55088  # permissions/privs set for the account we create
55089  if ($< == 0) {
55090    unless (chmod(0755, $home_dir)) {
55091      die("Can't set perms on $home_dir to 0755: $!");
55092    }
55093
55094    unless (chown($uid, $gid, $home_dir)) {
55095      die("Can't set owner of $home_dir to $uid/$gid: $!");
55096    }
55097  }
55098
55099  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
55100    '/bin/bash');
55101  auth_group_write($auth_group_file, $group, $gid, $user);
55102
55103  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
55104  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
55105
55106  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
55107
55108  my $config = {
55109    PidFile => $pid_file,
55110    ScoreboardFile => $scoreboard_file,
55111    SystemLog => $log_file,
55112    TraceLog => $log_file,
55113    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
55114
55115    AuthUserFile => $auth_user_file,
55116    AuthGroupFile => $auth_group_file,
55117
55118    IfModules => {
55119      'mod_delay.c' => {
55120        DelayEngine => 'off',
55121      },
55122
55123      'mod_sftp.c' => [
55124        "SFTPEngine on",
55125        "SFTPLog $log_file",
55126        "SFTPHostKey $rsa_host_key",
55127        "SFTPHostKey $dsa_host_key",
55128      ],
55129    },
55130  };
55131
55132  my ($port, $config_user, $config_group) = config_write($config_file, $config);
55133
55134  # Open pipes, for use between the parent and child processes.  Specifically,
55135  # the child will indicate when it's done with its test by writing a message
55136  # to the parent.
55137  my ($rfh, $wfh);
55138  unless (pipe($rfh, $wfh)) {
55139    die("Can't open pipe: $!");
55140  }
55141
55142  require Net::SSH2;
55143
55144  my $ex;
55145
55146  # Ignore SIGPIPE
55147  local $SIG{PIPE} = sub { };
55148
55149  # Fork child
55150  $self->handle_sigchld();
55151  defined(my $pid = fork()) or die("Can't fork: $!");
55152  if ($pid) {
55153    eval {
55154      my $ssh2 = Net::SSH2->new();
55155
55156      sleep(1);
55157
55158      unless ($ssh2->connect('127.0.0.1', $port)) {
55159        my ($err_code, $err_name, $err_str) = $ssh2->error();
55160        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55161      }
55162
55163      unless ($ssh2->auth_password($user, $passwd)) {
55164        my ($err_code, $err_name, $err_str) = $ssh2->error();
55165        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55166      }
55167
55168      my $res = $ssh2->scp_get('not-here.txt', $test_file);
55169      if ($res) {
55170        die("Download of not-here.txt from server succeeded unexpectedly");
55171      }
55172
55173      $ssh2->disconnect();
55174    };
55175
55176    if ($@) {
55177      $ex = $@;
55178    }
55179
55180    $wfh->print("done\n");
55181    $wfh->flush();
55182
55183  } else {
55184    eval { server_wait($config_file, $rfh) };
55185    if ($@) {
55186      warn($@);
55187      exit 1;
55188    }
55189
55190    exit 0;
55191  }
55192
55193  # Stop server
55194  server_stop($pid_file);
55195
55196  $self->assert_child_ok($pid);
55197
55198  if ($ex) {
55199    test_append_logfile($log_file, $ex);
55200    unlink($log_file);
55201
55202    die($ex);
55203  }
55204
55205  unlink($log_file);
55206}
55207
55208sub scp_download_zero_len_file {
55209  my $self = shift;
55210  my $tmpdir = $self->{tmpdir};
55211
55212  my $config_file = "$tmpdir/sftp.conf";
55213  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
55214  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
55215
55216  my $log_file = test_get_logfile();
55217
55218  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
55219  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
55220
55221  my $user = 'proftpd';
55222  my $passwd = 'test';
55223  my $group = 'ftpd';
55224  my $home_dir = File::Spec->rel2abs($tmpdir);
55225  my $uid = 500;
55226  my $gid = 500;
55227
55228  # Make sure that, if we're running as root, that the home directory has
55229  # permissions/privs set for the account we create
55230  if ($< == 0) {
55231    unless (chmod(0755, $home_dir)) {
55232      die("Can't set perms on $home_dir to 0755: $!");
55233    }
55234
55235    unless (chown($uid, $gid, $home_dir)) {
55236      die("Can't set owner of $home_dir to $uid/$gid: $!");
55237    }
55238  }
55239
55240  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
55241    '/bin/bash');
55242  auth_group_write($auth_group_file, $group, $gid, $user);
55243
55244  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
55245  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
55246
55247  my $empty_file = File::Spec->rel2abs("$tmpdir/empty.txt");
55248  if (open(my $fh, "> $empty_file")) {
55249    close($fh);
55250
55251  } else {
55252    die("Can't open $empty_file: $!");
55253  }
55254
55255  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
55256
55257  my $config = {
55258    PidFile => $pid_file,
55259    ScoreboardFile => $scoreboard_file,
55260    SystemLog => $log_file,
55261    TraceLog => $log_file,
55262    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
55263
55264    AuthUserFile => $auth_user_file,
55265    AuthGroupFile => $auth_group_file,
55266
55267    IfModules => {
55268      'mod_delay.c' => {
55269        DelayEngine => 'off',
55270      },
55271
55272      'mod_sftp.c' => [
55273        "SFTPEngine on",
55274        "SFTPLog $log_file",
55275        "SFTPHostKey $rsa_host_key",
55276        "SFTPHostKey $dsa_host_key",
55277      ],
55278    },
55279  };
55280
55281  my ($port, $config_user, $config_group) = config_write($config_file, $config);
55282
55283  # Open pipes, for use between the parent and child processes.  Specifically,
55284  # the child will indicate when it's done with its test by writing a message
55285  # to the parent.
55286  my ($rfh, $wfh);
55287  unless (pipe($rfh, $wfh)) {
55288    die("Can't open pipe: $!");
55289  }
55290
55291  require Net::SSH2;
55292
55293  my $ex;
55294
55295  # Ignore SIGPIPE
55296  local $SIG{PIPE} = sub { };
55297
55298  # Fork child
55299  $self->handle_sigchld();
55300  defined(my $pid = fork()) or die("Can't fork: $!");
55301  if ($pid) {
55302    eval {
55303      my $ssh2 = Net::SSH2->new();
55304
55305      sleep(1);
55306
55307      unless ($ssh2->connect('127.0.0.1', $port)) {
55308        my ($err_code, $err_name, $err_str) = $ssh2->error();
55309        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55310      }
55311
55312      unless ($ssh2->auth_password($user, $passwd)) {
55313        my ($err_code, $err_name, $err_str) = $ssh2->error();
55314        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55315      }
55316
55317      my $res = $ssh2->scp_get($empty_file, $test_file);
55318      unless ($res) {
55319        my ($err_code, $err_name, $err_str) = $ssh2->error();
55320        die("Can't download $empty_file from server: [$err_name] ($err_code) $err_str");
55321      }
55322
55323      $ssh2->disconnect();
55324
55325      unless (-f $test_file) {
55326        die("$test_file file does not exist as expected");
55327      }
55328
55329      my $size = -s $test_file;
55330      unless ($size == 0) {
55331        die("$test_file has size $size unexpectedly");
55332      }
55333    };
55334
55335    if ($@) {
55336      $ex = $@;
55337    }
55338
55339    $wfh->print("done\n");
55340    $wfh->flush();
55341
55342  } else {
55343    eval { server_wait($config_file, $rfh) };
55344    if ($@) {
55345      warn($@);
55346      exit 1;
55347    }
55348
55349    exit 0;
55350  }
55351
55352  # Stop server
55353  server_stop($pid_file);
55354
55355  $self->assert_child_ok($pid);
55356
55357  if ($ex) {
55358    test_append_logfile($log_file, $ex);
55359    unlink($log_file);
55360
55361    die($ex);
55362  }
55363
55364  unlink($log_file);
55365}
55366
55367sub scp_download_largefile {
55368  my $self = shift;
55369  my $tmpdir = $self->{tmpdir};
55370
55371  my $config_file = "$tmpdir/sftp.conf";
55372  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
55373  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
55374
55375  my $log_file = test_get_logfile();
55376
55377  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
55378  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
55379
55380  my $user = 'proftpd';
55381  my $passwd = 'test';
55382  my $group = 'ftpd';
55383  my $home_dir = File::Spec->rel2abs($tmpdir);
55384  my $uid = 500;
55385  my $gid = 500;
55386
55387  # Make sure that, if we're running as root, that the home directory has
55388  # permissions/privs set for the account we create
55389  if ($< == 0) {
55390    unless (chmod(0755, $home_dir)) {
55391      die("Can't set perms on $home_dir to 0755: $!");
55392    }
55393
55394    unless (chown($uid, $gid, $home_dir)) {
55395      die("Can't set owner of $home_dir to $uid/$gid: $!");
55396    }
55397  }
55398
55399  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
55400    '/bin/bash');
55401  auth_group_write($auth_group_file, $group, $gid, $user);
55402
55403  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
55404  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
55405
55406  my $fh;
55407
55408  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
55409  if (open($fh, "> $test_file")) {
55410    # Make a file that's larger than the maximum SSH2 packet size, forcing
55411    # the scp code to loop properly entire the entire large file is sent.
55412
55413    print $fh "ABCDefgh" x 16384;
55414    unless (close($fh)) {
55415      die("Can't write $test_file: $!");
55416    }
55417
55418  } else {
55419    die("Can't open $test_file: $!");
55420  }
55421
55422  # Calculate the MD5 checksum of this file, for comparison with the
55423  # downloaded file.
55424  my $ctx = Digest::MD5->new();
55425  my $expected_md5;
55426
55427  if (open($fh, "< $test_file")) {
55428    binmode($fh);
55429    $ctx->addfile($fh);
55430    $expected_md5 = $ctx->hexdigest();
55431    close($fh);
55432
55433  } else {
55434    die("Can't read $test_file: $!");
55435  }
55436
55437  my $test_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
55438
55439  my $config = {
55440    PidFile => $pid_file,
55441    ScoreboardFile => $scoreboard_file,
55442    SystemLog => $log_file,
55443    TraceLog => $log_file,
55444    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
55445
55446    AuthUserFile => $auth_user_file,
55447    AuthGroupFile => $auth_group_file,
55448
55449    IfModules => {
55450      'mod_delay.c' => {
55451        DelayEngine => 'off',
55452      },
55453
55454      'mod_sftp.c' => [
55455        "SFTPEngine on",
55456        "SFTPLog $log_file",
55457        "SFTPHostKey $rsa_host_key",
55458        "SFTPHostKey $dsa_host_key",
55459      ],
55460    },
55461  };
55462
55463  my ($port, $config_user, $config_group) = config_write($config_file, $config);
55464
55465  # Open pipes, for use between the parent and child processes.  Specifically,
55466  # the child will indicate when it's done with its test by writing a message
55467  # to the parent.
55468  my ($rfh, $wfh);
55469  unless (pipe($rfh, $wfh)) {
55470    die("Can't open pipe: $!");
55471  }
55472
55473  require Net::SSH2;
55474
55475  my $ex;
55476
55477  # Ignore SIGPIPE
55478  local $SIG{PIPE} = sub { };
55479
55480  # Fork child
55481  $self->handle_sigchld();
55482  defined(my $pid = fork()) or die("Can't fork: $!");
55483  if ($pid) {
55484    eval {
55485      my $ssh2 = Net::SSH2->new();
55486
55487      sleep(1);
55488
55489      unless ($ssh2->connect('127.0.0.1', $port)) {
55490        my ($err_code, $err_name, $err_str) = $ssh2->error();
55491        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55492      }
55493
55494      unless ($ssh2->auth_password($user, $passwd)) {
55495        my ($err_code, $err_name, $err_str) = $ssh2->error();
55496        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55497      }
55498
55499      my $res = $ssh2->scp_get('test.txt', $test_file2);
55500      unless ($res) {
55501        my ($err_code, $err_name, $err_str) = $ssh2->error();
55502        die("Can't download 'test.txt' from server: [$err_name] ($err_code) $err_str");
55503      }
55504
55505      $ssh2->disconnect();
55506
55507      unless (-f $test_file2) {
55508        die("$test_file2 file does not exist as expected");
55509      }
55510    };
55511
55512    if ($@) {
55513      $ex = $@;
55514    }
55515
55516    $wfh->print("done\n");
55517    $wfh->flush();
55518
55519  } else {
55520    eval { server_wait($config_file, $rfh) };
55521    if ($@) {
55522      warn($@);
55523      exit 1;
55524    }
55525
55526    exit 0;
55527  }
55528
55529  # Stop server
55530  server_stop($pid_file);
55531
55532  $self->assert_child_ok($pid);
55533
55534  if ($ex) {
55535    test_append_logfile($log_file, $ex);
55536    unlink($log_file);
55537
55538    die($ex);
55539  }
55540
55541  # Calculate the MD5 checksum of the downloaded file, for comparison with the
55542  # downloaded file.
55543  $ctx->reset();
55544  my $md5;
55545
55546  if (open($fh, "< $test_file2")) {
55547    binmode($fh);
55548    $ctx->addfile($fh);
55549    $md5 = $ctx->hexdigest();
55550    close($fh);
55551
55552  } else {
55553    die("Can't read $test_file2: $!");
55554  }
55555
55556  $self->assert($expected_md5 eq $md5,
55557    test_msg("Expected '$expected_md5', got '$md5'"));
55558
55559  unlink($log_file);
55560}
55561
55562sub scp_download_fifo_bug3314 {
55563  my $self = shift;
55564  my $tmpdir = $self->{tmpdir};
55565
55566  my $config_file = "$tmpdir/sftp.conf";
55567  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
55568  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
55569
55570  my $log_file = test_get_logfile();
55571
55572  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
55573  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
55574
55575  my $user = 'proftpd';
55576  my $passwd = 'test';
55577  my $group = 'ftpd';
55578  my $home_dir = File::Spec->rel2abs($tmpdir);
55579  my $uid = 500;
55580  my $gid = 500;
55581
55582  # Make sure that, if we're running as root, that the home directory has
55583  # permissions/privs set for the account we create
55584  if ($< == 0) {
55585    unless (chmod(0755, $home_dir)) {
55586      die("Can't set perms on $home_dir to 0755: $!");
55587    }
55588
55589    unless (chown($uid, $gid, $home_dir)) {
55590      die("Can't set owner of $home_dir to $uid/$gid: $!");
55591    }
55592  }
55593
55594  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
55595    '/bin/bash');
55596  auth_group_write($auth_group_file, $group, $gid, $user);
55597
55598  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
55599  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
55600
55601  my $fifo = File::Spec->rel2abs("/tmp/test.fifo");
55602  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
55603
55604  my $config = {
55605    PidFile => $pid_file,
55606    ScoreboardFile => $scoreboard_file,
55607    SystemLog => $log_file,
55608    TraceLog => $log_file,
55609    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
55610
55611    AuthUserFile => $auth_user_file,
55612    AuthGroupFile => $auth_group_file,
55613
55614    IfModules => {
55615      'mod_delay.c' => {
55616        DelayEngine => 'off',
55617      },
55618
55619      'mod_sftp.c' => [
55620        "SFTPEngine on",
55621        "SFTPLog $log_file",
55622        "SFTPHostKey $rsa_host_key",
55623        "SFTPHostKey $dsa_host_key",
55624      ],
55625    },
55626  };
55627
55628  my ($port, $config_user, $config_group) = config_write($config_file, $config);
55629
55630  # Open pipes, for use between the parent and child processes.  Specifically,
55631  # the child will indicate when it's done with its test by writing a message
55632  # to the parent.
55633  my ($rfh, $wfh);
55634  unless (pipe($rfh, $wfh)) {
55635    die("Can't open pipe: $!");
55636  }
55637
55638  require Net::SSH2;
55639
55640  my $ex;
55641
55642  # Ignore SIGPIPE
55643  local $SIG{PIPE} = sub { };
55644
55645  # Fork child
55646  $self->handle_sigchld();
55647  defined(my $pid = fork()) or die("Can't fork: $!");
55648  if ($pid) {
55649    eval {
55650      my $ssh2 = Net::SSH2->new();
55651
55652      sleep(1);
55653
55654      unless ($ssh2->connect('127.0.0.1', $port)) {
55655        my ($err_code, $err_name, $err_str) = $ssh2->error();
55656        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55657      }
55658
55659      unless ($ssh2->auth_password($user, $passwd)) {
55660        my ($err_code, $err_name, $err_str) = $ssh2->error();
55661        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55662      }
55663
55664      my $res = $ssh2->scp_get($fifo, $test_file);
55665      unless ($res) {
55666        my ($err_code, $err_name, $err_str) = $ssh2->error();
55667        die("Can't download $fifo from server: [$err_name] ($err_code) $err_str");
55668      }
55669
55670      $ssh2->disconnect();
55671
55672      unless (-f $test_file) {
55673        die("$test_file file does not exist as expected");
55674      }
55675    };
55676
55677    if ($@) {
55678      $ex = $@;
55679    }
55680
55681    $wfh->print("done\n");
55682    $wfh->flush();
55683
55684  } else {
55685    eval { server_wait($config_file, $rfh) };
55686    if ($@) {
55687      warn($@);
55688      exit 1;
55689    }
55690
55691    exit 0;
55692  }
55693
55694  # Stop server
55695  server_stop($pid_file);
55696
55697  $self->assert_child_ok($pid);
55698
55699  if ($ex) {
55700    test_append_logfile($log_file, $ex);
55701    unlink($log_file);
55702
55703    die($ex);
55704  }
55705
55706  unlink($log_file);
55707}
55708
55709sub scp_download_abs_symlink {
55710  my $self = shift;
55711  my $tmpdir = $self->{tmpdir};
55712  my $setup = test_setup($tmpdir, 'scp');
55713
55714  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
55715  mkpath($test_dir);
55716
55717  my $src_file = File::Spec->rel2abs("$test_dir/src.txt");
55718  if (open(my $fh, "> $src_file")) {
55719    print $fh "Hello, World!\n";
55720    unless (close($fh)) {
55721      die("Can't write $src_file: $!");
55722    }
55723
55724  } else {
55725    die("Can't open $src_file: $!");
55726  }
55727
55728  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
55729
55730  my $dst_path = $src_file;
55731  if ($^O eq 'darwin') {
55732    # MacOSX-specific hack
55733    $dst_path = '/private' . $dst_path;
55734  }
55735
55736  unless (symlink($dst_path, $test_symlink)) {
55737    die("Can't symlink $test_symlink to $dst_path: $!");
55738  }
55739
55740  if ($< == 0) {
55741    unless (chmod(0755, $test_dir)) {
55742      die("Can't set perms on $test_dir to 0755: $!");
55743    }
55744
55745    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $src_file)) {
55746      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
55747    }
55748  }
55749
55750  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
55751
55752  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
55753  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
55754
55755  my $config = {
55756    PidFile => $setup->{pid_file},
55757    ScoreboardFile => $setup->{scoreboard_file},
55758    SystemLog => $setup->{log_file},
55759    TraceLog => $setup->{log_file},
55760    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
55761
55762    AuthUserFile => $setup->{auth_user_file},
55763    AuthGroupFile => $setup->{auth_group_file},
55764
55765    IfModules => {
55766      'mod_delay.c' => {
55767        DelayEngine => 'off',
55768      },
55769
55770      'mod_sftp.c' => [
55771        "SFTPEngine on",
55772        "SFTPLog $setup->{log_file}",
55773        "SFTPHostKey $rsa_host_key",
55774        "SFTPHostKey $dsa_host_key",
55775      ],
55776    },
55777  };
55778
55779  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
55780    $config);
55781
55782  # Open pipes, for use between the parent and child processes.  Specifically,
55783  # the child will indicate when it's done with its test by writing a message
55784  # to the parent.
55785  my ($rfh, $wfh);
55786  unless (pipe($rfh, $wfh)) {
55787    die("Can't open pipe: $!");
55788  }
55789
55790  require Net::SSH2;
55791
55792  my $ex;
55793
55794  # Ignore SIGPIPE
55795  local $SIG{PIPE} = sub { };
55796
55797  # Fork child
55798  $self->handle_sigchld();
55799  defined(my $pid = fork()) or die("Can't fork: $!");
55800  if ($pid) {
55801    eval {
55802      my $ssh2 = Net::SSH2->new();
55803
55804      sleep(1);
55805
55806      unless ($ssh2->connect('127.0.0.1', $port)) {
55807        my ($err_code, $err_name, $err_str) = $ssh2->error();
55808        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55809      }
55810
55811      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
55812        my ($err_code, $err_name, $err_str) = $ssh2->error();
55813        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55814      }
55815
55816      my $src_path = 'test.d/test.lnk';
55817      my $res = $ssh2->scp_get($src_path, $test_file);
55818      unless ($res) {
55819        my ($err_code, $err_name, $err_str) = $ssh2->error();
55820        die("Can't download $src_path from server: [$err_name] ($err_code) $err_str");
55821      }
55822
55823      $ssh2->disconnect();
55824
55825      $self->assert(-f $test_file,
55826        test_msg("File $test_file file does not exist"));
55827    };
55828    if ($@) {
55829      $ex = $@;
55830    }
55831
55832    $wfh->print("done\n");
55833    $wfh->flush();
55834
55835  } else {
55836    eval { server_wait($setup->{config_file}, $rfh) };
55837    if ($@) {
55838      warn($@);
55839      exit 1;
55840    }
55841
55842    exit 0;
55843  }
55844
55845  # Stop server
55846  server_stop($setup->{pid_file});
55847  $self->assert_child_ok($pid);
55848
55849  test_cleanup($setup->{log_file}, $ex);
55850}
55851
55852sub scp_download_abs_symlink_chrooted_bug4219 {
55853  my $self = shift;
55854  my $tmpdir = $self->{tmpdir};
55855  my $setup = test_setup($tmpdir, 'scp');
55856
55857  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
55858  mkpath($test_dir);
55859
55860  my $src_file = File::Spec->rel2abs("$test_dir/src.txt");
55861  if (open(my $fh, "> $src_file")) {
55862    print $fh "Hello, World!\n";
55863    unless (close($fh)) {
55864      die("Can't write $src_file: $!");
55865    }
55866
55867  } else {
55868    die("Can't open $src_file: $!");
55869  }
55870
55871  my $test_symlink = File::Spec->rel2abs("$test_dir/test.lnk");
55872
55873  my $dst_path = $src_file;
55874  if ($^O eq 'darwin') {
55875    # MacOSX-specific hack
55876    $dst_path = '/private' . $dst_path;
55877  }
55878
55879  unless (symlink($dst_path, $test_symlink)) {
55880    die("Can't symlink $test_symlink to $dst_path: $!");
55881  }
55882
55883  if ($< == 0) {
55884    unless (chmod(0755, $test_dir)) {
55885      die("Can't set perms on $test_dir to 0755: $!");
55886    }
55887
55888    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $src_file)) {
55889      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
55890    }
55891  }
55892
55893  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
55894
55895  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
55896  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
55897
55898  my $config = {
55899    PidFile => $setup->{pid_file},
55900    ScoreboardFile => $setup->{scoreboard_file},
55901    SystemLog => $setup->{log_file},
55902    TraceLog => $setup->{log_file},
55903    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
55904
55905    AuthUserFile => $setup->{auth_user_file},
55906    AuthGroupFile => $setup->{auth_group_file},
55907
55908    DefaultRoot => '~',
55909
55910    IfModules => {
55911      'mod_delay.c' => {
55912        DelayEngine => 'off',
55913      },
55914
55915      'mod_sftp.c' => [
55916        "SFTPEngine on",
55917        "SFTPLog $setup->{log_file}",
55918        "SFTPHostKey $rsa_host_key",
55919        "SFTPHostKey $dsa_host_key",
55920      ],
55921    },
55922  };
55923
55924  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
55925    $config);
55926
55927  # Open pipes, for use between the parent and child processes.  Specifically,
55928  # the child will indicate when it's done with its test by writing a message
55929  # to the parent.
55930  my ($rfh, $wfh);
55931  unless (pipe($rfh, $wfh)) {
55932    die("Can't open pipe: $!");
55933  }
55934
55935  require Net::SSH2;
55936
55937  my $ex;
55938
55939  # Ignore SIGPIPE
55940  local $SIG{PIPE} = sub { };
55941
55942  # Fork child
55943  $self->handle_sigchld();
55944  defined(my $pid = fork()) or die("Can't fork: $!");
55945  if ($pid) {
55946    eval {
55947      my $ssh2 = Net::SSH2->new();
55948
55949      sleep(1);
55950
55951      unless ($ssh2->connect('127.0.0.1', $port)) {
55952        my ($err_code, $err_name, $err_str) = $ssh2->error();
55953        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
55954      }
55955
55956      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
55957        my ($err_code, $err_name, $err_str) = $ssh2->error();
55958        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
55959      }
55960
55961      my $src_path = 'test.d/test.lnk';
55962      my $res = $ssh2->scp_get($src_path, $test_file);
55963      unless ($res) {
55964        my ($err_code, $err_name, $err_str) = $ssh2->error();
55965        die("Can't download $src_path from server: [$err_name] ($err_code) $err_str");
55966      }
55967
55968      $ssh2->disconnect();
55969
55970      $self->assert(-f $test_file,
55971        test_msg("File $test_file file does not exist"));
55972    };
55973    if ($@) {
55974      $ex = $@;
55975    }
55976
55977    $wfh->print("done\n");
55978    $wfh->flush();
55979
55980  } else {
55981    eval { server_wait($setup->{config_file}, $rfh) };
55982    if ($@) {
55983      warn($@);
55984      exit 1;
55985    }
55986
55987    exit 0;
55988  }
55989
55990  # Stop server
55991  server_stop($setup->{pid_file});
55992  $self->assert_child_ok($pid);
55993
55994  test_cleanup($setup->{log_file}, $ex);
55995}
55996
55997sub scp_download_rel_symlink {
55998  my $self = shift;
55999  my $tmpdir = $self->{tmpdir};
56000  my $setup = test_setup($tmpdir, 'scp');
56001
56002  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
56003  mkpath($test_dir);
56004
56005  my $src_file = File::Spec->rel2abs("$test_dir/src.txt");
56006  if (open(my $fh, "> $src_file")) {
56007    print $fh "Hello, World!\n";
56008    unless (close($fh)) {
56009      die("Can't write $src_file: $!");
56010    }
56011
56012  } else {
56013    die("Can't open $src_file: $!");
56014  }
56015
56016  # Change to the test directory in order to create a relative path in the
56017  # symlink we need
56018
56019  my $cwd = getcwd();
56020  unless (chdir($test_dir)) {
56021    die("Can't chdir to $test_dir: $!");
56022  }
56023
56024  unless (symlink('./src.txt', './test.lnk')) {
56025    die("Can't symlink 'test.lnk' to './src.txt': $!");
56026  }
56027
56028  unless (chdir($cwd)) {
56029    die("Can't chdir to $cwd: $!");
56030  }
56031
56032  if ($< == 0) {
56033    unless (chmod(0755, $test_dir)) {
56034      die("Can't set perms on $test_dir to 0755: $!");
56035    }
56036
56037    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $src_file)) {
56038      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
56039    }
56040  }
56041
56042  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
56043
56044  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
56045  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
56046
56047  my $config = {
56048    PidFile => $setup->{pid_file},
56049    ScoreboardFile => $setup->{scoreboard_file},
56050    SystemLog => $setup->{log_file},
56051    TraceLog => $setup->{log_file},
56052    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
56053
56054    AuthUserFile => $setup->{auth_user_file},
56055    AuthGroupFile => $setup->{auth_group_file},
56056
56057    IfModules => {
56058      'mod_delay.c' => {
56059        DelayEngine => 'off',
56060      },
56061
56062      'mod_sftp.c' => [
56063        "SFTPEngine on",
56064        "SFTPLog $setup->{log_file}",
56065        "SFTPHostKey $rsa_host_key",
56066        "SFTPHostKey $dsa_host_key",
56067      ],
56068    },
56069  };
56070
56071  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
56072    $config);
56073
56074  # Open pipes, for use between the parent and child processes.  Specifically,
56075  # the child will indicate when it's done with its test by writing a message
56076  # to the parent.
56077  my ($rfh, $wfh);
56078  unless (pipe($rfh, $wfh)) {
56079    die("Can't open pipe: $!");
56080  }
56081
56082  require Net::SSH2;
56083
56084  my $ex;
56085
56086  # Ignore SIGPIPE
56087  local $SIG{PIPE} = sub { };
56088
56089  # Fork child
56090  $self->handle_sigchld();
56091  defined(my $pid = fork()) or die("Can't fork: $!");
56092  if ($pid) {
56093    eval {
56094      my $ssh2 = Net::SSH2->new();
56095
56096      sleep(1);
56097
56098      unless ($ssh2->connect('127.0.0.1', $port)) {
56099        my ($err_code, $err_name, $err_str) = $ssh2->error();
56100        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
56101      }
56102
56103      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
56104        my ($err_code, $err_name, $err_str) = $ssh2->error();
56105        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
56106      }
56107
56108      my $src_path = 'test.d/test.lnk';
56109      my $res = $ssh2->scp_get($src_path, $test_file);
56110      unless ($res) {
56111        my ($err_code, $err_name, $err_str) = $ssh2->error();
56112        die("Can't download $src_path from server: [$err_name] ($err_code) $err_str");
56113      }
56114
56115      $ssh2->disconnect();
56116
56117      $self->assert(-f $test_file,
56118        test_msg("File $test_file file does not exist"));
56119    };
56120    if ($@) {
56121      $ex = $@;
56122    }
56123
56124    $wfh->print("done\n");
56125    $wfh->flush();
56126
56127  } else {
56128    eval { server_wait($setup->{config_file}, $rfh) };
56129    if ($@) {
56130      warn($@);
56131      exit 1;
56132    }
56133
56134    exit 0;
56135  }
56136
56137  # Stop server
56138  server_stop($setup->{pid_file});
56139  $self->assert_child_ok($pid);
56140
56141  test_cleanup($setup->{log_file}, $ex);
56142}
56143
56144sub scp_download_rel_symlink_chrooted_bug4219 {
56145  my $self = shift;
56146  my $tmpdir = $self->{tmpdir};
56147  my $setup = test_setup($tmpdir, 'scp');
56148
56149  my $test_dir = File::Spec->rel2abs("$tmpdir/test.d");
56150  mkpath($test_dir);
56151
56152  my $src_file = File::Spec->rel2abs("$test_dir/src.txt");
56153  if (open(my $fh, "> $src_file")) {
56154    print $fh "Hello, World!\n";
56155    unless (close($fh)) {
56156      die("Can't write $src_file: $!");
56157    }
56158
56159  } else {
56160    die("Can't open $src_file: $!");
56161  }
56162
56163  # Change to the test directory in order to create a relative path in the
56164  # symlink we need
56165
56166  my $cwd = getcwd();
56167  unless (chdir($test_dir)) {
56168    die("Can't chdir to $test_dir: $!");
56169  }
56170
56171  unless (symlink('./src.txt', './test.lnk')) {
56172    die("Can't symlink 'test.lnk' to './src.txt': $!");
56173  }
56174
56175  unless (chdir($cwd)) {
56176    die("Can't chdir to $cwd: $!");
56177  }
56178
56179  if ($< == 0) {
56180    unless (chmod(0755, $test_dir)) {
56181      die("Can't set perms on $test_dir to 0755: $!");
56182    }
56183
56184    unless (chown($setup->{uid}, $setup->{gid}, $test_dir, $src_file)) {
56185      die("Can't set owner of $test_dir to $setup->{uid}/$setup->{gid}: $!");
56186    }
56187  }
56188
56189  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
56190
56191  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
56192  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
56193
56194  my $config = {
56195    PidFile => $setup->{pid_file},
56196    ScoreboardFile => $setup->{scoreboard_file},
56197    SystemLog => $setup->{log_file},
56198    TraceLog => $setup->{log_file},
56199    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
56200
56201    AuthUserFile => $setup->{auth_user_file},
56202    AuthGroupFile => $setup->{auth_group_file},
56203
56204    DefaultRoot => '~',
56205
56206    IfModules => {
56207      'mod_delay.c' => {
56208        DelayEngine => 'off',
56209      },
56210
56211      'mod_sftp.c' => [
56212        "SFTPEngine on",
56213        "SFTPLog $setup->{log_file}",
56214        "SFTPHostKey $rsa_host_key",
56215        "SFTPHostKey $dsa_host_key",
56216      ],
56217    },
56218  };
56219
56220  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
56221    $config);
56222
56223  # Open pipes, for use between the parent and child processes.  Specifically,
56224  # the child will indicate when it's done with its test by writing a message
56225  # to the parent.
56226  my ($rfh, $wfh);
56227  unless (pipe($rfh, $wfh)) {
56228    die("Can't open pipe: $!");
56229  }
56230
56231  require Net::SSH2;
56232
56233  my $ex;
56234
56235  # Ignore SIGPIPE
56236  local $SIG{PIPE} = sub { };
56237
56238  # Fork child
56239  $self->handle_sigchld();
56240  defined(my $pid = fork()) or die("Can't fork: $!");
56241  if ($pid) {
56242    eval {
56243      my $ssh2 = Net::SSH2->new();
56244
56245      sleep(1);
56246
56247      unless ($ssh2->connect('127.0.0.1', $port)) {
56248        my ($err_code, $err_name, $err_str) = $ssh2->error();
56249        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
56250      }
56251
56252      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
56253        my ($err_code, $err_name, $err_str) = $ssh2->error();
56254        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
56255      }
56256
56257      my $src_path = 'test.d/test.lnk';
56258      my $res = $ssh2->scp_get($src_path, $test_file);
56259      unless ($res) {
56260        my ($err_code, $err_name, $err_str) = $ssh2->error();
56261        die("Can't download $src_path from server: [$err_name] ($err_code) $err_str");
56262      }
56263
56264      $ssh2->disconnect();
56265
56266      $self->assert(-f $test_file,
56267        test_msg("File $test_file file does not exist"));
56268    };
56269    if ($@) {
56270      $ex = $@;
56271    }
56272
56273    $wfh->print("done\n");
56274    $wfh->flush();
56275
56276  } else {
56277    eval { server_wait($setup->{config_file}, $rfh) };
56278    if ($@) {
56279      warn($@);
56280      exit 1;
56281    }
56282
56283    exit 0;
56284  }
56285
56286  # Stop server
56287  server_stop($setup->{pid_file});
56288  $self->assert_child_ok($pid);
56289
56290  test_cleanup($setup->{log_file}, $ex);
56291}
56292
56293sub scp_ext_download_bug3544 {
56294  my $self = shift;
56295  my $tmpdir = $self->{tmpdir};
56296
56297  my $config_file = "$tmpdir/sftp.conf";
56298  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
56299  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
56300
56301  my $log_file = test_get_logfile();
56302
56303  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
56304  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
56305
56306  my $user = 'proftpd';
56307  my $passwd = 'test';
56308  my $group = 'ftpd';
56309  my $home_dir = File::Spec->rel2abs($tmpdir);
56310  my $uid = 500;
56311  my $gid = 500;
56312
56313  # Make sure that, if we're running as root, that the home directory has
56314  # permissions/privs set for the account we create
56315  if ($< == 0) {
56316    unless (chmod(0755, $home_dir)) {
56317      die("Can't set perms on $home_dir to 0755: $!");
56318    }
56319
56320    unless (chown($uid, $gid, $home_dir)) {
56321      die("Can't set owner of $home_dir to $uid/$gid: $!");
56322    }
56323  }
56324
56325  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
56326    '/bin/bash');
56327  auth_group_write($auth_group_file, $group, $gid, $user);
56328
56329  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
56330  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
56331
56332  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
56333  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
56334  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
56335
56336  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
56337  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
56338    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
56339  }
56340
56341  my $dst_file = File::Spec->rel2abs("$tmpdir/test.txt");
56342
56343  my $timeout_idle = 60;
56344
56345  my $config = {
56346    PidFile => $pid_file,
56347    ScoreboardFile => $scoreboard_file,
56348    SystemLog => $log_file,
56349    TraceLog => $log_file,
56350    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
56351
56352    AuthUserFile => $auth_user_file,
56353    AuthGroupFile => $auth_group_file,
56354
56355    IfModules => {
56356      'mod_delay.c' => {
56357        DelayEngine => 'off',
56358      },
56359
56360      'mod_sftp.c' => [
56361        "SFTPEngine on",
56362        "SFTPLog $log_file",
56363        "SFTPHostKey $rsa_host_key",
56364        "SFTPHostKey $dsa_host_key",
56365        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
56366      ],
56367    },
56368  };
56369
56370  my ($port, $config_user, $config_group) = config_write($config_file, $config);
56371
56372  # Open pipes, for use between the parent and child processes.  Specifically,
56373  # the child will indicate when it's done with its test by writing a message
56374  # to the parent.
56375  my ($rfh, $wfh);
56376  unless (pipe($rfh, $wfh)) {
56377    die("Can't open pipe: $!");
56378  }
56379
56380  require Net::SSH2;
56381
56382  my $ex;
56383
56384  # Ignore SIGPIPE
56385  local $SIG{PIPE} = sub { };
56386
56387  # Fork child
56388  $self->handle_sigchld();
56389  defined(my $pid = fork()) or die("Can't fork: $!");
56390  if ($pid) {
56391    eval {
56392      my @cmd = (
56393        'scp',
56394        '-vvv',
56395        '-oBatchMode=yes',
56396        '-oCheckHostIP=no',
56397        "-oPort=$port",
56398        "-oIdentityFile=$rsa_priv_key",
56399        '-oPubkeyAuthentication=yes',
56400        '-oStrictHostKeyChecking=no',
56401        "$user\@127.0.0.1:$config_file",
56402        "$dst_file",
56403      );
56404
56405      my $scp_rh = IO::Handle->new();
56406      my $scp_wh = IO::Handle->new();
56407      my $scp_eh = IO::Handle->new();
56408
56409      $scp_wh->autoflush(1);
56410
56411      sleep(1);
56412
56413      local $SIG{CHLD} = 'DEFAULT';
56414
56415      # Make sure that the perms on the priv key are what OpenSSH wants
56416      unless (chmod(0400, $rsa_priv_key)) {
56417        die("Can't set perms on $rsa_priv_key to 0400: $!");
56418      }
56419
56420      if ($ENV{TEST_VERBOSE}) {
56421        print STDERR "Executing: ", join(' ', @cmd), "\n";
56422      }
56423
56424      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
56425      waitpid($scp_pid, 0);
56426      my $exit_status = $?;
56427
56428      # Restore the perms on the priv key
56429      unless (chmod(0644, $rsa_priv_key)) {
56430        die("Can't set perms on $rsa_priv_key to 0644: $!");
56431      }
56432
56433      my ($res, $errstr);
56434      if ($exit_status >> 8 == 0) {
56435        $errstr = join('', <$scp_eh>);
56436        $res = 0;
56437
56438      } else {
56439        $errstr = join('', <$scp_eh>);
56440        if ($ENV{TEST_VERBOSE}) {
56441          print STDERR "Stderr: $errstr\n";
56442        }
56443
56444        $res = 1;
56445      }
56446
56447      unless ($res == 0) {
56448        die("Can't download $config_file from server: $errstr");
56449      }
56450
56451      unless (-f "$dst_file") {
56452        die("File '$dst_file' does not exist as expected");
56453      }
56454    };
56455
56456    if ($@) {
56457      $ex = $@;
56458    }
56459
56460    $wfh->print("done\n");
56461    $wfh->flush();
56462
56463  } else {
56464    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
56465    if ($@) {
56466      warn($@);
56467      exit 1;
56468    }
56469
56470    exit 0;
56471  }
56472
56473  # Stop server
56474  server_stop($pid_file);
56475
56476  $self->assert_child_ok($pid);
56477
56478  if ($ex) {
56479    test_append_logfile($log_file, $ex);
56480    unlink($log_file);
56481
56482    die($ex);
56483  }
56484
56485  unlink($log_file);
56486}
56487
56488sub scp_ext_download_bug3798 {
56489  my $self = shift;
56490  my $tmpdir = $self->{tmpdir};
56491
56492  my $config_file = "$tmpdir/sftp.conf";
56493  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
56494  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
56495
56496  my $log_file = test_get_logfile();
56497
56498  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
56499  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
56500
56501  my $user = 'proftpd';
56502  my $passwd = 'test';
56503  my $group = 'ftpd';
56504  my $home_dir = File::Spec->rel2abs($tmpdir);
56505  my $uid = 500;
56506  my $gid = 500;
56507
56508  # Make sure that, if we're running as root, that the home directory has
56509  # permissions/privs set for the account we create
56510  if ($< == 0) {
56511    unless (chmod(0755, $home_dir)) {
56512      die("Can't set perms on $home_dir to 0755: $!");
56513    }
56514
56515    unless (chown($uid, $gid, $home_dir)) {
56516      die("Can't set owner of $home_dir to $uid/$gid: $!");
56517    }
56518  }
56519
56520  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
56521    '/bin/bash');
56522  auth_group_write($auth_group_file, $group, $gid, $user);
56523
56524  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
56525  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
56526
56527  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
56528  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
56529  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
56530
56531  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
56532  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
56533    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
56534  }
56535
56536  my $test_file = File::Spec->rel2abs("$tmpdir/no-such-file.txt");
56537  my $dst_file = File::Spec->rel2abs("$tmpdir/test.txt");
56538
56539  my $timeout_idle = 60;
56540
56541  my $config = {
56542    PidFile => $pid_file,
56543    ScoreboardFile => $scoreboard_file,
56544    SystemLog => $log_file,
56545    TraceLog => $log_file,
56546    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
56547
56548    AuthUserFile => $auth_user_file,
56549    AuthGroupFile => $auth_group_file,
56550
56551    IfModules => {
56552      'mod_delay.c' => {
56553        DelayEngine => 'off',
56554      },
56555
56556      'mod_sftp.c' => [
56557        "SFTPEngine on",
56558        "SFTPLog $log_file",
56559        "SFTPHostKey $rsa_host_key",
56560        "SFTPHostKey $dsa_host_key",
56561        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
56562      ],
56563    },
56564  };
56565
56566  my ($port, $config_user, $config_group) = config_write($config_file, $config);
56567
56568  # Open pipes, for use between the parent and child processes.  Specifically,
56569  # the child will indicate when it's done with its test by writing a message
56570  # to the parent.
56571  my ($rfh, $wfh);
56572  unless (pipe($rfh, $wfh)) {
56573    die("Can't open pipe: $!");
56574  }
56575
56576  require Net::SSH2;
56577
56578  my $ex;
56579
56580  # Ignore SIGPIPE
56581  local $SIG{PIPE} = sub { };
56582
56583  # Fork child
56584  $self->handle_sigchld();
56585  defined(my $pid = fork()) or die("Can't fork: $!");
56586  if ($pid) {
56587    eval {
56588      my @cmd = (
56589        'scp',
56590        '-vvv',
56591        '-oBatchMode=yes',
56592        '-oCheckHostIP=no',
56593        "-oPort=$port",
56594        "-oIdentityFile=$rsa_priv_key",
56595        '-oPubkeyAuthentication=yes',
56596        '-oStrictHostKeyChecking=no',
56597        "$user\@127.0.0.1:$test_file",
56598        "$dst_file",
56599      );
56600
56601      my $scp_rh = IO::Handle->new();
56602      my $scp_wh = IO::Handle->new();
56603      my $scp_eh = IO::Handle->new();
56604
56605      $scp_wh->autoflush(1);
56606
56607      sleep(1);
56608
56609      local $SIG{CHLD} = 'DEFAULT';
56610
56611      # Make sure that the perms on the priv key are what OpenSSH wants
56612      unless (chmod(0400, $rsa_priv_key)) {
56613        die("Can't set perms on $rsa_priv_key to 0400: $!");
56614      }
56615
56616      if ($ENV{TEST_VERBOSE}) {
56617        print STDERR "Executing: ", join(' ', @cmd), "\n";
56618      }
56619
56620      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
56621      waitpid($scp_pid, 0);
56622      my $exit_status = $?;
56623
56624      # Restore the perms on the priv key
56625      unless (chmod(0644, $rsa_priv_key)) {
56626        die("Can't set perms on $rsa_priv_key to 0644: $!");
56627      }
56628
56629      my ($res, $errstr);
56630      $errstr = join('', <$scp_eh>);
56631
56632      if ($exit_status >> 8 == 0) {
56633        $res = 0;
56634
56635      } else {
56636        if ($ENV{TEST_VERBOSE}) {
56637          print STDERR "Stderr: $errstr\n";
56638        }
56639
56640        $res = 1;
56641      }
56642
56643      $self->assert($res == 1,
56644        "Downloading $test_file from server succeeded unexpectedly");
56645
56646      $self->assert(!-f $dst_file,
56647        "File '$dst_file' exists unexpectedly");
56648
56649      $self->assert(qr/No such file or directory/, $errstr,
56650        "Expected error response 'No such file or directory' not found");
56651    };
56652
56653    if ($@) {
56654      $ex = $@;
56655    }
56656
56657    $wfh->print("done\n");
56658    $wfh->flush();
56659
56660  } else {
56661    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
56662    if ($@) {
56663      warn($@);
56664      exit 1;
56665    }
56666
56667    exit 0;
56668  }
56669
56670  # Stop server
56671  server_stop($pid_file);
56672
56673  $self->assert_child_ok($pid);
56674
56675  if ($ex) {
56676    test_append_logfile($log_file, $ex);
56677    unlink($log_file);
56678
56679    die($ex);
56680  }
56681
56682  unlink($log_file);
56683}
56684
56685sub scp_ext_download_glob_single_match_bug3904 {
56686  my $self = shift;
56687  my $tmpdir = $self->{tmpdir};
56688
56689  my $config_file = "$tmpdir/sftp.conf";
56690  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
56691  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
56692
56693  my $log_file = test_get_logfile();
56694
56695  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
56696  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
56697
56698  my $user = 'proftpd';
56699  my $passwd = 'test';
56700  my $group = 'ftpd';
56701  my $home_dir = File::Spec->rel2abs($tmpdir);
56702  my $uid = 500;
56703  my $gid = 500;
56704
56705  # Make sure that, if we're running as root, that the home directory has
56706  # permissions/privs set for the account we create
56707  if ($< == 0) {
56708    unless (chmod(0755, $home_dir)) {
56709      die("Can't set perms on $home_dir to 0755: $!");
56710    }
56711
56712    unless (chown($uid, $gid, $home_dir)) {
56713      die("Can't set owner of $home_dir to $uid/$gid: $!");
56714    }
56715  }
56716
56717  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
56718    '/bin/bash');
56719  auth_group_write($auth_group_file, $group, $gid, $user);
56720
56721  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
56722  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
56723
56724  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
56725  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
56726  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
56727
56728  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
56729  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
56730    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
56731  }
56732
56733  my $test_file = File::Spec->rel2abs($tmpdir) . '/*.conf';
56734  my $dst_file = File::Spec->rel2abs("$tmpdir/test.txt");
56735
56736  my $timeout_idle = 60;
56737
56738  my $config = {
56739    PidFile => $pid_file,
56740    ScoreboardFile => $scoreboard_file,
56741    SystemLog => $log_file,
56742    TraceLog => $log_file,
56743    Trace => 'DEFAULT:10 ssh2:20 scp:20',
56744
56745    AuthUserFile => $auth_user_file,
56746    AuthGroupFile => $auth_group_file,
56747
56748    IfModules => {
56749      'mod_delay.c' => {
56750        DelayEngine => 'off',
56751      },
56752
56753      'mod_sftp.c' => [
56754        "SFTPEngine on",
56755        "SFTPLog $log_file",
56756        "SFTPHostKey $rsa_host_key",
56757        "SFTPHostKey $dsa_host_key",
56758        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
56759      ],
56760    },
56761  };
56762
56763  my ($port, $config_user, $config_group) = config_write($config_file, $config);
56764
56765  # Open pipes, for use between the parent and child processes.  Specifically,
56766  # the child will indicate when it's done with its test by writing a message
56767  # to the parent.
56768  my ($rfh, $wfh);
56769  unless (pipe($rfh, $wfh)) {
56770    die("Can't open pipe: $!");
56771  }
56772
56773  require Net::SSH2;
56774
56775  my $ex;
56776
56777  # Ignore SIGPIPE
56778  local $SIG{PIPE} = sub { };
56779
56780  # Fork child
56781  $self->handle_sigchld();
56782  defined(my $pid = fork()) or die("Can't fork: $!");
56783  if ($pid) {
56784    eval {
56785      my @cmd = (
56786        'scp',
56787        '-vvv',
56788        '-oBatchMode=yes',
56789        '-oCheckHostIP=no',
56790        "-oPort=$port",
56791        "-oIdentityFile=$rsa_priv_key",
56792        '-oPubkeyAuthentication=yes',
56793        '-oStrictHostKeyChecking=no',
56794        "$user\@127.0.0.1:$test_file",
56795        "$dst_file",
56796      );
56797
56798      my $scp_rh = IO::Handle->new();
56799      my $scp_wh = IO::Handle->new();
56800      my $scp_eh = IO::Handle->new();
56801
56802      $scp_wh->autoflush(1);
56803
56804      sleep(1);
56805
56806      local $SIG{CHLD} = 'DEFAULT';
56807
56808      # Make sure that the perms on the priv key are what OpenSSH wants
56809      unless (chmod(0400, $rsa_priv_key)) {
56810        die("Can't set perms on $rsa_priv_key to 0400: $!");
56811      }
56812
56813      if ($ENV{TEST_VERBOSE}) {
56814        print STDERR "Executing: ", join(' ', @cmd), "\n";
56815      }
56816
56817      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
56818      waitpid($scp_pid, 0);
56819
56820      # Restore the perms on the priv key
56821      unless (chmod(0644, $rsa_priv_key)) {
56822        die("Can't set perms on $rsa_priv_key to 0644: $!");
56823      }
56824
56825      my ($res, $errstr);
56826      if ($? >> 8 == 0) {
56827        $errstr = join('', <$scp_eh>);
56828        $res = 0;
56829
56830      } else {
56831        $errstr = join('', <$scp_eh>);
56832        if ($ENV{TEST_VERBOSE}) {
56833          print STDERR "Stderr: $errstr\n";
56834        }
56835
56836        $res = 1;
56837      }
56838
56839      $self->assert($res == 0,
56840        "Downloading $test_file from server failed unexpectedly");
56841
56842      $self->assert(-f $dst_file,
56843        "File '$dst_file' does not exist as expected");
56844    };
56845
56846    if ($@) {
56847      $ex = $@;
56848    }
56849
56850    $wfh->print("done\n");
56851    $wfh->flush();
56852
56853  } else {
56854    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
56855    if ($@) {
56856      warn($@);
56857      exit 1;
56858    }
56859
56860    exit 0;
56861  }
56862
56863  # Stop server
56864  server_stop($pid_file);
56865
56866  $self->assert_child_ok($pid);
56867
56868  if ($ex) {
56869    test_append_logfile($log_file, $ex);
56870    unlink($log_file);
56871
56872    die($ex);
56873  }
56874
56875  unlink($log_file);
56876}
56877
56878sub scp_ext_download_glob_multiple_matches_bug3904 {
56879  my $self = shift;
56880  my $tmpdir = $self->{tmpdir};
56881
56882  my $config_file = "$tmpdir/sftp.conf";
56883  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
56884  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
56885
56886  my $log_file = test_get_logfile();
56887
56888  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
56889  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
56890
56891  my $user = 'proftpd';
56892  my $passwd = 'test';
56893  my $group = 'ftpd';
56894  my $home_dir = File::Spec->rel2abs($tmpdir);
56895  my $uid = 500;
56896  my $gid = 500;
56897
56898  # Make sure that, if we're running as root, that the home directory has
56899  # permissions/privs set for the account we create
56900  if ($< == 0) {
56901    unless (chmod(0755, $home_dir)) {
56902      die("Can't set perms on $home_dir to 0755: $!");
56903    }
56904
56905    unless (chown($uid, $gid, $home_dir)) {
56906      die("Can't set owner of $home_dir to $uid/$gid: $!");
56907    }
56908  }
56909
56910  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
56911    '/bin/bash');
56912  auth_group_write($auth_group_file, $group, $gid, $user);
56913
56914  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
56915  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
56916
56917  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
56918  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
56919  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
56920
56921  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
56922  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
56923    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
56924  }
56925
56926  my $src_glob = File::Spec->rel2abs($tmpdir) . '/*.txt';
56927  my $dst_dir = File::Spec->rel2abs("$tmpdir/sub.d");
56928  mkpath($dst_dir);
56929
56930  my $src_file1 = File::Spec->rel2abs("$tmpdir/test1.txt");
56931  if (open(my $fh, "> $src_file1")) {
56932    # An 11MB file
56933    print $fh 'A' x 11534336;
56934
56935    unless (close($fh)) {
56936      die("Can't write $src_file1: $!");
56937    }
56938
56939  } else {
56940    die("Can't open $src_file1: $!");
56941  }
56942
56943  my $src_file2 = File::Spec->rel2abs("$tmpdir/test2.txt");
56944  if (open(my $fh, "> $src_file2")) {
56945    # An 1443B file
56946    print $fh 'B' x 1443;
56947
56948    unless (close($fh)) {
56949      die("Can't write $src_file2: $!");
56950    }
56951
56952  } else {
56953    die("Can't open $src_file2: $!");
56954  }
56955
56956  my $dst_file1 = File::Spec->rel2abs("$dst_dir/test1.txt");
56957  my $dst_size1 = -s $src_file1;
56958
56959  my $dst_file2 = File::Spec->rel2abs("$dst_dir/test2.txt");
56960  my $dst_size2 = -s $src_file2;
56961
56962  my $timeout_idle = 60;
56963
56964  my $config = {
56965    PidFile => $pid_file,
56966    ScoreboardFile => $scoreboard_file,
56967    SystemLog => $log_file,
56968    TraceLog => $log_file,
56969    Trace => 'DEFAULT:10 ssh2:20 scp:20',
56970
56971    AuthUserFile => $auth_user_file,
56972    AuthGroupFile => $auth_group_file,
56973
56974    IfModules => {
56975      'mod_delay.c' => {
56976        DelayEngine => 'off',
56977      },
56978
56979      'mod_sftp.c' => [
56980        "SFTPEngine on",
56981        "SFTPLog $log_file",
56982        "SFTPHostKey $rsa_host_key",
56983        "SFTPHostKey $dsa_host_key",
56984        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
56985      ],
56986    },
56987  };
56988
56989  my ($port, $config_user, $config_group) = config_write($config_file, $config);
56990
56991  # Open pipes, for use between the parent and child processes.  Specifically,
56992  # the child will indicate when it's done with its test by writing a message
56993  # to the parent.
56994  my ($rfh, $wfh);
56995  unless (pipe($rfh, $wfh)) {
56996    die("Can't open pipe: $!");
56997  }
56998
56999  require Net::SSH2;
57000
57001  my $ex;
57002
57003  # Ignore SIGPIPE
57004  local $SIG{PIPE} = sub { };
57005
57006  # Fork child
57007  $self->handle_sigchld();
57008  defined(my $pid = fork()) or die("Can't fork: $!");
57009  if ($pid) {
57010    eval {
57011      my @cmd = (
57012        'scp',
57013        '-vvv',
57014        '-oBatchMode=yes',
57015        '-oCheckHostIP=no',
57016        "-oPort=$port",
57017        "-oIdentityFile=$rsa_priv_key",
57018        '-oPubkeyAuthentication=yes',
57019        '-oStrictHostKeyChecking=no',
57020        "$user\@127.0.0.1:$src_glob",
57021        "$dst_dir",
57022      );
57023
57024      my $scp_rh = IO::Handle->new();
57025      my $scp_wh = IO::Handle->new();
57026      my $scp_eh = IO::Handle->new();
57027
57028      $scp_wh->autoflush(1);
57029
57030      sleep(1);
57031
57032      local $SIG{CHLD} = 'DEFAULT';
57033
57034      # Make sure that the perms on the priv key are what OpenSSH wants
57035      unless (chmod(0400, $rsa_priv_key)) {
57036        die("Can't set perms on $rsa_priv_key to 0400: $!");
57037      }
57038
57039      if ($ENV{TEST_VERBOSE}) {
57040        print STDERR "Executing: ", join(' ', @cmd), "\n";
57041      }
57042
57043      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
57044      waitpid($scp_pid, 0);
57045
57046      # Restore the perms on the priv key
57047      unless (chmod(0644, $rsa_priv_key)) {
57048        die("Can't set perms on $rsa_priv_key to 0644: $!");
57049      }
57050
57051      my ($res, $errstr);
57052      if ($? >> 8 == 0) {
57053        $errstr = join('', <$scp_eh>);
57054        $res = 0;
57055
57056      } else {
57057        $errstr = join('', <$scp_eh>);
57058        if ($ENV{TEST_VERBOSE}) {
57059          print STDERR "Stderr: $errstr\n";
57060        }
57061
57062        $res = 1;
57063      }
57064
57065      $self->assert($res == 0,
57066        "Downloading $src_glob from server failed unexpectedly");
57067
57068      $self->assert(-f $dst_file1,
57069        "File '$dst_file1' does not exist as expected");
57070
57071      my $sz = -s $dst_file1;
57072      $self->assert($dst_size1 == $sz,
57073        "File '$dst_file1' size ($sz) does not match expected size ($dst_size1)");
57074
57075      $self->assert(-f $dst_file2,
57076        "File '$dst_file2' does not exist as expected");
57077
57078      $sz = -s $dst_file2;
57079      $self->assert($dst_size2 == $sz,
57080        "File '$dst_file2' size ($sz) does not match expected size ($dst_size2)");
57081    };
57082
57083    if ($@) {
57084      $ex = $@;
57085    }
57086
57087    $wfh->print("done\n");
57088    $wfh->flush();
57089
57090  } else {
57091    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
57092    if ($@) {
57093      warn($@);
57094      exit 1;
57095    }
57096
57097    exit 0;
57098  }
57099
57100  # Stop server
57101  server_stop($pid_file);
57102
57103  $self->assert_child_ok($pid);
57104
57105  if ($ex) {
57106    test_append_logfile($log_file, $ex);
57107    unlink($log_file);
57108
57109    die($ex);
57110  }
57111
57112  unlink($log_file);
57113}
57114
57115sub scp_ext_download_recursive_dir_bug3456 {
57116  my $self = shift;
57117  my $tmpdir = $self->{tmpdir};
57118
57119  my $config_file = "$tmpdir/sftp.conf";
57120  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
57121  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
57122
57123  my $log_file = test_get_logfile();
57124
57125  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
57126  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
57127
57128  my $user = 'proftpd';
57129  my $passwd = 'test';
57130  my $group = 'ftpd';
57131  my $home_dir = File::Spec->rel2abs($tmpdir);
57132  my $uid = 500;
57133  my $gid = 500;
57134
57135  # Make sure that, if we're running as root, that the home directory has
57136  # permissions/privs set for the account we create
57137  if ($< == 0) {
57138    unless (chmod(0755, $home_dir)) {
57139      die("Can't set perms on $home_dir to 0755: $!");
57140    }
57141
57142    unless (chown($uid, $gid, $home_dir)) {
57143      die("Can't set owner of $home_dir to $uid/$gid: $!");
57144    }
57145  }
57146
57147  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
57148    '/bin/bash');
57149  auth_group_write($auth_group_file, $group, $gid, $user);
57150
57151  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
57152  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
57153
57154  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
57155  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
57156  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
57157
57158  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
57159  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
57160    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
57161  }
57162
57163  # For this test, we need the following directory structure:
57164  #
57165  #  src/
57166  #    files
57167  #    subdir1/
57168  #      files
57169  #    subdir2
57170  #      files
57171
57172  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
57173  mkpath($src_dir);
57174
57175  my $count = 25;
57176  for (my $i = 0; $i < $count; $i++) {
57177    my $filename = (chr(97 + $i)) . sprintf("%03s", $i);
57178    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
57179
57180    if (open(my $fh, "> $src_file")) {
57181      print $fh "ABCDefgh" x 7891;
57182
57183      unless (close($fh)) {
57184        die("Can't write $src_file: $!");
57185    }
57186
57187    } else {
57188      die("Can't open $src_file: $!");
57189    }
57190  }
57191
57192  for (my $i = 0; $i < $count; $i++) {
57193    my $filename = (chr(65 + $i)) . sprintf("%03s", $i);
57194    my $src_file = File::Spec->rel2abs("$src_dir/$filename");
57195
57196    if (open(my $fh, "> $src_file")) {
57197      print $fh "ABCDefgh" x 6458;
57198
57199      unless (close($fh)) {
57200        die("Can't write $src_file: $!");
57201    }
57202
57203    } else {
57204      die("Can't open $src_file: $!");
57205    }
57206  }
57207
57208  my $src_subdir = File::Spec->rel2abs("$src_dir/cd.d");
57209  mkpath($src_subdir);
57210
57211  for (my $i = 0; $i < $count; $i++) {
57212    my $filename = 'aa' . sprintf("%03s", $i);
57213    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
57214
57215    if (open(my $fh, "> $src_file")) {
57216      print $fh "ABCDefgh" x 9802;
57217
57218      unless (close($fh)) {
57219        die("Can't write $src_file: $!");
57220    }
57221
57222    } else {
57223      die("Can't open $src_file: $!");
57224    }
57225  }
57226
57227  $src_subdir = File::Spec->rel2abs("$src_dir/wx.d");
57228  mkpath($src_subdir);
57229
57230  for (my $i = 0; $i < $count; $i++) {
57231    my $filename = 'aa' . sprintf("%03s", $i);
57232    my $src_file = File::Spec->rel2abs("$src_subdir/$filename");
57233
57234    if (open(my $fh, "> $src_file")) {
57235      print $fh "ABCDefgh" x 8192;
57236
57237      unless (close($fh)) {
57238        die("Can't write $src_file: $!");
57239    }
57240
57241    } else {
57242      die("Can't open $src_file: $!");
57243    }
57244  }
57245
57246  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
57247  mkpath($dst_dir);
57248
57249  my $timeout_idle = 60;
57250
57251  my $config = {
57252    PidFile => $pid_file,
57253    ScoreboardFile => $scoreboard_file,
57254    SystemLog => $log_file,
57255    TraceLog => $log_file,
57256    Trace => 'DEFAULT:10 ssh2:20 scp:20',
57257
57258    AuthUserFile => $auth_user_file,
57259    AuthGroupFile => $auth_group_file,
57260
57261    IfModules => {
57262      'mod_delay.c' => {
57263        DelayEngine => 'off',
57264      },
57265
57266      'mod_sftp.c' => [
57267        "SFTPEngine on",
57268        "SFTPLog $log_file",
57269        "SFTPHostKey $rsa_host_key",
57270        "SFTPHostKey $dsa_host_key",
57271        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
57272      ],
57273    },
57274  };
57275
57276  my ($port, $config_user, $config_group) = config_write($config_file, $config);
57277
57278  # Open pipes, for use between the parent and child processes.  Specifically,
57279  # the child will indicate when it's done with its test by writing a message
57280  # to the parent.
57281  my ($rfh, $wfh);
57282  unless (pipe($rfh, $wfh)) {
57283    die("Can't open pipe: $!");
57284  }
57285
57286  require Net::SSH2;
57287
57288  my $ex;
57289
57290  # Ignore SIGPIPE
57291  local $SIG{PIPE} = sub { };
57292
57293  # Fork child
57294  $self->handle_sigchld();
57295  defined(my $pid = fork()) or die("Can't fork: $!");
57296  if ($pid) {
57297    eval {
57298      my @cmd = (
57299        'scp',
57300        '-r',
57301        '-vvv',
57302        '-oBatchMode=yes',
57303        '-oCheckHostIP=no',
57304        "-oPort=$port",
57305        "-oIdentityFile=$rsa_priv_key",
57306        '-oPubkeyAuthentication=yes',
57307        '-oStrictHostKeyChecking=no',
57308        "$user\@127.0.0.1:src.d/",
57309        "$dst_dir",
57310      );
57311
57312      my $scp_rh = IO::Handle->new();
57313      my $scp_wh = IO::Handle->new();
57314      my $scp_eh = IO::Handle->new();
57315
57316      $scp_wh->autoflush(1);
57317
57318      sleep(1);
57319
57320      local $SIG{CHLD} = 'DEFAULT';
57321
57322      # Make sure that the perms on the priv key are what OpenSSH wants
57323      unless (chmod(0400, $rsa_priv_key)) {
57324        die("Can't set perms on $rsa_priv_key to 0400: $!");
57325      }
57326
57327      if ($ENV{TEST_VERBOSE}) {
57328        print STDERR "Executing: ", join(' ', @cmd), "\n";
57329      }
57330
57331      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
57332      waitpid($scp_pid, 0);
57333      my $exit_status = $?;
57334
57335      # Restore the perms on the priv key
57336      unless (chmod(0644, $rsa_priv_key)) {
57337        die("Can't set perms on $rsa_priv_key to 0644: $!");
57338      }
57339
57340      my ($res, $errstr);
57341      if ($exit_status >> 8 == 0) {
57342        $errstr = join('', <$scp_eh>);
57343        $res = 0;
57344
57345      } else {
57346        $errstr = join('', <$scp_eh>);
57347        if ($ENV{TEST_VERBOSE}) {
57348          print STDERR "Stderr: $errstr\n";
57349        }
57350
57351        $res = 1;
57352      }
57353
57354      unless ($res) {
57355        die("Can't download $src_dir from server: $errstr");
57356      }
57357
57358      unless (-d "$dst_dir/src.d") {
57359        die("Directory '$dst_dir/src.d' does not exist as expected");
57360      }
57361
57362      unless (-f "$dst_dir/src.d/y024") {
57363        die("File '$dst_dir/src.d/y024' does not exist as expected");
57364      }
57365
57366      unless (-f "$dst_dir/src.d/Y024") {
57367        die("File '$dst_dir/src.d/Y024' does not exist as expected");
57368      }
57369
57370      unless (-d "$dst_dir/src.d/cd.d") {
57371        die("Directory '$dst_dir/src.d/cd.d' does not exist as expected");
57372      }
57373
57374      unless (-f "$dst_dir/src.d/cd.d/aa024") {
57375        die("File '$dst_dir/src.d/cd.d/aa024' does not exist as expected");
57376      }
57377
57378      unless (-d "$dst_dir/src.d/wx.d") {
57379        die("Directory '$dst_dir/src.d/wx.d' does not exist as expected");
57380      }
57381
57382      unless (-f "$dst_dir/src.d/wx.d/aa024") {
57383        die("File '$dst_dir/src.d/wx.d/aa024' does not exist as expected");
57384      }
57385
57386    };
57387
57388    if ($@) {
57389      $ex = $@;
57390    }
57391
57392    $wfh->print("done\n");
57393    $wfh->flush();
57394
57395  } else {
57396    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
57397    if ($@) {
57398      warn($@);
57399      exit 1;
57400    }
57401
57402    exit 0;
57403  }
57404
57405  # Stop server
57406  server_stop($pid_file);
57407
57408  $self->assert_child_ok($pid);
57409
57410  if ($ex) {
57411    test_append_logfile($log_file, $ex);
57412    unlink($log_file);
57413
57414    die($ex);
57415  }
57416
57417  unlink($log_file);
57418}
57419
57420sub scp_ext_download_recursive_empty_dir {
57421  my $self = shift;
57422  my $tmpdir = $self->{tmpdir};
57423
57424  my $config_file = "$tmpdir/sftp.conf";
57425  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
57426  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
57427
57428  my $log_file = test_get_logfile();
57429
57430  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
57431  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
57432
57433  my $user = 'proftpd';
57434  my $passwd = 'test';
57435  my $group = 'ftpd';
57436  my $home_dir = File::Spec->rel2abs($tmpdir);
57437  my $uid = 500;
57438  my $gid = 500;
57439
57440  # Make sure that, if we're running as root, that the home directory has
57441  # permissions/privs set for the account we create
57442  if ($< == 0) {
57443    unless (chmod(0755, $home_dir)) {
57444      die("Can't set perms on $home_dir to 0755: $!");
57445    }
57446
57447    unless (chown($uid, $gid, $home_dir)) {
57448      die("Can't set owner of $home_dir to $uid/$gid: $!");
57449    }
57450  }
57451
57452  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
57453    '/bin/bash');
57454  auth_group_write($auth_group_file, $group, $gid, $user);
57455
57456  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
57457  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
57458
57459  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
57460  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
57461  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
57462
57463  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
57464  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
57465    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
57466  }
57467
57468  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
57469  mkpath($src_dir);
57470
57471  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
57472  mkpath($dst_dir);
57473
57474  my $timeout_idle = 60;
57475
57476  my $config = {
57477    PidFile => $pid_file,
57478    ScoreboardFile => $scoreboard_file,
57479    SystemLog => $log_file,
57480    TraceLog => $log_file,
57481    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
57482
57483    AuthUserFile => $auth_user_file,
57484    AuthGroupFile => $auth_group_file,
57485
57486    IfModules => {
57487      'mod_delay.c' => {
57488        DelayEngine => 'off',
57489      },
57490
57491      'mod_sftp.c' => [
57492        "SFTPEngine on",
57493        "SFTPLog $log_file",
57494        "SFTPHostKey $rsa_host_key",
57495        "SFTPHostKey $dsa_host_key",
57496        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
57497      ],
57498    },
57499  };
57500
57501  my ($port, $config_user, $config_group) = config_write($config_file, $config);
57502
57503  # Open pipes, for use between the parent and child processes.  Specifically,
57504  # the child will indicate when it's done with its test by writing a message
57505  # to the parent.
57506  my ($rfh, $wfh);
57507  unless (pipe($rfh, $wfh)) {
57508    die("Can't open pipe: $!");
57509  }
57510
57511  require Net::SSH2;
57512
57513  my $ex;
57514
57515  # Ignore SIGPIPE
57516  local $SIG{PIPE} = sub { };
57517
57518  # Fork child
57519  $self->handle_sigchld();
57520  defined(my $pid = fork()) or die("Can't fork: $!");
57521  if ($pid) {
57522    eval {
57523      my @cmd = (
57524        'scp',
57525        '-r',
57526        '-v',
57527        '-oBatchMode=yes',
57528        '-oCheckHostIP=no',
57529        "-oPort=$port",
57530        "-oIdentityFile=$rsa_priv_key",
57531        '-oPubkeyAuthentication=yes',
57532        '-oStrictHostKeyChecking=no',
57533        "$user\@127.0.0.1:src.d/",
57534        "$dst_dir",
57535      );
57536
57537      my $scp_rh = IO::Handle->new();
57538      my $scp_wh = IO::Handle->new();
57539      my $scp_eh = IO::Handle->new();
57540
57541      $scp_wh->autoflush(1);
57542
57543      sleep(1);
57544
57545      local $SIG{CHLD} = 'DEFAULT';
57546
57547      # Make sure that the perms on the priv key are what OpenSSH wants
57548      unless (chmod(0400, $rsa_priv_key)) {
57549        die("Can't set perms on $rsa_priv_key to 0400: $!");
57550      }
57551
57552      if ($ENV{TEST_VERBOSE}) {
57553        print STDERR "Executing: ", join(' ', @cmd), "\n";
57554      }
57555
57556      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
57557      waitpid($scp_pid, 0);
57558      my $exit_status = $?;
57559
57560      # Restore the perms on the priv key
57561      unless (chmod(0644, $rsa_priv_key)) {
57562        die("Can't set perms on $rsa_priv_key to 0644: $!");
57563      }
57564
57565      my ($res, $errstr);
57566
57567      $errstr = join('', <$scp_eh>);
57568      if ($exit_status >> 8 == 0) {
57569        $res = 0;
57570
57571      } else {
57572        $errstr = join('', <$scp_eh>);
57573        if ($ENV{TEST_VERBOSE}) {
57574          print STDERR "Stderr: $errstr\n";
57575        }
57576
57577        $res = 1;
57578      }
57579
57580      unless ($res == 0) {
57581        die("Can't download $src_dir from server: $errstr");
57582      }
57583
57584      unless (-d "$dst_dir/src.d") {
57585        die("Directory '$dst_dir/src.d' does not exist as expected");
57586      }
57587    };
57588
57589    if ($@) {
57590      $ex = $@;
57591    }
57592
57593    $wfh->print("done\n");
57594    $wfh->flush();
57595
57596  } else {
57597    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
57598    if ($@) {
57599      warn($@);
57600      exit 1;
57601    }
57602
57603    exit 0;
57604  }
57605
57606  # Stop server
57607  server_stop($pid_file);
57608
57609  $self->assert_child_ok($pid);
57610
57611  if ($ex) {
57612    test_append_logfile($log_file, $ex);
57613    unlink($log_file);
57614
57615    die($ex);
57616  }
57617
57618  unlink($log_file);
57619}
57620
57621sub scp_ext_download_glob_no_matches_bug3935 {
57622  my $self = shift;
57623  my $tmpdir = $self->{tmpdir};
57624
57625  my $config_file = "$tmpdir/sftp.conf";
57626  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
57627  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
57628
57629  my $log_file = test_get_logfile();
57630
57631  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
57632  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
57633
57634  my $user = 'proftpd';
57635  my $passwd = 'test';
57636  my $group = 'ftpd';
57637  my $home_dir = File::Spec->rel2abs($tmpdir);
57638  my $uid = 500;
57639  my $gid = 500;
57640
57641  # Make sure that, if we're running as root, that the home directory has
57642  # permissions/privs set for the account we create
57643  if ($< == 0) {
57644    unless (chmod(0755, $home_dir)) {
57645      die("Can't set perms on $home_dir to 0755: $!");
57646    }
57647
57648    unless (chown($uid, $gid, $home_dir)) {
57649      die("Can't set owner of $home_dir to $uid/$gid: $!");
57650    }
57651  }
57652
57653  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
57654    '/bin/bash');
57655  auth_group_write($auth_group_file, $group, $gid, $user);
57656
57657  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
57658  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
57659
57660  my $rsa_priv_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key');
57661  my $rsa_pub_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/test_rsa_key.pub');
57662  my $rsa_rfc4716_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/authorized_rsa_keys');
57663
57664  my $authorized_keys = File::Spec->rel2abs("$tmpdir/.authorized_keys");
57665  unless (copy($rsa_rfc4716_key, $authorized_keys)) {
57666    die("Can't copy $rsa_rfc4716_key to $authorized_keys: $!");
57667  }
57668
57669  my $src_dir = File::Spec->rel2abs("$tmpdir/src.d");
57670  mkpath($src_dir);
57671
57672  my $dst_dir = File::Spec->rel2abs("$tmpdir/dst.d");
57673  mkpath($dst_dir);
57674
57675  my $timeout_idle = 60;
57676
57677  my $config = {
57678    PidFile => $pid_file,
57679    ScoreboardFile => $scoreboard_file,
57680    SystemLog => $log_file,
57681    TraceLog => $log_file,
57682    Trace => 'DEFAULT:10 ssh2:20 scp:20',
57683
57684    AuthUserFile => $auth_user_file,
57685    AuthGroupFile => $auth_group_file,
57686
57687    IfModules => {
57688      'mod_delay.c' => {
57689        DelayEngine => 'off',
57690      },
57691
57692      'mod_sftp.c' => [
57693        "SFTPEngine on",
57694        "SFTPLog $log_file",
57695        "SFTPHostKey $rsa_host_key",
57696        "SFTPHostKey $dsa_host_key",
57697        "SFTPAuthorizedUserKeys file:~/.authorized_keys",
57698      ],
57699    },
57700  };
57701
57702  my ($port, $config_user, $config_group) = config_write($config_file, $config);
57703
57704  # Open pipes, for use between the parent and child processes.  Specifically,
57705  # the child will indicate when it's done with its test by writing a message
57706  # to the parent.
57707  my ($rfh, $wfh);
57708  unless (pipe($rfh, $wfh)) {
57709    die("Can't open pipe: $!");
57710  }
57711
57712  require Net::SSH2;
57713
57714  my $ex;
57715
57716  # Ignore SIGPIPE
57717  local $SIG{PIPE} = sub { };
57718
57719  # Fork child
57720  $self->handle_sigchld();
57721  defined(my $pid = fork()) or die("Can't fork: $!");
57722  if ($pid) {
57723    eval {
57724      my @cmd = (
57725        'scp',
57726        '-vvv',
57727        '-oBatchMode=yes',
57728        '-oCheckHostIP=no',
57729        "-oPort=$port",
57730        "-oIdentityFile=$rsa_priv_key",
57731        '-oPubkeyAuthentication=yes',
57732        '-oStrictHostKeyChecking=no',
57733        "$user\@127.0.0.1:src.d/*",
57734        "$dst_dir",
57735      );
57736
57737      my $scp_rh = IO::Handle->new();
57738      my $scp_wh = IO::Handle->new();
57739      my $scp_eh = IO::Handle->new();
57740
57741      $scp_wh->autoflush(1);
57742
57743      sleep(1);
57744
57745      local $SIG{CHLD} = 'DEFAULT';
57746
57747      # Make sure that the perms on the priv key are what OpenSSH wants
57748      unless (chmod(0400, $rsa_priv_key)) {
57749        die("Can't set perms on $rsa_priv_key to 0400: $!");
57750      }
57751
57752      if ($ENV{TEST_VERBOSE}) {
57753        print STDERR "Executing: ", join(' ', @cmd), "\n";
57754      }
57755
57756      my $scp_pid = open3($scp_wh, $scp_rh, $scp_eh, @cmd);
57757      waitpid($scp_pid, 0);
57758      my $exit_status = $?;
57759
57760      # Restore the perms on the priv key
57761      unless (chmod(0644, $rsa_priv_key)) {
57762        die("Can't set perms on $rsa_priv_key to 0644: $!");
57763      }
57764
57765      my $res;
57766      my $errstr = join('', <$scp_eh>);
57767
57768      if ($exit_status >> 8 == 0) {
57769        $res = 0;
57770
57771      } else {
57772        $res = 1;
57773      }
57774
57775      unless ($errstr =~ /src\.d\/\*: No such file or directory/) {
57776        die("Did not receive expected error message from server (Bug#3935)");
57777      }
57778    };
57779
57780    if ($@) {
57781      $ex = $@;
57782    }
57783
57784    $wfh->print("done\n");
57785    $wfh->flush();
57786
57787  } else {
57788    eval { server_wait($config_file, $rfh, $timeout_idle + 2) };
57789    if ($@) {
57790      warn($@);
57791      exit 1;
57792    }
57793
57794    exit 0;
57795  }
57796
57797  # Stop server
57798  server_stop($pid_file);
57799
57800  $self->assert_child_ok($pid);
57801
57802  if ($ex) {
57803    test_append_logfile($log_file, $ex);
57804    unlink($log_file);
57805
57806    die($ex);
57807  }
57808
57809  unlink($log_file);
57810}
57811
57812sub scp_config_ignore_upload_perms {
57813  my $self = shift;
57814  my $tmpdir = $self->{tmpdir};
57815
57816  my $config_file = "$tmpdir/sftp.conf";
57817  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
57818  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
57819
57820  my $log_file = test_get_logfile();
57821
57822  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
57823  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
57824
57825  my $user = 'proftpd';
57826  my $passwd = 'test';
57827  my $group = 'ftpd';
57828  my $home_dir = File::Spec->rel2abs($tmpdir);
57829  my $uid = 500;
57830  my $gid = 500;
57831
57832  # Make sure that, if we're running as root, that the home directory has
57833  # permissions/privs set for the account we create
57834  if ($< == 0) {
57835    unless (chmod(0755, $home_dir)) {
57836      die("Can't set perms on $home_dir to 0755: $!");
57837    }
57838
57839    unless (chown($uid, $gid, $home_dir)) {
57840      die("Can't set owner of $home_dir to $uid/$gid: $!");
57841    }
57842  }
57843
57844  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
57845    '/bin/bash');
57846  auth_group_write($auth_group_file, $group, $gid, $user);
57847
57848  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
57849  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
57850
57851  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
57852
57853  my $config = {
57854    PidFile => $pid_file,
57855    ScoreboardFile => $scoreboard_file,
57856    SystemLog => $log_file,
57857    TraceLog => $log_file,
57858    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
57859
57860    AuthUserFile => $auth_user_file,
57861    AuthGroupFile => $auth_group_file,
57862
57863    IfModules => {
57864      'mod_delay.c' => {
57865        DelayEngine => 'off',
57866      },
57867
57868      'mod_sftp.c' => [
57869        "SFTPEngine on",
57870        "SFTPLog $log_file",
57871        "SFTPHostKey $rsa_host_key",
57872        "SFTPHostKey $dsa_host_key",
57873
57874        "SFTPOptions IgnoreSCPUploadPerms",
57875      ],
57876    },
57877  };
57878
57879  my ($port, $config_user, $config_group) = config_write($config_file, $config);
57880
57881  # Open pipes, for use between the parent and child processes.  Specifically,
57882  # the child will indicate when it's done with its test by writing a message
57883  # to the parent.
57884  my ($rfh, $wfh);
57885  unless (pipe($rfh, $wfh)) {
57886    die("Can't open pipe: $!");
57887  }
57888
57889  require Net::SSH2;
57890
57891  my $ex;
57892
57893  # Ignore SIGPIPE
57894  local $SIG{PIPE} = sub { };
57895
57896  # Fork child
57897  $self->handle_sigchld();
57898  defined(my $pid = fork()) or die("Can't fork: $!");
57899  if ($pid) {
57900    eval {
57901      my $ssh2 = Net::SSH2->new();
57902
57903      sleep(1);
57904
57905      unless ($ssh2->connect('127.0.0.1', $port)) {
57906        my ($err_code, $err_name, $err_str) = $ssh2->error();
57907        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
57908      }
57909
57910      unless ($ssh2->auth_password($user, $passwd)) {
57911        my ($err_code, $err_name, $err_str) = $ssh2->error();
57912        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
57913      }
57914
57915      chmod(0666, $config_file);
57916
57917      my $res = $ssh2->scp_put($config_file, 'test.txt');
57918      unless ($res) {
57919        my ($err_code, $err_name, $err_str) = $ssh2->error();
57920        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
57921      }
57922
57923      $ssh2->disconnect();
57924
57925      unless (-f $test_file) {
57926        die("$test_file file does not exist as expected");
57927      }
57928    };
57929
57930    if ($@) {
57931      $ex = $@;
57932    }
57933
57934    $wfh->print("done\n");
57935    $wfh->flush();
57936
57937  } else {
57938    eval { server_wait($config_file, $rfh) };
57939    if ($@) {
57940      warn($@);
57941      exit 1;
57942    }
57943
57944    exit 0;
57945  }
57946
57947  # Stop server
57948  server_stop($pid_file);
57949
57950  $self->assert_child_ok($pid);
57951
57952  if ($ex) {
57953    test_append_logfile($log_file, $ex);
57954    unlink($log_file);
57955
57956    die($ex);
57957  }
57958
57959  my $perms = ((stat($test_file))[2] & 07777);
57960
57961  my $expected = 0644;
57962  $self->assert($expected == $perms,
57963    test_msg("Expected '$expected', got '$perms'"));
57964
57965  unlink($log_file);
57966}
57967
57968sub scp_config_ignore_upload_times {
57969  my $self = shift;
57970  my $tmpdir = $self->{tmpdir};
57971
57972  my $config_file = "$tmpdir/sftp.conf";
57973  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
57974  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
57975
57976  my $log_file = test_get_logfile();
57977
57978  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
57979  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
57980
57981  my $user = 'proftpd';
57982  my $passwd = 'test';
57983  my $group = 'ftpd';
57984  my $home_dir = File::Spec->rel2abs($tmpdir);
57985  my $uid = 500;
57986  my $gid = 500;
57987
57988  # Make sure that, if we're running as root, that the home directory has
57989  # permissions/privs set for the account we create
57990  if ($< == 0) {
57991    unless (chmod(0755, $home_dir)) {
57992      die("Can't set perms on $home_dir to 0755: $!");
57993    }
57994
57995    unless (chown($uid, $gid, $home_dir)) {
57996      die("Can't set owner of $home_dir to $uid/$gid: $!");
57997    }
57998  }
57999
58000  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58001    '/bin/bash');
58002  auth_group_write($auth_group_file, $group, $gid, $user);
58003
58004  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58005  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58006
58007  my $src_file = File::Spec->rel2abs("$tmpdir/test.txt");
58008  if (open(my $fh, "> $src_file")) {
58009    unless (close($fh)) {
58010      die("Can't write $src_file: $!");
58011    }
58012
58013  } else {
58014    die("Can't open $src_file: $!");
58015  }
58016
58017  my $ts = 1;
58018  unless (utime($ts, $ts, $src_file)) {
58019    die("Can't change times on $src_file: $!");
58020  }
58021
58022  my $expected_atime = (stat($src_file))[8];
58023  my $expected_mtime = (stat($src_file))[9];
58024
58025  my $dst_file = File::Spec->rel2abs("$tmpdir/test2.txt");
58026
58027  my $config = {
58028    PidFile => $pid_file,
58029    ScoreboardFile => $scoreboard_file,
58030    SystemLog => $log_file,
58031    TraceLog => $log_file,
58032    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58033
58034    AuthUserFile => $auth_user_file,
58035    AuthGroupFile => $auth_group_file,
58036
58037    IfModules => {
58038      'mod_delay.c' => {
58039        DelayEngine => 'off',
58040      },
58041
58042      'mod_sftp.c' => [
58043        "SFTPEngine on",
58044        "SFTPLog $log_file",
58045        "SFTPHostKey $rsa_host_key",
58046        "SFTPHostKey $dsa_host_key",
58047
58048        "SFTPOptions IgnoreSCPUploadTimes",
58049      ],
58050    },
58051  };
58052
58053  my ($port, $config_user, $config_group) = config_write($config_file, $config);
58054
58055  # Open pipes, for use between the parent and child processes.  Specifically,
58056  # the child will indicate when it's done with its test by writing a message
58057  # to the parent.
58058  my ($rfh, $wfh);
58059  unless (pipe($rfh, $wfh)) {
58060    die("Can't open pipe: $!");
58061  }
58062
58063  require Net::SSH2;
58064
58065  my $ex;
58066
58067  # Ignore SIGPIPE
58068  local $SIG{PIPE} = sub { };
58069
58070  # Fork child
58071  $self->handle_sigchld();
58072  defined(my $pid = fork()) or die("Can't fork: $!");
58073  if ($pid) {
58074    eval {
58075      my $ssh2 = Net::SSH2->new();
58076
58077      sleep(1);
58078
58079      unless ($ssh2->connect('127.0.0.1', $port)) {
58080        my ($err_code, $err_name, $err_str) = $ssh2->error();
58081        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
58082      }
58083
58084      unless ($ssh2->auth_password($user, $passwd)) {
58085        my ($err_code, $err_name, $err_str) = $ssh2->error();
58086        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
58087      }
58088
58089      my $res = $ssh2->scp_put($src_file, $dst_file);
58090      unless ($res) {
58091        my ($err_code, $err_name, $err_str) = $ssh2->error();
58092        die("Can't upload $src_file to server: [$err_name] ($err_code) $err_str");
58093      }
58094
58095      $ssh2->disconnect();
58096
58097      unless (-f $dst_file) {
58098        die("File $dst_file does not exist as expected");
58099      }
58100
58101      my $atime = (stat($dst_file))[8];
58102      my $mtime = (stat($dst_file))[9];
58103
58104      my $expected = $expected_atime;
58105      $self->assert($expected != $atime,
58106        test_msg("Expected atime to not be $expected, got $atime"));
58107
58108      $expected = $expected_mtime;
58109      $self->assert($expected != $mtime,
58110        test_msg("Expected mtime to not be $expected, got $mtime"));
58111    };
58112
58113    if ($@) {
58114      $ex = $@;
58115    }
58116
58117    $wfh->print("done\n");
58118    $wfh->flush();
58119
58120  } else {
58121    eval { server_wait($config_file, $rfh) };
58122    if ($@) {
58123      warn($@);
58124      exit 1;
58125    }
58126
58127    exit 0;
58128  }
58129
58130  # Stop server
58131  server_stop($pid_file);
58132
58133  $self->assert_child_ok($pid);
58134
58135  if ($ex) {
58136    test_append_logfile($log_file, $ex);
58137    unlink($log_file);
58138
58139    die($ex);
58140  }
58141
58142  unlink($log_file);
58143}
58144
58145sub scp_config_hiddenstores {
58146  my $self = shift;
58147  my $tmpdir = $self->{tmpdir};
58148
58149  my $config_file = "$tmpdir/sftp.conf";
58150  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
58151  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
58152
58153  my $log_file = test_get_logfile();
58154
58155  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
58156  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
58157
58158  my $user = 'proftpd';
58159  my $passwd = 'test';
58160  my $group = 'ftpd';
58161  my $home_dir = File::Spec->rel2abs($tmpdir);
58162  my $uid = 500;
58163  my $gid = 500;
58164
58165  # Make sure that, if we're running as root, that the home directory has
58166  # permissions/privs set for the account we create
58167  if ($< == 0) {
58168    unless (chmod(0755, $home_dir)) {
58169      die("Can't set perms on $home_dir to 0755: $!");
58170    }
58171
58172    unless (chown($uid, $gid, $home_dir)) {
58173      die("Can't set owner of $home_dir to $uid/$gid: $!");
58174    }
58175  }
58176
58177  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58178    '/bin/bash');
58179  auth_group_write($auth_group_file, $group, $gid, $user);
58180
58181  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58182  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58183
58184  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
58185  my $hidden_file = File::Spec->rel2abs("$tmpdir/.in.test.txt.");
58186
58187  my $config = {
58188    PidFile => $pid_file,
58189    ScoreboardFile => $scoreboard_file,
58190    SystemLog => $log_file,
58191    TraceLog => $log_file,
58192    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58193
58194    AuthUserFile => $auth_user_file,
58195    AuthGroupFile => $auth_group_file,
58196
58197    HiddenStores => 'on',
58198
58199    IfModules => {
58200      'mod_delay.c' => {
58201        DelayEngine => 'off',
58202      },
58203
58204      'mod_sftp.c' => [
58205        "SFTPEngine on",
58206        "SFTPLog $log_file",
58207        "SFTPHostKey $rsa_host_key",
58208        "SFTPHostKey $dsa_host_key",
58209      ],
58210    },
58211  };
58212
58213  my ($port, $config_user, $config_group) = config_write($config_file, $config);
58214
58215  # Open pipes, for use between the parent and child processes.  Specifically,
58216  # the child will indicate when it's done with its test by writing a message
58217  # to the parent.
58218  my ($rfh, $wfh);
58219  unless (pipe($rfh, $wfh)) {
58220    die("Can't open pipe: $!");
58221  }
58222
58223  require Net::SSH2;
58224
58225  my $ex;
58226
58227  # Ignore SIGPIPE
58228  local $SIG{PIPE} = sub { };
58229
58230  # Fork child
58231  $self->handle_sigchld();
58232  defined(my $pid = fork()) or die("Can't fork: $!");
58233  if ($pid) {
58234    eval {
58235      my $ssh2 = Net::SSH2->new();
58236
58237      sleep(1);
58238
58239      unless ($ssh2->connect('127.0.0.1', $port)) {
58240        my ($err_code, $err_name, $err_str) = $ssh2->error();
58241        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
58242      }
58243
58244      unless ($ssh2->auth_password($user, $passwd)) {
58245        my ($err_code, $err_name, $err_str) = $ssh2->error();
58246        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
58247      }
58248
58249      my $res = $ssh2->scp_put($config_file, 'test.txt');
58250      unless ($res) {
58251        my ($err_code, $err_name, $err_str) = $ssh2->error();
58252        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
58253      }
58254
58255      $ssh2->disconnect();
58256
58257      if (-f $hidden_file) {
58258        die("File $hidden_file exists unexpectedly");
58259      }
58260
58261      unless (-f $test_file) {
58262        die("File $test_file does not exist as expected");
58263      }
58264    };
58265
58266    if ($@) {
58267      $ex = $@;
58268    }
58269
58270    $wfh->print("done\n");
58271    $wfh->flush();
58272
58273  } else {
58274    eval { server_wait($config_file, $rfh) };
58275    if ($@) {
58276      warn($@);
58277      exit 1;
58278    }
58279
58280    exit 0;
58281  }
58282
58283  # Stop server
58284  server_stop($pid_file);
58285
58286  $self->assert_child_ok($pid);
58287
58288  if ($ex) {
58289    test_append_logfile($log_file, $ex);
58290    unlink($log_file);
58291
58292    die($ex);
58293  }
58294
58295  unlink($log_file);
58296}
58297
58298sub scp_config_subdir_upload_allowed {
58299  my $self = shift;
58300  my $tmpdir = $self->{tmpdir};
58301
58302  my $config_file = "$tmpdir/sftp.conf";
58303  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
58304  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
58305
58306  my $log_file = test_get_logfile();
58307
58308  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
58309  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
58310
58311  my $user = 'proftpd';
58312  my $passwd = 'test';
58313  my $group = 'ftpd';
58314  my $home_dir = File::Spec->rel2abs($tmpdir);
58315  my $uid = 500;
58316  my $gid = 500;
58317
58318  my $parent_dir = File::Spec->rel2abs("$tmpdir/dir");
58319  my $sub_dir = File::Spec->rel2abs("$parent_dir/subdir");
58320  mkpath($sub_dir);
58321
58322  # Make sure that, if we're running as root, that the home directory has
58323  # permissions/privs set for the account we create
58324  if ($< == 0) {
58325    unless (chmod(0755, $home_dir, $parent_dir, $sub_dir)) {
58326      die("Can't set perms on $home_dir, $parent_dir, $sub_dir to 0755: $!");
58327    }
58328
58329    unless (chown($uid, $gid, $home_dir, $parent_dir, $sub_dir)) {
58330      die("Can't set owner of $home_dir, $parent_dir, $sub_dir to $uid/$gid: $!");
58331    }
58332  }
58333
58334  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58335    '/bin/bash');
58336  auth_group_write($auth_group_file, $group, $gid, $user);
58337
58338  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58339  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58340
58341  my $config = {
58342    PidFile => $pid_file,
58343    ScoreboardFile => $scoreboard_file,
58344    SystemLog => $log_file,
58345    TraceLog => $log_file,
58346    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58347
58348    AuthUserFile => $auth_user_file,
58349    AuthGroupFile => $auth_group_file,
58350
58351    # Provide a specific <Directory> configuration which should only allow
58352    # uploads to a sub directory, not to the parent directory.  Apparently
58353    # works as expected for FTP and SFTP, but not SCP.
58354    Directory => {
58355      '~/*/*' => {
58356        Limit => {
58357          STOR => {
58358            AllowAll => '',
58359          },
58360        },
58361      },
58362    },
58363
58364    Limit => {
58365      WRITE => {
58366        DenyAll => '',
58367      },
58368    },
58369
58370    IfModules => {
58371      'mod_delay.c' => {
58372        DelayEngine => 'off',
58373      },
58374
58375      'mod_sftp.c' => [
58376        "SFTPEngine on",
58377        "SFTPLog $log_file",
58378        "SFTPHostKey $rsa_host_key",
58379        "SFTPHostKey $dsa_host_key",
58380      ],
58381    },
58382  };
58383
58384  my ($port, $config_user, $config_group) = config_write($config_file, $config);
58385
58386  # Open pipes, for use between the parent and child processes.  Specifically,
58387  # the child will indicate when it's done with its test by writing a message
58388  # to the parent.
58389  my ($rfh, $wfh);
58390  unless (pipe($rfh, $wfh)) {
58391    die("Can't open pipe: $!");
58392  }
58393
58394  require Net::SSH2;
58395
58396  my $ex;
58397
58398  # Ignore SIGPIPE
58399  local $SIG{PIPE} = sub { };
58400
58401  # Fork child
58402  $self->handle_sigchld();
58403  defined(my $pid = fork()) or die("Can't fork: $!");
58404  if ($pid) {
58405    eval {
58406      my $ssh2 = Net::SSH2->new();
58407
58408      sleep(1);
58409
58410      unless ($ssh2->connect('127.0.0.1', $port)) {
58411        my ($err_code, $err_name, $err_str) = $ssh2->error();
58412        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
58413      }
58414
58415      unless ($ssh2->auth_password($user, $passwd)) {
58416        my ($err_code, $err_name, $err_str) = $ssh2->error();
58417        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
58418      }
58419
58420      my $res = $ssh2->scp_put($config_file, 'dir/test.txt');
58421      unless ($res) {
58422        my ($err_code, $err_name, $err_str) = $ssh2->error();
58423        die("Can't upload $config_file to 'dir/test.txt' on server: [$err_name] ($err_code) $err_str");
58424      }
58425
58426      $ssh2->disconnect();
58427    };
58428
58429    if ($@) {
58430      $ex = $@;
58431    }
58432
58433    $wfh->print("done\n");
58434    $wfh->flush();
58435
58436  } else {
58437    eval { server_wait($config_file, $rfh) };
58438    if ($@) {
58439      warn($@);
58440      exit 1;
58441    }
58442
58443    exit 0;
58444  }
58445
58446  # Stop server
58447  server_stop($pid_file);
58448
58449  $self->assert_child_ok($pid);
58450
58451  if ($ex) {
58452    test_append_logfile($log_file, $ex);
58453    unlink($log_file);
58454
58455    die($ex);
58456  }
58457
58458  unlink($log_file);
58459}
58460
58461sub scp_config_protocols {
58462  my $self = shift;
58463  my $tmpdir = $self->{tmpdir};
58464
58465  my $config_file = "$tmpdir/sftp.conf";
58466  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
58467  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
58468
58469  my $log_file = test_get_logfile();
58470
58471  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
58472  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
58473
58474  my $user = 'proftpd';
58475  my $passwd = 'test';
58476  my $group = 'ftpd';
58477  my $home_dir = File::Spec->rel2abs($tmpdir);
58478  my $uid = 500;
58479  my $gid = 500;
58480
58481  # Make sure that, if we're running as root, that the home directory has
58482  # permissions/privs set for the account we create
58483  if ($< == 0) {
58484    unless (chmod(0755, $home_dir)) {
58485      die("Can't set perms on $home_dir to 0755: $!");
58486    }
58487
58488    unless (chown($uid, $gid, $home_dir)) {
58489      die("Can't set owner of $home_dir to $uid/$gid: $!");
58490    }
58491  }
58492
58493  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58494    '/bin/bash');
58495  auth_group_write($auth_group_file, $group, $gid, $user);
58496
58497  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58498  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58499
58500  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
58501
58502  my $config = {
58503    PidFile => $pid_file,
58504    ScoreboardFile => $scoreboard_file,
58505    SystemLog => $log_file,
58506    TraceLog => $log_file,
58507    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58508
58509    AuthUserFile => $auth_user_file,
58510    AuthGroupFile => $auth_group_file,
58511
58512    IfModules => {
58513      'mod_delay.c' => {
58514        DelayEngine => 'off',
58515      },
58516
58517      'mod_sftp.c' => [
58518        "SFTPEngine on",
58519        "SFTPLog $log_file",
58520        "SFTPHostKey $rsa_host_key",
58521        "SFTPHostKey $dsa_host_key",
58522        "Protocols sftp",
58523      ],
58524    },
58525  };
58526
58527  my ($port, $config_user, $config_group) = config_write($config_file, $config);
58528
58529  # Open pipes, for use between the parent and child processes.  Specifically,
58530  # the child will indicate when it's done with its test by writing a message
58531  # to the parent.
58532  my ($rfh, $wfh);
58533  unless (pipe($rfh, $wfh)) {
58534    die("Can't open pipe: $!");
58535  }
58536
58537  require Net::SSH2;
58538
58539  my $ex;
58540
58541  # Ignore SIGPIPE
58542  local $SIG{PIPE} = sub { };
58543
58544  # Fork child
58545  $self->handle_sigchld();
58546  defined(my $pid = fork()) or die("Can't fork: $!");
58547  if ($pid) {
58548    eval {
58549      my $ssh2 = Net::SSH2->new();
58550
58551      sleep(1);
58552
58553      unless ($ssh2->connect('127.0.0.1', $port)) {
58554        my ($err_code, $err_name, $err_str) = $ssh2->error();
58555        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
58556      }
58557
58558      unless ($ssh2->auth_password($user, $passwd)) {
58559        my ($err_code, $err_name, $err_str) = $ssh2->error();
58560        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
58561      }
58562
58563      my $res = $ssh2->scp_put($config_file, 'test.txt');
58564      if ($res) {
58565        die("SCP upload succeeded unexpectedly");
58566      }
58567
58568      my ($err_code, $err_name, $err_str) = $ssh2->error();
58569
58570      $ssh2->disconnect();
58571
58572      if (-f $test_file) {
58573        die("File $test_file exists unexpectedly");
58574      }
58575    };
58576
58577    if ($@) {
58578      $ex = $@;
58579    }
58580
58581    $wfh->print("done\n");
58582    $wfh->flush();
58583
58584  } else {
58585    eval { server_wait($config_file, $rfh) };
58586    if ($@) {
58587      warn($@);
58588      exit 1;
58589    }
58590
58591    exit 0;
58592  }
58593
58594  # Stop server
58595  server_stop($pid_file);
58596
58597  $self->assert_child_ok($pid);
58598
58599  if ($ex) {
58600    test_append_logfile($log_file, $ex);
58601    unlink($log_file);
58602
58603    die($ex);
58604  }
58605
58606  unlink($log_file);
58607}
58608
58609sub scp_config_userowner {
58610  my $self = shift;
58611  my $tmpdir = $self->{tmpdir};
58612
58613  my $config_file = "$tmpdir/sftp.conf";
58614  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
58615  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
58616
58617  my $log_file = test_get_logfile();
58618
58619  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
58620  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
58621
58622  my $user = 'proftpd';
58623  my $passwd = 'test';
58624  my $group = 'ftpd';
58625  my $home_dir = File::Spec->rel2abs($tmpdir);
58626  my $uid = 500;
58627  my $gid = 500;
58628
58629  # Make sure that, if we're running as root, that the home directory has
58630  # permissions/privs set for the account we create
58631  if ($< == 0) {
58632    unless (chmod(0755, $home_dir)) {
58633      die("Can't set perms on $home_dir to 0755: $!");
58634    }
58635
58636    unless (chown($uid, $gid, $home_dir)) {
58637      die("Can't set owner of $home_dir to $uid/$gid: $!");
58638    }
58639  }
58640
58641  my $owner = 'proftpd2';
58642  my $owner_uid = 7777;
58643
58644  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58645    '/bin/bash');
58646  auth_user_write($auth_user_file, $owner, 'none', $owner_uid, $gid, $home_dir,
58647    '/bin/bash');
58648  auth_group_write($auth_group_file, $group, $gid, $user);
58649
58650  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58651  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58652
58653  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
58654
58655  my $config = {
58656    PidFile => $pid_file,
58657    ScoreboardFile => $scoreboard_file,
58658    SystemLog => $log_file,
58659    TraceLog => $log_file,
58660    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58661
58662    AuthUserFile => $auth_user_file,
58663    AuthGroupFile => $auth_group_file,
58664    RootRevoke => 'off',
58665
58666    Directory => {
58667      '~' => {
58668        UserOwner => $owner,
58669      },
58670    },
58671
58672    IfModules => {
58673      'mod_delay.c' => {
58674        DelayEngine => 'off',
58675      },
58676
58677      'mod_sftp.c' => [
58678        "SFTPEngine on",
58679        "SFTPLog $log_file",
58680        "SFTPHostKey $rsa_host_key",
58681        "SFTPHostKey $dsa_host_key",
58682      ],
58683    },
58684  };
58685
58686  my ($port, $config_user, $config_group) = config_write($config_file, $config);
58687
58688  # Open pipes, for use between the parent and child processes.  Specifically,
58689  # the child will indicate when it's done with its test by writing a message
58690  # to the parent.
58691  my ($rfh, $wfh);
58692  unless (pipe($rfh, $wfh)) {
58693    die("Can't open pipe: $!");
58694  }
58695
58696  require Net::SSH2;
58697
58698  my $ex;
58699
58700  # Ignore SIGPIPE
58701  local $SIG{PIPE} = sub { };
58702
58703  # Fork child
58704  $self->handle_sigchld();
58705  defined(my $pid = fork()) or die("Can't fork: $!");
58706  if ($pid) {
58707    eval {
58708      my $ssh2 = Net::SSH2->new();
58709
58710      sleep(1);
58711
58712      unless ($ssh2->connect('127.0.0.1', $port)) {
58713        my ($err_code, $err_name, $err_str) = $ssh2->error();
58714        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
58715      }
58716
58717      unless ($ssh2->auth_password($user, $passwd)) {
58718        my ($err_code, $err_name, $err_str) = $ssh2->error();
58719        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
58720      }
58721
58722      my $res = $ssh2->scp_put($config_file, 'test.txt');
58723      unless ($res) {
58724        my ($err_code, $err_name, $err_str) = $ssh2->error();
58725        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
58726      }
58727
58728      $ssh2->disconnect();
58729
58730      unless (-f $test_file) {
58731        die("File $test_file file does not exist as expected");
58732      }
58733
58734      my $owning_uid = (stat($test_file))[4];
58735      $self->assert($owner_uid == $owning_uid,
58736        test_msg("Expected $owner_uid, got $owning_uid"));
58737    };
58738
58739    if ($@) {
58740      $ex = $@;
58741    }
58742
58743    $wfh->print("done\n");
58744    $wfh->flush();
58745
58746  } else {
58747    eval { server_wait($config_file, $rfh) };
58748    if ($@) {
58749      warn($@);
58750      exit 1;
58751    }
58752
58753    exit 0;
58754  }
58755
58756  # Stop server
58757  server_stop($pid_file);
58758
58759  $self->assert_child_ok($pid);
58760
58761  if ($ex) {
58762    test_append_logfile($log_file, $ex);
58763    unlink($log_file);
58764
58765    die($ex);
58766  }
58767
58768  unlink($log_file);
58769}
58770
58771sub scp_config_groupowner_file_nonmember {
58772  my $self = shift;
58773  my $tmpdir = $self->{tmpdir};
58774
58775  my $config_file = "$tmpdir/sftp.conf";
58776  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
58777  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
58778
58779  my $log_file = test_get_logfile();
58780
58781  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
58782  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
58783
58784  my $user = 'proftpd';
58785  my $passwd = 'test';
58786  my $group = 'ftpd';
58787  my $home_dir = File::Spec->rel2abs($tmpdir);
58788  my $uid = 500;
58789  my $gid = 500;
58790
58791  # Make sure that, if we're running as root, that the home directory has
58792  # permissions/privs set for the account we create
58793  if ($< == 0) {
58794    unless (chmod(0755, $home_dir)) {
58795      die("Can't set perms on $home_dir to 0755: $!");
58796    }
58797
58798    unless (chown($uid, $gid, $home_dir)) {
58799      die("Can't set owner of $home_dir to $uid/$gid: $!");
58800    }
58801  }
58802
58803  my $owner = 'proftpd2';
58804  my $owner_gid = 7777;
58805
58806  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58807    '/bin/bash');
58808  auth_group_write($auth_group_file, $group, $gid, $user);
58809  auth_group_write($auth_group_file, $owner, $owner_gid, 'foo');
58810
58811  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58812  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58813
58814  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
58815
58816  my $config = {
58817    PidFile => $pid_file,
58818    ScoreboardFile => $scoreboard_file,
58819    SystemLog => $log_file,
58820    TraceLog => $log_file,
58821    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58822
58823    AuthUserFile => $auth_user_file,
58824    AuthGroupFile => $auth_group_file,
58825    RootRevoke => 'off',
58826
58827    Directory => {
58828      '~' => {
58829        GroupOwner => $owner,
58830      },
58831    },
58832
58833    IfModules => {
58834      'mod_delay.c' => {
58835        DelayEngine => 'off',
58836      },
58837
58838      'mod_sftp.c' => [
58839        "SFTPEngine on",
58840        "SFTPLog $log_file",
58841        "SFTPHostKey $rsa_host_key",
58842        "SFTPHostKey $dsa_host_key",
58843      ],
58844    },
58845  };
58846
58847  my ($port, $config_user, $config_group) = config_write($config_file, $config);
58848
58849  # Open pipes, for use between the parent and child processes.  Specifically,
58850  # the child will indicate when it's done with its test by writing a message
58851  # to the parent.
58852  my ($rfh, $wfh);
58853  unless (pipe($rfh, $wfh)) {
58854    die("Can't open pipe: $!");
58855  }
58856
58857  require Net::SSH2;
58858
58859  my $ex;
58860
58861  # Ignore SIGPIPE
58862  local $SIG{PIPE} = sub { };
58863
58864  # Fork child
58865  $self->handle_sigchld();
58866  defined(my $pid = fork()) or die("Can't fork: $!");
58867  if ($pid) {
58868    eval {
58869      my $ssh2 = Net::SSH2->new();
58870
58871      sleep(1);
58872
58873      unless ($ssh2->connect('127.0.0.1', $port)) {
58874        my ($err_code, $err_name, $err_str) = $ssh2->error();
58875        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
58876      }
58877
58878      unless ($ssh2->auth_password($user, $passwd)) {
58879        my ($err_code, $err_name, $err_str) = $ssh2->error();
58880        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
58881      }
58882
58883      my $res = $ssh2->scp_put($config_file, 'test.txt');
58884      unless ($res) {
58885        my ($err_code, $err_name, $err_str) = $ssh2->error();
58886        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
58887      }
58888
58889      $ssh2->disconnect();
58890
58891      unless (-f $test_file) {
58892        die("File $test_file file does not exist as expected");
58893      }
58894
58895      my $owning_gid = (stat($test_file))[5];
58896      $self->assert($owner_gid == $owning_gid,
58897        test_msg("Expected $owner_gid, got $owning_gid"));
58898    };
58899
58900    if ($@) {
58901      $ex = $@;
58902    }
58903
58904    $wfh->print("done\n");
58905    $wfh->flush();
58906
58907  } else {
58908    eval { server_wait($config_file, $rfh) };
58909    if ($@) {
58910      warn($@);
58911      exit 1;
58912    }
58913
58914    exit 0;
58915  }
58916
58917  # Stop server
58918  server_stop($pid_file);
58919
58920  $self->assert_child_ok($pid);
58921
58922  if ($ex) {
58923    test_append_logfile($log_file, $ex);
58924    unlink($log_file);
58925
58926    die($ex);
58927  }
58928
58929  unlink($log_file);
58930}
58931
58932sub scp_config_groupowner_file_member_norootprivs {
58933  my $self = shift;
58934  my $tmpdir = $self->{tmpdir};
58935
58936  my ($config_user, $config_group) = config_get_identity();
58937
58938  my $members = [split(' ', (getgrnam($config_group))[3])];
58939  if (scalar(@$members) < 2) {
58940    print STDERR " + unable to run 'scp_config_groupowner_member_norootprivs' test without current user belonging to multiple groups, skipping\n";
58941    return;
58942  }
58943
58944  my ($uid, $gid) = (getpwnam($members->[0]))[2,3];
58945
58946  my $root_login = 'off';
58947  if ($uid == 0) {
58948    $root_login = 'on';
58949  }
58950
58951  my $owner = 'proftpd2';
58952  my $owner_gid = (getpwnam($members->[1]))[3];
58953
58954  my $config_file = "$tmpdir/sftp.conf";
58955  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
58956  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
58957
58958  my $log_file = test_get_logfile();
58959
58960  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
58961  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
58962
58963  my $user = 'proftpd';
58964  my $passwd = 'test';
58965  my $group = 'ftpd';
58966  my $home_dir = File::Spec->rel2abs($tmpdir);
58967
58968  # Make sure that, if we're running as root, that the home directory has
58969  # permissions/privs set for the account we create
58970  if ($< == 0) {
58971    unless (chmod(0755, $home_dir)) {
58972      die("Can't set perms on $home_dir to 0755: $!");
58973    }
58974
58975    unless (chown($uid, $gid, $home_dir)) {
58976      die("Can't set owner of $home_dir to $uid/$gid: $!");
58977    }
58978  }
58979
58980  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
58981    '/bin/bash');
58982  auth_group_write($auth_group_file, $group, $gid, $user);
58983  auth_group_write($auth_group_file, $owner, $owner_gid, 'foo');
58984
58985  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
58986  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
58987
58988  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
58989
58990  my $config = {
58991    PidFile => $pid_file,
58992    ScoreboardFile => $scoreboard_file,
58993    SystemLog => $log_file,
58994    TraceLog => $log_file,
58995    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
58996
58997    AuthUserFile => $auth_user_file,
58998    AuthGroupFile => $auth_group_file,
58999    RootLogin => $root_login,
59000
59001    Directory => {
59002      '~' => {
59003        GroupOwner => $owner,
59004      },
59005    },
59006
59007    IfModules => {
59008      'mod_delay.c' => {
59009        DelayEngine => 'off',
59010      },
59011
59012      'mod_sftp.c' => [
59013        "SFTPEngine on",
59014        "SFTPLog $log_file",
59015        "SFTPHostKey $rsa_host_key",
59016        "SFTPHostKey $dsa_host_key",
59017      ],
59018    },
59019  };
59020
59021  my $port;
59022  ($port, $config_user, $config_group) = config_write($config_file, $config);
59023
59024  # Open pipes, for use between the parent and child processes.  Specifically,
59025  # the child will indicate when it's done with its test by writing a message
59026  # to the parent.
59027  my ($rfh, $wfh);
59028  unless (pipe($rfh, $wfh)) {
59029    die("Can't open pipe: $!");
59030  }
59031
59032  require Net::SSH2;
59033
59034  my $ex;
59035
59036  # Ignore SIGPIPE
59037  local $SIG{PIPE} = sub { };
59038
59039  # Fork child
59040  $self->handle_sigchld();
59041  defined(my $pid = fork()) or die("Can't fork: $!");
59042  if ($pid) {
59043    eval {
59044      my $ssh2 = Net::SSH2->new();
59045
59046      sleep(1);
59047
59048      unless ($ssh2->connect('127.0.0.1', $port)) {
59049        my ($err_code, $err_name, $err_str) = $ssh2->error();
59050        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
59051      }
59052
59053      unless ($ssh2->auth_password($user, $passwd)) {
59054        my ($err_code, $err_name, $err_str) = $ssh2->error();
59055        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
59056      }
59057
59058      my $res = $ssh2->scp_put($config_file, 'test.txt');
59059      unless ($res) {
59060        my ($err_code, $err_name, $err_str) = $ssh2->error();
59061        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
59062      }
59063
59064      $ssh2->disconnect();
59065
59066      unless (-f $test_file) {
59067        die("File $test_file file does not exist as expected");
59068      }
59069
59070      my $owning_gid = (stat($test_file))[5];
59071      $self->assert($owner_gid == $owning_gid,
59072        test_msg("Expected $owner_gid, got $owning_gid"));
59073    };
59074
59075    if ($@) {
59076      $ex = $@;
59077    }
59078
59079    $wfh->print("done\n");
59080    $wfh->flush();
59081
59082  } else {
59083    eval { server_wait($config_file, $rfh) };
59084    if ($@) {
59085      warn($@);
59086      exit 1;
59087    }
59088
59089    exit 0;
59090  }
59091
59092  # Stop server
59093  server_stop($pid_file);
59094
59095  $self->assert_child_ok($pid);
59096
59097  if ($ex) {
59098    test_append_logfile($log_file, $ex);
59099    unlink($log_file);
59100
59101    die($ex);
59102  }
59103
59104  unlink($log_file);
59105}
59106
59107sub scp_log_extlog_var_f_upload {
59108  my $self = shift;
59109  my $tmpdir = $self->{tmpdir};
59110
59111  my $config_file = "$tmpdir/sftp.conf";
59112  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
59113  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
59114  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
59115
59116  my $log_file = test_get_logfile();
59117
59118  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
59119  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
59120
59121  my $user = 'proftpd';
59122  my $passwd = 'test';
59123  my $group = 'ftpd';
59124  my $home_dir = File::Spec->rel2abs($tmpdir);
59125  my $uid = 500;
59126  my $gid = 500;
59127
59128  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
59129  if (open(my $fh, "> $test_file")) {
59130    print $fh "ABCD" x 32;
59131
59132    unless (close($fh)) {
59133      die("Can't write $test_file: $!");
59134    }
59135
59136  } else {
59137    die("Can't open $test_file: $!");
59138  }
59139
59140  my $upload_file = File::Spec->rel2abs("$tmpdir/upload.txt");
59141
59142  # Make sure that, if we're running as root, that the home directory has
59143  # permissions/privs set for the account we create
59144  if ($< == 0) {
59145    unless (chmod(0755, $home_dir)) {
59146      die("Can't set perms on $home_dir to 0755: $!");
59147    }
59148
59149    unless (chown($uid, $gid, $home_dir)) {
59150      die("Can't set owner of $home_dir to $uid/$gid: $!");
59151    }
59152  }
59153
59154  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
59155    '/bin/bash');
59156  auth_group_write($auth_group_file, $group, $gid, $user);
59157
59158  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
59159  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
59160
59161  my $config = {
59162    PidFile => $pid_file,
59163    ScoreboardFile => $scoreboard_file,
59164    SystemLog => $log_file,
59165    TraceLog => $log_file,
59166    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
59167
59168    AuthUserFile => $auth_user_file,
59169    AuthGroupFile => $auth_group_file,
59170
59171    LogFormat => 'transfer "%f %F"',
59172    ExtendedLog => "$extlog_file WRITE transfer",
59173
59174    IfModules => {
59175      'mod_delay.c' => {
59176        DelayEngine => 'off',
59177      },
59178
59179      'mod_sftp.c' => [
59180        "SFTPEngine on",
59181        "SFTPLog $log_file",
59182        "SFTPHostKey $rsa_host_key",
59183        "SFTPHostKey $dsa_host_key",
59184      ],
59185    },
59186  };
59187
59188  my ($port, $config_user, $config_group) = config_write($config_file, $config);
59189
59190  # Open pipes, for use between the parent and child processes.  Specifically,
59191  # the child will indicate when it's done with its test by writing a message
59192  # to the parent.
59193  my ($rfh, $wfh);
59194  unless (pipe($rfh, $wfh)) {
59195    die("Can't open pipe: $!");
59196  }
59197
59198  require Net::SSH2;
59199
59200  my $ex;
59201
59202  # Ignore SIGPIPE
59203  local $SIG{PIPE} = sub { };
59204
59205  # Fork child
59206  $self->handle_sigchld();
59207  defined(my $pid = fork()) or die("Can't fork: $!");
59208  if ($pid) {
59209    eval {
59210      my $ssh2 = Net::SSH2->new();
59211
59212      sleep(1);
59213
59214      unless ($ssh2->connect('127.0.0.1', $port)) {
59215        my ($err_code, $err_name, $err_str) = $ssh2->error();
59216        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
59217      }
59218
59219      unless ($ssh2->auth_password($user, $passwd)) {
59220        my ($err_code, $err_name, $err_str) = $ssh2->error();
59221        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
59222      }
59223
59224      my $res = $ssh2->scp_put($test_file, 'upload.txt');
59225      unless ($res) {
59226        my ($err_code, $err_name, $err_str) = $ssh2->error();
59227        die("Can't upload $test_file to server: [$err_name] ($err_code) $err_str");
59228      }
59229
59230      $ssh2->disconnect();
59231
59232      unless (-f $upload_file) {
59233        die("$upload_file file does not exist as expected");
59234      }
59235    };
59236
59237    if ($@) {
59238      $ex = $@;
59239    }
59240
59241    $wfh->print("done\n");
59242    $wfh->flush();
59243
59244  } else {
59245    eval { server_wait($config_file, $rfh) };
59246    if ($@) {
59247      warn($@);
59248      exit 1;
59249    }
59250
59251    exit 0;
59252  }
59253
59254  # Stop server
59255  server_stop($pid_file);
59256
59257  $self->assert_child_ok($pid);
59258
59259  if ($ex) {
59260    test_append_logfile($log_file, $ex);
59261    unlink($log_file);
59262
59263    die($ex);
59264  }
59265
59266  if (open(my $fh, "< $extlog_file")) {
59267    my $ok = 0;
59268
59269    while (my $line = <$fh>) {
59270      chomp($line);
59271
59272      # Due to the way that Net::SSH2's scp support works, the full path is
59273      # sent to the server.  Note that the OpenSSH command-line scp tool
59274      # does not do this, so the %F value will not always be the full path.
59275      if ($^O eq 'darwin') {
59276        # Mac OSX hack
59277        $upload_file = '/private' . $upload_file;
59278      }
59279
59280      my $expected = "$upload_file $upload_file";
59281      $self->assert($expected eq $line,
59282        test_msg("Expected '$expected', got '$line'"));
59283      $ok = 1;
59284      last;
59285    }
59286
59287    close($fh);
59288
59289    unless ($ok) {
59290      die("No lines found in $extlog_file");
59291    }
59292
59293  } else {
59294    die("Can't read $extlog_file: $!");
59295  }
59296
59297  unlink($log_file);
59298}
59299
59300sub scp_log_extlog_file_modified_bug3457 {
59301  my $self = shift;
59302  my $tmpdir = $self->{tmpdir};
59303
59304  my $config_file = "$tmpdir/sftp.conf";
59305  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
59306  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
59307  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
59308
59309  my $log_file = test_get_logfile();
59310
59311  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
59312  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
59313
59314  my $user = 'proftpd';
59315  my $passwd = 'test';
59316  my $group = 'ftpd';
59317  my $home_dir = File::Spec->rel2abs($tmpdir);
59318  my $uid = 500;
59319  my $gid = 500;
59320
59321  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
59322  if (open(my $fh, "> $src_file")) {
59323    print $fh "ABCD" x 32;
59324
59325    unless (close($fh)) {
59326      die("Can't write $src_file: $!");
59327    }
59328
59329  } else {
59330    die("Can't open $src_file: $!");
59331  }
59332
59333  my $dst_file = File::Spec->rel2abs("$tmpdir/dst.txt");
59334  if (open(my $fh, "> $dst_file")) {
59335    print $fh "Hello, World!\n";
59336    unless (close($fh)) {
59337      die("Can't write $dst_file: $!");
59338    }
59339
59340  } else {
59341    die("Can't open $dst_file: $!");
59342  }
59343
59344  # Make sure that, if we're running as root, that the home directory has
59345  # permissions/privs set for the account we create
59346  if ($< == 0) {
59347    unless (chmod(0755, $home_dir)) {
59348      die("Can't set perms on $home_dir to 0755: $!");
59349    }
59350
59351    unless (chown($uid, $gid, $home_dir)) {
59352      die("Can't set owner of $home_dir to $uid/$gid: $!");
59353    }
59354  }
59355
59356  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
59357    '/bin/bash');
59358  auth_group_write($auth_group_file, $group, $gid, $user);
59359
59360  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
59361  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
59362
59363  my $config = {
59364    PidFile => $pid_file,
59365    ScoreboardFile => $scoreboard_file,
59366    SystemLog => $log_file,
59367    TraceLog => $log_file,
59368    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
59369
59370    AuthUserFile => $auth_user_file,
59371    AuthGroupFile => $auth_group_file,
59372
59373    AllowOverwrite => 'on',
59374    LogFormat => 'custom "%{file-modified}"',
59375    ExtendedLog => "$extlog_file WRITE custom",
59376
59377    IfModules => {
59378      'mod_delay.c' => {
59379        DelayEngine => 'off',
59380      },
59381
59382      'mod_sftp.c' => [
59383        "SFTPEngine on",
59384        "SFTPLog $log_file",
59385        "SFTPHostKey $rsa_host_key",
59386        "SFTPHostKey $dsa_host_key",
59387      ],
59388    },
59389  };
59390
59391  my ($port, $config_user, $config_group) = config_write($config_file, $config);
59392
59393  # Open pipes, for use between the parent and child processes.  Specifically,
59394  # the child will indicate when it's done with its test by writing a message
59395  # to the parent.
59396  my ($rfh, $wfh);
59397  unless (pipe($rfh, $wfh)) {
59398    die("Can't open pipe: $!");
59399  }
59400
59401  require Net::SSH2;
59402
59403  my $ex;
59404
59405  # Ignore SIGPIPE
59406  local $SIG{PIPE} = sub { };
59407
59408  # Fork child
59409  $self->handle_sigchld();
59410  defined(my $pid = fork()) or die("Can't fork: $!");
59411  if ($pid) {
59412    eval {
59413      my $ssh2 = Net::SSH2->new();
59414
59415      sleep(1);
59416
59417      unless ($ssh2->connect('127.0.0.1', $port)) {
59418        my ($err_code, $err_name, $err_str) = $ssh2->error();
59419        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
59420      }
59421
59422      unless ($ssh2->auth_password($user, $passwd)) {
59423        my ($err_code, $err_name, $err_str) = $ssh2->error();
59424        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
59425      }
59426
59427      my $res = $ssh2->scp_put($src_file, 'dst.txt');
59428      unless ($res) {
59429        my ($err_code, $err_name, $err_str) = $ssh2->error();
59430        die("Can't upload $src_file to server: [$err_name] ($err_code) $err_str");
59431      }
59432
59433      $ssh2->disconnect();
59434    };
59435
59436    if ($@) {
59437      $ex = $@;
59438    }
59439
59440    $wfh->print("done\n");
59441    $wfh->flush();
59442
59443  } else {
59444    eval { server_wait($config_file, $rfh) };
59445    if ($@) {
59446      warn($@);
59447      exit 1;
59448    }
59449
59450    exit 0;
59451  }
59452
59453  # Stop server
59454  server_stop($pid_file);
59455
59456  $self->assert_child_ok($pid);
59457
59458  if ($ex) {
59459    test_append_logfile($log_file, $ex);
59460    unlink($log_file);
59461
59462    die($ex);
59463  }
59464
59465  if (open(my $fh, "< $extlog_file")) {
59466    while (my $line = <$fh>) {
59467      chomp($line);
59468
59469      my $expected = 'true';
59470      $self->assert($expected eq $line,
59471        test_msg("Expected '$expected', got '$line'"));
59472    }
59473
59474    close($fh);
59475
59476  } else {
59477    die("Can't read $extlog_file: $!");
59478  }
59479
59480  unlink($log_file);
59481}
59482
59483sub scp_log_extlog_var_file_size_download_issue676 {
59484  my $self = shift;
59485  my $tmpdir = $self->{tmpdir};
59486  my $setup = test_setup($tmpdir, 'sftp');
59487
59488  my $extlog_file = File::Spec->rel2abs("$tmpdir/ext.log");
59489
59490  my $src_file = File::Spec->rel2abs("$tmpdir/src.txt");
59491  if (open(my $fh, "> $src_file")) {
59492    print $fh "ABCD" x 32;
59493
59494    unless (close($fh)) {
59495      die("Can't write $src_file: $!");
59496    }
59497
59498  } else {
59499    die("Can't open $src_file: $!");
59500  }
59501
59502  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
59503  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
59504
59505  my $config = {
59506    PidFile => $setup->{pid_file},
59507    ScoreboardFile => $setup->{scoreboard_file},
59508    SystemLog => $setup->{log_file},
59509    TraceLog => $setup->{log_file},
59510    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
59511
59512    AuthUserFile => $setup->{auth_user_file},
59513    AuthGroupFile => $setup->{auth_group_file},
59514
59515    AllowOverwrite => 'on',
59516    LogFormat => 'custom "%{file-size}"',
59517    ExtendedLog => "$extlog_file READ custom",
59518
59519    IfModules => {
59520      'mod_delay.c' => {
59521        DelayEngine => 'off',
59522      },
59523
59524      'mod_sftp.c' => [
59525        "SFTPEngine on",
59526        "SFTPLog $setup->{log_file}",
59527        "SFTPHostKey $rsa_host_key",
59528        "SFTPHostKey $dsa_host_key",
59529      ],
59530    },
59531  };
59532
59533  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
59534    $config);
59535
59536  # Open pipes, for use between the parent and child processes.  Specifically,
59537  # the child will indicate when it's done with its test by writing a message
59538  # to the parent.
59539  my ($rfh, $wfh);
59540  unless (pipe($rfh, $wfh)) {
59541    die("Can't open pipe: $!");
59542  }
59543
59544  require Net::SSH2;
59545
59546  my $ex;
59547
59548  # Ignore SIGPIPE
59549  local $SIG{PIPE} = sub { };
59550
59551  # Fork child
59552  $self->handle_sigchld();
59553  defined(my $pid = fork()) or die("Can't fork: $!");
59554  if ($pid) {
59555    eval {
59556      my $ssh2 = Net::SSH2->new();
59557      sleep(1);
59558
59559      unless ($ssh2->connect('127.0.0.1', $port)) {
59560        my ($err_code, $err_name, $err_str) = $ssh2->error();
59561        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
59562      }
59563
59564      unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) {
59565        my ($err_code, $err_name, $err_str) = $ssh2->error();
59566        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
59567      }
59568
59569      my $res = $ssh2->scp_get($src_file, '/dev/null');
59570      unless ($res) {
59571        my ($err_code, $err_name, $err_str) = $ssh2->error();
59572        die("Can't download $src_file from server: [$err_name] ($err_code) $err_str");
59573      }
59574
59575      $ssh2->disconnect();
59576    };
59577    if ($@) {
59578      $ex = $@;
59579    }
59580
59581    $wfh->print("done\n");
59582    $wfh->flush();
59583
59584  } else {
59585    eval { server_wait($setup->{config_file}, $rfh) };
59586    if ($@) {
59587      warn($@);
59588      exit 1;
59589    }
59590
59591    exit 0;
59592  }
59593
59594  # Stop server
59595  server_stop($setup->{pid_file});
59596  $self->assert_child_ok($pid);
59597
59598  if ($ex) {
59599    test_cleanup($setup->{log_file}, $ex);
59600  }
59601
59602  eval {
59603    if (open(my $fh, "< $extlog_file")) {
59604      while (my $line = <$fh>) {
59605        chomp($line);
59606
59607        if ($ENV{TEST_VERBOSE}) {
59608          print STDERR "# line: $line\n";
59609        }
59610
59611        my $expected = '\d+';
59612        $self->assert(qr/$expected/, $line,
59613          test_msg("Expected '$expected', got '$line'"));
59614      }
59615
59616      close($fh);
59617
59618    } else {
59619      die("Can't read $extlog_file: $!");
59620    }
59621  };
59622  if ($@) {
59623    $ex = $@;
59624  }
59625
59626  test_cleanup($setup->{log_file}, $ex);
59627}
59628
59629sub scp_log_xferlog_download {
59630  my $self = shift;
59631  my $tmpdir = $self->{tmpdir};
59632
59633  my $config_file = "$tmpdir/sftp.conf";
59634  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
59635  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
59636  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
59637
59638  my $log_file = test_get_logfile();
59639
59640  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
59641  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
59642
59643  my $user = 'proftpd';
59644  my $passwd = 'test';
59645  my $group = 'ftpd';
59646  my $home_dir = File::Spec->rel2abs($tmpdir);
59647  my $uid = 500;
59648  my $gid = 500;
59649
59650  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
59651
59652  # Make sure that, if we're running as root, that the home directory has
59653  # permissions/privs set for the account we create
59654  if ($< == 0) {
59655    unless (chmod(0755, $home_dir)) {
59656      die("Can't set perms on $home_dir to 0755: $!");
59657    }
59658
59659    unless (chown($uid, $gid, $home_dir)) {
59660      die("Can't set owner of $home_dir to $uid/$gid: $!");
59661    }
59662  }
59663
59664  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
59665    '/bin/bash');
59666  auth_group_write($auth_group_file, $group, $gid, $user);
59667
59668  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
59669  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
59670
59671  my $config = {
59672    PidFile => $pid_file,
59673    ScoreboardFile => $scoreboard_file,
59674    SystemLog => $log_file,
59675    TraceLog => $log_file,
59676    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
59677
59678    AuthUserFile => $auth_user_file,
59679    AuthGroupFile => $auth_group_file,
59680
59681    TransferLog => $xferlog_file,
59682
59683    IfModules => {
59684      'mod_delay.c' => {
59685        DelayEngine => 'off',
59686      },
59687
59688      'mod_sftp.c' => [
59689        "SFTPEngine on",
59690        "SFTPLog $log_file",
59691        "SFTPHostKey $rsa_host_key",
59692        "SFTPHostKey $dsa_host_key",
59693      ],
59694    },
59695  };
59696
59697  my ($port, $config_user, $config_group) = config_write($config_file, $config);
59698
59699  my $read_sz = (stat($config_file))[7];
59700
59701  # Open pipes, for use between the parent and child processes.  Specifically,
59702  # the child will indicate when it's done with its test by writing a message
59703  # to the parent.
59704  my ($rfh, $wfh);
59705  unless (pipe($rfh, $wfh)) {
59706    die("Can't open pipe: $!");
59707  }
59708
59709  require Net::SSH2;
59710
59711  my $ex;
59712
59713  # Ignore SIGPIPE
59714  local $SIG{PIPE} = sub { };
59715
59716  # Fork child
59717  $self->handle_sigchld();
59718  defined(my $pid = fork()) or die("Can't fork: $!");
59719  if ($pid) {
59720    eval {
59721      my $ssh2 = Net::SSH2->new();
59722
59723      sleep(1);
59724
59725      unless ($ssh2->connect('127.0.0.1', $port)) {
59726        my ($err_code, $err_name, $err_str) = $ssh2->error();
59727        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
59728      }
59729
59730      unless ($ssh2->auth_password($user, $passwd)) {
59731        my ($err_code, $err_name, $err_str) = $ssh2->error();
59732        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
59733      }
59734
59735      my $res = $ssh2->scp_get('sftp.conf', $test_file);
59736      unless ($res) {
59737        my ($err_code, $err_name, $err_str) = $ssh2->error();
59738        die("Can't download sftp.conf from server: [$err_name] ($err_code) $err_str");
59739      }
59740
59741      $ssh2->disconnect();
59742
59743      unless (-f $test_file) {
59744        die("$test_file file does not exist as expected");
59745      }
59746
59747    };
59748
59749    if ($@) {
59750      $ex = $@;
59751    }
59752
59753    $wfh->print("done\n");
59754    $wfh->flush();
59755
59756  } else {
59757    eval { server_wait($config_file, $rfh) };
59758    if ($@) {
59759      warn($@);
59760      exit 1;
59761    }
59762
59763    exit 0;
59764  }
59765
59766  # Stop server
59767  server_stop($pid_file);
59768
59769  $self->assert_child_ok($pid);
59770
59771  if ($ex) {
59772    test_append_logfile($log_file, $ex);
59773    unlink($log_file);
59774
59775    die($ex);
59776  }
59777
59778  if (open(my $fh, "< $xferlog_file")) {
59779    my $ok = 0;
59780
59781    while (my $line = <$fh>) {
59782      chomp($line);
59783
59784     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
59785        my $client_addr = $3;
59786        my $nbytes = $4;
59787        my $path = $5;
59788        my $xfer_type = $6;
59789        my $action_flag = $7;
59790        my $xfer_direction = $8;
59791        my $access_mode = $9;
59792        my $user_name = $10;
59793        my $service_name = $11;
59794        my $completion_status = $12;
59795
59796        my $expected;
59797
59798        $expected = '127.0.0.1';
59799        $self->assert($expected eq $client_addr,
59800          test_msg("Expected '$expected', got '$client_addr'"));
59801
59802        $expected = $read_sz;
59803        $self->assert($expected == $nbytes,
59804          test_msg("Expected $expected, got $nbytes"));
59805
59806        $expected = File::Spec->rel2abs($config_file);
59807        if ($^O eq 'darwin') {
59808          # Mac OSX hack
59809          $expected = '/private' . $expected;
59810        }
59811
59812        $self->assert($expected eq $path,
59813          test_msg("Expected '$expected', got '$path'"));
59814
59815        $expected = 'b';
59816        $self->assert($expected eq $xfer_type,
59817          test_msg("Expected '$expected', got '$xfer_type'"));
59818
59819        $expected = '_';
59820        $self->assert($expected eq $action_flag,
59821          test_msg("Expected '$expected', got '$action_flag'"));
59822
59823        $expected = 'o';
59824        $self->assert($expected eq $xfer_direction,
59825          test_msg("Expected '$expected', got '$xfer_direction'"));
59826
59827        $expected = 'r';
59828        $self->assert($expected eq $access_mode,
59829          test_msg("Expected '$expected', got '$access_mode'"));
59830
59831        $expected = $user;
59832        $self->assert($expected eq $user_name,
59833          test_msg("Expected '$expected', got '$user_name'"));
59834
59835        $expected = 'scp';
59836        $self->assert($expected eq $service_name,
59837          test_msg("Expected '$expected', got '$service_name'"));
59838
59839        $expected = 'c';
59840        $self->assert($expected eq $completion_status,
59841          test_msg("Expected '$expected', got '$completion_status'"));
59842
59843        $ok = 1;
59844        last;
59845      }
59846    }
59847
59848    close($fh);
59849
59850    unless ($ok) {
59851      die("No lines found in $xferlog_file");
59852    }
59853
59854  } else {
59855    die("Can't read $xferlog_file: $!");
59856  }
59857
59858  unlink($log_file);
59859}
59860
59861sub scp_log_xferlog_upload {
59862  my $self = shift;
59863  my $tmpdir = $self->{tmpdir};
59864
59865  my $config_file = "$tmpdir/sftp.conf";
59866  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
59867  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
59868  my $xferlog_file = File::Spec->rel2abs("$tmpdir/xfer.log");
59869
59870  my $log_file = test_get_logfile();
59871
59872  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
59873  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
59874
59875  my $user = 'proftpd';
59876  my $passwd = 'test';
59877  my $group = 'ftpd';
59878  my $home_dir = File::Spec->rel2abs($tmpdir);
59879  my $uid = 500;
59880  my $gid = 500;
59881
59882  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
59883  if (open(my $fh, "> $test_file")) {
59884    print $fh "ABCD" x 32;
59885
59886    unless (close($fh)) {
59887      die("Can't write $test_file: $!");
59888    }
59889
59890  } else {
59891    die("Can't open $test_file: $!");
59892  }
59893
59894  my $test_sz = (stat($test_file))[7];
59895
59896  my $upload_file = File::Spec->rel2abs("$tmpdir/upload.txt");
59897
59898  # Make sure that, if we're running as root, that the home directory has
59899  # permissions/privs set for the account we create
59900  if ($< == 0) {
59901    unless (chmod(0755, $home_dir)) {
59902      die("Can't set perms on $home_dir to 0755: $!");
59903    }
59904
59905    unless (chown($uid, $gid, $home_dir)) {
59906      die("Can't set owner of $home_dir to $uid/$gid: $!");
59907    }
59908  }
59909
59910  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
59911    '/bin/bash');
59912  auth_group_write($auth_group_file, $group, $gid, $user);
59913
59914  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
59915  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
59916
59917  my $config = {
59918    PidFile => $pid_file,
59919    ScoreboardFile => $scoreboard_file,
59920    SystemLog => $log_file,
59921    TraceLog => $log_file,
59922    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
59923
59924    AuthUserFile => $auth_user_file,
59925    AuthGroupFile => $auth_group_file,
59926
59927    TransferLog => $xferlog_file,
59928
59929    IfModules => {
59930      'mod_delay.c' => {
59931        DelayEngine => 'off',
59932      },
59933
59934      'mod_sftp.c' => [
59935        "SFTPEngine on",
59936        "SFTPLog $log_file",
59937        "SFTPHostKey $rsa_host_key",
59938        "SFTPHostKey $dsa_host_key",
59939      ],
59940    },
59941  };
59942
59943  my ($port, $config_user, $config_group) = config_write($config_file, $config);
59944
59945  # Open pipes, for use between the parent and child processes.  Specifically,
59946  # the child will indicate when it's done with its test by writing a message
59947  # to the parent.
59948  my ($rfh, $wfh);
59949  unless (pipe($rfh, $wfh)) {
59950    die("Can't open pipe: $!");
59951  }
59952
59953  require Net::SSH2;
59954
59955  my $ex;
59956
59957  # Ignore SIGPIPE
59958  local $SIG{PIPE} = sub { };
59959
59960  # Fork child
59961  $self->handle_sigchld();
59962  defined(my $pid = fork()) or die("Can't fork: $!");
59963  if ($pid) {
59964    eval {
59965      my $ssh2 = Net::SSH2->new();
59966
59967      sleep(1);
59968
59969      unless ($ssh2->connect('127.0.0.1', $port)) {
59970        my ($err_code, $err_name, $err_str) = $ssh2->error();
59971        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
59972      }
59973
59974      unless ($ssh2->auth_password($user, $passwd)) {
59975        my ($err_code, $err_name, $err_str) = $ssh2->error();
59976        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
59977      }
59978
59979      my $res = $ssh2->scp_put($test_file, 'upload.txt');
59980      unless ($res) {
59981        my ($err_code, $err_name, $err_str) = $ssh2->error();
59982        die("Can't upload $test_file to server: [$err_name] ($err_code) $err_str");
59983      }
59984
59985      $ssh2->disconnect();
59986
59987      unless (-f $upload_file) {
59988        die("$upload_file file does not exist as expected");
59989      }
59990    };
59991
59992    if ($@) {
59993      $ex = $@;
59994    }
59995
59996    $wfh->print("done\n");
59997    $wfh->flush();
59998
59999  } else {
60000    eval { server_wait($config_file, $rfh) };
60001    if ($@) {
60002      warn($@);
60003      exit 1;
60004    }
60005
60006    exit 0;
60007  }
60008
60009  # Stop server
60010  server_stop($pid_file);
60011
60012  $self->assert_child_ok($pid);
60013
60014  if ($ex) {
60015    test_append_logfile($log_file, $ex);
60016    unlink($log_file);
60017
60018    die($ex);
60019  }
60020
60021  if (open(my $fh, "< $xferlog_file")) {
60022    my $ok = 0;
60023
60024    while (my $line = <$fh>) {
60025      chomp($line);
60026
60027     if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+(.*?)\s+.*?(\S+)$/o) {
60028        my $client_addr = $3;
60029        my $nbytes = $4;
60030        my $path = $5;
60031        my $xfer_type = $6;
60032        my $action_flag = $7;
60033        my $xfer_direction = $8;
60034        my $access_mode = $9;
60035        my $user_name = $10;
60036        my $service_name = $11;
60037        my $completion_status = $12;
60038
60039        my $expected;
60040
60041        $expected = '127.0.0.1';
60042        $self->assert($expected eq $client_addr,
60043          test_msg("Expected '$expected', got '$client_addr'"));
60044
60045        $expected = $test_sz;
60046        $self->assert($expected == $nbytes,
60047          test_msg("Expected $expected, got $nbytes"));
60048
60049        $expected = $upload_file;
60050        if ($^O eq 'darwin') {
60051          # Mac OSX hack
60052          $expected = '/private' . $expected;
60053        }
60054
60055        $self->assert($expected eq $path,
60056          test_msg("Expected '$expected', got '$path'"));
60057
60058        $expected = 'b';
60059        $self->assert($expected eq $xfer_type,
60060          test_msg("Expected '$expected', got '$xfer_type'"));
60061
60062        $expected = '_';
60063        $self->assert($expected eq $action_flag,
60064          test_msg("Expected '$expected', got '$action_flag'"));
60065
60066        $expected = 'i';
60067        $self->assert($expected eq $xfer_direction,
60068          test_msg("Expected '$expected', got '$xfer_direction'"));
60069
60070        $expected = 'r';
60071        $self->assert($expected eq $access_mode,
60072          test_msg("Expected '$expected', got '$access_mode'"));
60073
60074        $expected = $user;
60075        $self->assert($expected eq $user_name,
60076          test_msg("Expected '$expected', got '$user_name'"));
60077
60078        $expected = 'scp';
60079        $self->assert($expected eq $service_name,
60080          test_msg("Expected '$expected', got '$service_name'"));
60081
60082        $expected = 'c';
60083        $self->assert($expected eq $completion_status,
60084          test_msg("Expected '$expected', got '$completion_status'"));
60085
60086        $ok = 1;
60087        last;
60088      }
60089    }
60090
60091    close($fh);
60092
60093    unless ($ok) {
60094      die("No lines found in $xferlog_file");
60095    }
60096
60097  } else {
60098    die("Can't read $xferlog_file: $!");
60099  }
60100
60101  unlink($log_file);
60102}
60103
60104sub sftp_quotatab_upload_bytes_in_exceeded_soft_limit {
60105  my $self = shift;
60106  my $tmpdir = $self->{tmpdir};
60107
60108  my $config_file = "$tmpdir/sftp.conf";
60109  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
60110  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
60111
60112  my $log_file = test_get_logfile();
60113
60114  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
60115  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
60116
60117  my $user = 'proftpd';
60118  my $passwd = 'test';
60119  my $group = 'ftpd';
60120  my $home_dir = File::Spec->rel2abs($tmpdir);
60121  my $uid = 500;
60122  my $gid = 500;
60123
60124  my $db_file = File::Spec->rel2abs("$tmpdir/sftp.db");
60125
60126  # Build up sqlite3 command to create users, groups tables and populate them
60127  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
60128
60129  if (open(my $fh, "> $db_script")) {
60130    print $fh <<EOS;
60131CREATE TABLE quotalimits (
60132  name TEXT NOT NULL,
60133  quota_type TEXT NOT NULL,
60134  per_session TEXT NOT NULL,
60135  limit_type TEXT NOT NULL,
60136  bytes_in_avail REAL NOT NULL,
60137  bytes_out_avail REAL NOT NULL,
60138  bytes_xfer_avail REAL NOT NULL,
60139  files_in_avail INTEGER NOT NULL,
60140  files_out_avail INTEGER NOT NULL,
60141  files_xfer_avail INTEGER NOT NULL
60142);
60143INSERT INTO quotalimits (name, quota_type, per_session, limit_type, bytes_in_avail, bytes_out_avail, bytes_xfer_avail, files_in_avail, files_out_avail, files_xfer_avail) VALUES ('$user', 'user', 'false', 'soft', 5, 0, 0, 3, 0, 0);
60144
60145CREATE TABLE quotatallies (
60146  name TEXT NOT NULL,
60147  quota_type TEXT NOT NULL,
60148  bytes_in_used REAL NOT NULL,
60149  bytes_out_used REAL NOT NULL,
60150  bytes_xfer_used REAL NOT NULL,
60151  files_in_used INTEGER NOT NULL,
60152  files_out_used INTEGER NOT NULL,
60153  files_xfer_used INTEGER NOT NULL
60154);
60155INSERT INTO quotatallies (name, quota_type, bytes_in_used, bytes_out_used, bytes_xfer_used, files_in_used, files_out_used, files_xfer_used) VALUES ('$user', 'user',  32, 0, 0, 2, 0, 0);
60156
60157EOS
60158
60159    unless (close($fh)) {
60160      die("Can't write $db_script: $!");
60161    }
60162
60163  } else {
60164    die("Can't open $db_script: $!");
60165  }
60166
60167  my $cmd = "sqlite3 $db_file < $db_script";
60168
60169  if ($ENV{TEST_VERBOSE}) {
60170    print STDERR "Executing sqlite3: $cmd\n";
60171  }
60172
60173  my @output = `$cmd`;
60174  if (scalar(@output) &&
60175      $ENV{TEST_VERBOSE}) {
60176    print STDERR "Output: ", join('', @output), "\n";
60177  }
60178
60179  my $test_file = 'test.txt';
60180  my $test_path = File::Spec->rel2abs("$tmpdir/$test_file");
60181
60182  if (open(my $fh, "> $test_path")) {
60183    print $fh "Hello, World!\n";
60184
60185    unless (close($fh)) {
60186      die("Can't write $test_path: $!");
60187    }
60188
60189  } else {
60190    die("Can't open $test_path: $!");
60191  }
60192
60193  # Make sure that, if we're running as root, that the home directory has
60194  # permissions/privs set for the account we create
60195  if ($< == 0) {
60196    unless (chmod(0755, $home_dir)) {
60197      die("Can't set perms on $home_dir to 0755: $!");
60198    }
60199
60200    unless (chown($uid, $gid, $home_dir)) {
60201      die("Can't set owner of $home_dir to $uid/$gid: $!");
60202    }
60203  }
60204
60205  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
60206    '/bin/bash');
60207  auth_group_write($auth_group_file, $group, $gid, $user);
60208
60209  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
60210  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
60211
60212  my $config = {
60213    PidFile => $pid_file,
60214    ScoreboardFile => $scoreboard_file,
60215    SystemLog => $log_file,
60216    TraceLog => $log_file,
60217    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
60218
60219    AllowOverwrite => 'on',
60220    AllowStoreRestart => 'on',
60221    AuthUserFile => $auth_user_file,
60222    AuthGroupFile => $auth_group_file,
60223
60224    IfModules => {
60225      'mod_delay.c' => {
60226        DelayEngine => 'off',
60227      },
60228
60229      'mod_quotatab_sql.c' => [
60230        'SQLNamedQuery get-quota-limit SELECT "name, quota_type, per_session, limit_type, bytes_in_avail, bytes_out_avail, bytes_xfer_avail, files_in_avail, files_out_avail, files_xfer_avail FROM quotalimits WHERE name = \'%{0}\' AND quota_type = \'%{1}\'"',
60231        'SQLNamedQuery get-quota-tally SELECT "name, quota_type, bytes_in_used, bytes_out_used, bytes_xfer_used, files_in_used, files_out_used, files_xfer_used FROM quotatallies WHERE name = \'%{0}\' AND quota_type = \'%{1}\'"',
60232        'SQLNamedQuery update-quota-tally UPDATE "bytes_in_used = bytes_in_used + %{0}, bytes_out_used = bytes_out_used + %{1}, bytes_xfer_used = bytes_xfer_used + %{2}, files_in_used = files_in_used + %{3}, files_out_used = files_out_used + %{4}, files_xfer_used = files_xfer_used + %{5} WHERE name = \'%{6}\' AND quota_type = \'%{7}\'" quotatallies',
60233        'SQLNamedQuery insert-quota-tally INSERT "%{0}, %{1}, %{2}, %{3}, %{4}, %{5}, %{6}, %{7}" quotatallies',
60234        'QuotaEngine on',
60235        "QuotaLog $log_file",
60236        'QuotaLimitTable sql:/get-quota-limit',
60237        'QuotaTallyTable sql:/get-quota-tally/update-quota-tally/insert-quota-tally',
60238      ],
60239
60240      'mod_sftp.c' => [
60241        "SFTPEngine on",
60242        "SFTPLog $log_file",
60243        "SFTPHostKey $rsa_host_key",
60244        "SFTPHostKey $dsa_host_key",
60245      ],
60246
60247      'mod_sql.c' => {
60248        SQLEngine => 'log',
60249        SQLBackend => 'sqlite3',
60250        SQLConnectInfo => $db_file,
60251        SQLLogFile => $log_file,
60252      },
60253    },
60254  };
60255
60256  my ($port, $config_user, $config_group) = config_write($config_file, $config);
60257
60258  # Open pipes, for use between the parent and child processes.  Specifically,
60259  # the child will indicate when it's done with its test by writing a message
60260  # to the parent.
60261  my ($rfh, $wfh);
60262  unless (pipe($rfh, $wfh)) {
60263    die("Can't open pipe: $!");
60264  }
60265
60266  require Net::SSH2;
60267
60268  my $ex;
60269
60270  # Fork child
60271  $self->handle_sigchld();
60272  defined(my $pid = fork()) or die("Can't fork: $!");
60273  if ($pid) {
60274    eval {
60275      my $ssh2 = Net::SSH2->new();
60276
60277      sleep(1);
60278
60279      unless ($ssh2->connect('127.0.0.1', $port)) {
60280        my ($err_code, $err_name, $err_str) = $ssh2->error();
60281        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
60282      }
60283
60284      unless ($ssh2->auth_password($user, $passwd)) {
60285        my ($err_code, $err_name, $err_str) = $ssh2->error();
60286        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
60287      }
60288
60289      my $sftp = $ssh2->sftp();
60290      unless ($sftp) {
60291        my ($err_code, $err_name, $err_str) = $ssh2->error();
60292        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
60293      }
60294
60295      my $fh = $sftp->open('test.txt', O_WRONLY, 0644);
60296      if ($fh) {
60297        die("OPEN test.txt succeeded unexpectedly");
60298      }
60299
60300      my ($err_code, $err_name) = $sftp->error();
60301
60302      my $expected = 'SSH_FX_FAILURE';
60303      $self->assert($expected eq $err_name,
60304        test_msg("Expected '$expected', got '$err_name'"));
60305
60306      $expected = 4;
60307      $self->assert($expected == $err_code,
60308        test_msg("Expected $expected, got $err_code"));
60309
60310      $sftp = undef;
60311      $ssh2->disconnect();
60312    };
60313
60314    if ($@) {
60315      $ex = $@;
60316    }
60317
60318    $wfh->print("done\n");
60319    $wfh->flush();
60320
60321  } else {
60322    eval { server_wait($config_file, $rfh) };
60323    if ($@) {
60324      warn($@);
60325      exit 1;
60326    }
60327
60328    exit 0;
60329  }
60330
60331  # Stop server
60332  server_stop($pid_file);
60333
60334  $self->assert_child_ok($pid);
60335
60336  if ($ex) {
60337    test_append_logfile($log_file, $ex);
60338    unlink($log_file);
60339
60340    die($ex);
60341  }
60342
60343  unlink($log_file);
60344}
60345
60346sub sftp_sql_custom_user_info {
60347  my $self = shift;
60348  my $tmpdir = $self->{tmpdir};
60349
60350  my $config_file = "$tmpdir/sftp.conf";
60351  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
60352  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
60353
60354  my $log_file = test_get_logfile();
60355
60356  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
60357  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
60358
60359  my $user = 'proftpd';
60360  my $passwd = 'test';
60361  my $group = 'ftpd';
60362  my $home_dir = File::Spec->rel2abs($tmpdir);
60363  my $uid = 500;
60364  my $gid = 500;
60365
60366  # Make sure that, if we're running as root, that the home directory has
60367  # permissions/privs set for the account we create
60368  if ($< == 0) {
60369    unless (chmod(0755, $home_dir)) {
60370      die("Can't set perms on $home_dir to 0755: $!");
60371    }
60372
60373    unless (chown($uid, $gid, $home_dir)) {
60374      die("Can't set owner of $home_dir to $uid/$gid: $!");
60375    }
60376  }
60377
60378  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
60379
60380  # Build up sqlite3 command to create users, groups tables and populate them
60381  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
60382
60383  if (open(my $fh, "> $db_script")) {
60384    print $fh <<EOS;
60385CREATE TABLE ftpusers (
60386  userid TEXT,
60387  passwd TEXT,
60388  uid INTEGER,
60389  gid INTEGER,
60390  homedir TEXT,
60391  shell TEXT,
60392  lastdir TEXT
60393);
60394INSERT INTO ftpusers (userid, passwd, uid, gid, homedir, shell) VALUES ('$user', '$passwd', $uid, $gid, '$home_dir', '/bin/bash');
60395
60396CREATE TABLE groups (
60397  groupname TEXT,
60398  gid INTEGER,
60399  members TEXT
60400);
60401INSERT INTO groups (groupname, gid, members) VALUES ('$group', $gid, '$user');
60402EOS
60403
60404    unless (close($fh)) {
60405      die("Can't write $db_script: $!");
60406    }
60407
60408  } else {
60409    die("Can't open $db_script: $!");
60410  }
60411
60412  my $cmd = "sqlite3 $db_file < $db_script";
60413
60414  if ($ENV{TEST_VERBOSE}) {
60415    print STDERR "Executing sqlite3: $cmd\n";
60416  }
60417
60418  my @output = `$cmd`;
60419  if (scalar(@output) &&
60420      $ENV{TEST_VERBOSE}) {
60421    print STDERR "Output: ", join('', @output), "\n";
60422  }
60423
60424  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
60425  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
60426
60427  $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
60428
60429  # Build up sqlite3 command to create users, groups tables and populate them
60430  $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
60431
60432  if (open(my $fh, "> $db_script")) {
60433    print $fh <<EOS;
60434CREATE TABLE sftplog (
60435  user TEXT NOT NULL,
60436  operation TEXT NOT NULL,
60437  filename TEXT NOT NULL,
60438  full_path TEXT NOT NULL,
60439  filesize INTEGER NOT NULL,
60440  xfertime INTEGER NOT NULL
60441);
60442EOS
60443
60444    unless (close($fh)) {
60445      die("Can't write $db_script: $!");
60446    }
60447
60448  } else {
60449    die("Can't open $db_script: $!");
60450  }
60451
60452  $cmd = "sqlite3 $db_file < $db_script";
60453
60454  if ($ENV{TEST_VERBOSE}) {
60455    print STDERR "Executing sqlite3: $cmd\n";
60456  }
60457
60458  @output = `$cmd`;
60459  if (scalar(@output) > 0 &&
60460      $ENV{TEST_VERBOSE}) {
60461    print STDERR "Output: ", join('', @output), "\n";
60462  }
60463
60464  my $config = {
60465    PidFile => $pid_file,
60466    ScoreboardFile => $scoreboard_file,
60467    SystemLog => $log_file,
60468    TraceLog => $log_file,
60469    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
60470
60471    AuthUserFile => $auth_user_file,
60472    AuthGroupFile => $auth_group_file,
60473
60474    IfModules => {
60475      'mod_delay.c' => {
60476        DelayEngine => 'off',
60477      },
60478
60479      'mod_sftp.c' => [
60480        "SFTPEngine on",
60481        "SFTPLog $log_file",
60482        "SFTPHostKey $rsa_host_key",
60483        "SFTPHostKey $dsa_host_key",
60484      ],
60485
60486      'mod_sql.c' => {
60487        SQLAuthTypes => 'plaintext',
60488        SQLEngine => 'on',
60489        SQLBackend => 'sqlite3',
60490        SQLConnectInfo => $db_file,
60491        SQLLogFile => $log_file,
60492
60493        SQLNamedQuery => 'get-sql-user SELECT "userid, passwd, uid, gid, homedir, shell FROM ftpusers WHERE userid = \'%U\'"',
60494        SQLUserInfo => 'custom:/get-sql-user',
60495      },
60496    },
60497  };
60498
60499  my ($port, $config_user, $config_group) = config_write($config_file, $config);
60500
60501  my $config_size = (stat($config_file))[7];
60502
60503  # Open pipes, for use between the parent and child processes.  Specifically,
60504  # the child will indicate when it's done with its test by writing a message
60505  # to the parent.
60506  my ($rfh, $wfh);
60507  unless (pipe($rfh, $wfh)) {
60508    die("Can't open pipe: $!");
60509  }
60510
60511  require Net::SSH2;
60512
60513  my $ex;
60514
60515  # Ignore SIGPIPE
60516  local $SIG{PIPE} = sub { };
60517
60518  # Fork child
60519  $self->handle_sigchld();
60520  defined(my $pid = fork()) or die("Can't fork: $!");
60521  if ($pid) {
60522    eval {
60523      my $ssh2 = Net::SSH2->new();
60524
60525      sleep(1);
60526
60527      unless ($ssh2->connect('127.0.0.1', $port)) {
60528        my ($err_code, $err_name, $err_str) = $ssh2->error();
60529        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
60530      }
60531
60532      unless ($ssh2->auth_password($user, $passwd)) {
60533        my ($err_code, $err_name, $err_str) = $ssh2->error();
60534        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
60535      }
60536
60537      my $sftp = $ssh2->sftp();
60538      unless ($sftp) {
60539        my ($err_code, $err_name, $err_str) = $ssh2->error();
60540        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
60541      }
60542
60543      my $fh = $sftp->open('sftp.conf', O_RDONLY, 0644);
60544      unless ($fh) {
60545        my ($err_code, $err_name) = $sftp->error();
60546        die("Can't open sftp.conf: [$err_name] ($err_code)");
60547      }
60548
60549      my $buf;
60550      my $size = 0;
60551
60552      my $res = $fh->read($buf, 8192);
60553
60554      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
60555      $fh = undef;
60556
60557      # To close the SFTP channel, we have to explicitly destroy the object
60558      $sftp = undef;
60559
60560      $ssh2->disconnect();
60561    };
60562
60563    if ($@) {
60564      $ex = $@;
60565    }
60566
60567    $wfh->print("done\n");
60568    $wfh->flush();
60569
60570  } else {
60571    eval { server_wait($config_file, $rfh) };
60572    if ($@) {
60573      warn($@);
60574      exit 1;
60575    }
60576
60577    exit 0;
60578  }
60579
60580  # Stop server
60581  server_stop($pid_file);
60582
60583  $self->assert_child_ok($pid);
60584
60585  if ($ex) {
60586    test_append_logfile($log_file, $ex);
60587    unlink($log_file);
60588
60589    die($ex);
60590  }
60591
60592  unlink($log_file);
60593}
60594
60595sub sftp_sql_log_retr_vars {
60596  my $self = shift;
60597  my $tmpdir = $self->{tmpdir};
60598
60599  my $config_file = "$tmpdir/sftp.conf";
60600  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
60601  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
60602
60603  my $log_file = test_get_logfile();
60604
60605  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
60606  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
60607
60608  my $user = 'proftpd';
60609  my $passwd = 'test';
60610  my $group = 'ftpd';
60611  my $home_dir = File::Spec->rel2abs($tmpdir);
60612  my $uid = 500;
60613  my $gid = 500;
60614
60615  # Make sure that, if we're running as root, that the home directory has
60616  # permissions/privs set for the account we create
60617  if ($< == 0) {
60618    unless (chmod(0755, $home_dir)) {
60619      die("Can't set perms on $home_dir to 0755: $!");
60620    }
60621
60622    unless (chown($uid, $gid, $home_dir)) {
60623      die("Can't set owner of $home_dir to $uid/$gid: $!");
60624    }
60625  }
60626
60627  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
60628    '/bin/bash');
60629  auth_group_write($auth_group_file, $group, $gid, $user);
60630
60631  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
60632  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
60633
60634  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
60635
60636  # Build up sqlite3 command to create users, groups tables and populate them
60637  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
60638
60639  if (open(my $fh, "> $db_script")) {
60640    print $fh <<EOS;
60641CREATE TABLE sftplog (
60642  user TEXT NOT NULL,
60643  operation TEXT NOT NULL,
60644  filename TEXT NOT NULL,
60645  full_path TEXT NOT NULL,
60646  filesize INTEGER NOT NULL,
60647  xfertime INTEGER NOT NULL
60648);
60649EOS
60650
60651    unless (close($fh)) {
60652      die("Can't write $db_script: $!");
60653    }
60654
60655  } else {
60656    die("Can't open $db_script: $!");
60657  }
60658
60659  my $cmd = "sqlite3 $db_file < $db_script";
60660
60661  if ($ENV{TEST_VERBOSE}) {
60662    print STDERR "Executing sqlite3: $cmd\n";
60663  }
60664
60665  my @output = `$cmd`;
60666  if (scalar(@output) > 0 &&
60667      $ENV{TEST_VERBOSE}) {
60668    print STDERR "Output: ", join('', @output), "\n";
60669  }
60670
60671  my $config = {
60672    PidFile => $pid_file,
60673    ScoreboardFile => $scoreboard_file,
60674    SystemLog => $log_file,
60675    TraceLog => $log_file,
60676    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
60677
60678    AuthUserFile => $auth_user_file,
60679    AuthGroupFile => $auth_group_file,
60680
60681    IfModules => {
60682      'mod_delay.c' => {
60683        DelayEngine => 'off',
60684      },
60685
60686      'mod_sftp.c' => [
60687        "SFTPEngine on",
60688        "SFTPLog $log_file",
60689        "SFTPHostKey $rsa_host_key",
60690        "SFTPHostKey $dsa_host_key",
60691      ],
60692
60693      'mod_sql.c' => {
60694        SQLEngine => 'log',
60695        SQLBackend => 'sqlite3',
60696        SQLConnectInfo => $db_file,
60697        SQLLogFile => $log_file,
60698
60699        SQLNamedQuery => 'log-download FREEFORM "INSERT INTO sftplog (user, operation, filename, full_path, filesize, xfertime) VALUES (\'%u\', \'%m\', \'%F\', \'%f\', %b, %T)"',
60700        SQLLog => 'RETR log-download',
60701      },
60702    },
60703  };
60704
60705  my ($port, $config_user, $config_group) = config_write($config_file, $config);
60706
60707  my $config_size = (stat($config_file))[7];
60708
60709  # Open pipes, for use between the parent and child processes.  Specifically,
60710  # the child will indicate when it's done with its test by writing a message
60711  # to the parent.
60712  my ($rfh, $wfh);
60713  unless (pipe($rfh, $wfh)) {
60714    die("Can't open pipe: $!");
60715  }
60716
60717  require Net::SSH2;
60718
60719  my $ex;
60720
60721  # Ignore SIGPIPE
60722  local $SIG{PIPE} = sub { };
60723
60724  # Fork child
60725  $self->handle_sigchld();
60726  defined(my $pid = fork()) or die("Can't fork: $!");
60727  if ($pid) {
60728    eval {
60729      my $ssh2 = Net::SSH2->new();
60730
60731      sleep(1);
60732
60733      unless ($ssh2->connect('127.0.0.1', $port)) {
60734        my ($err_code, $err_name, $err_str) = $ssh2->error();
60735        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
60736      }
60737
60738      unless ($ssh2->auth_password($user, $passwd)) {
60739        my ($err_code, $err_name, $err_str) = $ssh2->error();
60740        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
60741      }
60742
60743      my $sftp = $ssh2->sftp();
60744      unless ($sftp) {
60745        my ($err_code, $err_name, $err_str) = $ssh2->error();
60746        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
60747      }
60748
60749      my $fh = $sftp->open('sftp.conf', O_RDONLY, 0644);
60750      unless ($fh) {
60751        my ($err_code, $err_name) = $sftp->error();
60752        die("Can't open sftp.conf: [$err_name] ($err_code)");
60753      }
60754
60755      my $buf;
60756      my $size = 0;
60757
60758      my $res = $fh->read($buf, 8192);
60759
60760      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
60761      $fh = undef;
60762
60763      # To close the SFTP channel, we have to explicitly destroy the object
60764      $sftp = undef;
60765
60766      $ssh2->disconnect();
60767    };
60768
60769    if ($@) {
60770      $ex = $@;
60771    }
60772
60773    $wfh->print("done\n");
60774    $wfh->flush();
60775
60776  } else {
60777    eval { server_wait($config_file, $rfh) };
60778    if ($@) {
60779      warn($@);
60780      exit 1;
60781    }
60782
60783    exit 0;
60784  }
60785
60786  # Stop server
60787  server_stop($pid_file);
60788
60789  $self->assert_child_ok($pid);
60790
60791  if ($ex) {
60792    test_append_logfile($log_file, $ex);
60793    unlink($log_file);
60794
60795    die($ex);
60796  }
60797
60798  my ($logged_user, $filename, $full_path, $filesize, $xfertime);
60799  ($logged_user, $cmd, $filename, $full_path, $filesize, $xfertime) = get_sftplog($db_file);
60800  my $expected;
60801
60802  $expected = 'RETR';
60803  $self->assert($expected eq $cmd,
60804    test_msg("Expected '$expected', got '$cmd'"));
60805
60806  $expected = 'sftp.conf';
60807  $self->assert($expected eq $filename,
60808    test_msg("Expected '$expected', got '$filename'"));
60809
60810  $expected = File::Spec->rel2abs($config_file);
60811  $self->assert($expected eq $full_path,
60812    test_msg("Expected '$expected', got '$full_path'"));
60813
60814  $expected = $config_size;
60815  $self->assert($expected == $filesize,
60816    test_msg("Expected $expected, got $filesize"));
60817
60818  unlink($log_file);
60819}
60820
60821sub sftp_sql_log_stor_vars {
60822  my $self = shift;
60823  my $tmpdir = $self->{tmpdir};
60824
60825  my $config_file = "$tmpdir/sftp.conf";
60826  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
60827  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
60828
60829  my $log_file = test_get_logfile();
60830
60831  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
60832  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
60833
60834  my $user = 'proftpd';
60835  my $passwd = 'test';
60836  my $group = 'ftpd';
60837  my $home_dir = File::Spec->rel2abs($tmpdir);
60838  my $uid = 500;
60839  my $gid = 500;
60840
60841  # Make sure that, if we're running as root, that the home directory has
60842  # permissions/privs set for the account we create
60843  if ($< == 0) {
60844    unless (chmod(0755, $home_dir)) {
60845      die("Can't set perms on $home_dir to 0755: $!");
60846    }
60847
60848    unless (chown($uid, $gid, $home_dir)) {
60849      die("Can't set owner of $home_dir to $uid/$gid: $!");
60850    }
60851  }
60852
60853  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
60854    '/bin/bash');
60855  auth_group_write($auth_group_file, $group, $gid, $user);
60856
60857  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
60858  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
60859
60860  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
60861
60862  # Build up sqlite3 command to create users, groups tables and populate them
60863  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
60864
60865  if (open(my $fh, "> $db_script")) {
60866    print $fh <<EOS;
60867CREATE TABLE sftplog (
60868  user TEXT NOT NULL,
60869  operation TEXT NOT NULL,
60870  filename TEXT NOT NULL,
60871  full_path TEXT NOT NULL,
60872  filesize INTEGER NOT NULL,
60873  xfertime INTEGER NOT NULL
60874);
60875EOS
60876
60877    unless (close($fh)) {
60878      die("Can't write $db_script: $!");
60879    }
60880
60881  } else {
60882    die("Can't open $db_script: $!");
60883  }
60884
60885  my $cmd = "sqlite3 $db_file < $db_script";
60886
60887  if ($ENV{TEST_VERBOSE}) {
60888    print STDERR "Executing sqlite3: $cmd\n";
60889  }
60890
60891  my @output = `$cmd`;
60892  if (scalar(@output) > 0 &&
60893      $ENV{TEST_VERBOSE}) {
60894    print STDERR "Output: ", join('', @output), "\n";
60895  }
60896
60897  my $config = {
60898    PidFile => $pid_file,
60899    ScoreboardFile => $scoreboard_file,
60900    SystemLog => $log_file,
60901    TraceLog => $log_file,
60902    Trace => 'DEFAULT:10 ssh2:20 sftp:20 signal:0 event:0 lock:0',
60903
60904    AuthUserFile => $auth_user_file,
60905    AuthGroupFile => $auth_group_file,
60906
60907    IfModules => {
60908      'mod_delay.c' => {
60909        DelayEngine => 'off',
60910      },
60911
60912      'mod_sftp.c' => [
60913        "SFTPEngine on",
60914        "SFTPLog $log_file",
60915        "SFTPHostKey $rsa_host_key",
60916        "SFTPHostKey $dsa_host_key",
60917      ],
60918
60919      'mod_sql.c' => {
60920        SQLEngine => 'log',
60921        SQLBackend => 'sqlite3',
60922        SQLConnectInfo => $db_file,
60923        SQLLogFile => $log_file,
60924
60925        SQLNamedQuery => 'log-upload FREEFORM "INSERT INTO sftplog (user, operation, filename, full_path, filesize, xfertime) VALUES (\'%u\', \'%m\', \'%F\', \'%f\', %b, %T)"',
60926        SQLLog => 'STOR log-upload',
60927      },
60928    },
60929  };
60930
60931  my ($port, $config_user, $config_group) = config_write($config_file, $config);
60932
60933  # Open pipes, for use between the parent and child processes.  Specifically,
60934  # the child will indicate when it's done with its test by writing a message
60935  # to the parent.
60936  my ($rfh, $wfh);
60937  unless (pipe($rfh, $wfh)) {
60938    die("Can't open pipe: $!");
60939  }
60940
60941  require Net::SSH2;
60942
60943  my $ex;
60944
60945  # Ignore SIGPIPE
60946  local $SIG{PIPE} = sub { };
60947
60948  # Fork child
60949  $self->handle_sigchld();
60950  defined(my $pid = fork()) or die("Can't fork: $!");
60951  if ($pid) {
60952    eval {
60953      my $ssh2 = Net::SSH2->new();
60954
60955      sleep(1);
60956
60957      unless ($ssh2->connect('127.0.0.1', $port)) {
60958        my ($err_code, $err_name, $err_str) = $ssh2->error();
60959        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
60960      }
60961
60962      unless ($ssh2->auth_password($user, $passwd)) {
60963        my ($err_code, $err_name, $err_str) = $ssh2->error();
60964        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
60965      }
60966
60967      my $sftp = $ssh2->sftp();
60968      unless ($sftp) {
60969        my ($err_code, $err_name, $err_str) = $ssh2->error();
60970        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
60971      }
60972
60973      my $fh = $sftp->open('test.txt', O_WRONLY|O_CREAT, 0644);
60974      unless ($fh) {
60975        my ($err_code, $err_name) = $sftp->error();
60976        die("Can't open test.txt: [$err_name] ($err_code)");
60977      }
60978
60979      # Note: there's a limit on the size of SSH packets, and thus an
60980      # SFTP WRITE request with data will not necessarily be as large as the
60981      # Perl code would have one expect.  And Net::SSH2 does not do a great
60982      # job of handling such cases.  So we break it down into individual
60983      # writes.  C'est la vie.
60984      for (my $i = 0; $i < 4; $i++) {
60985        print $fh "ABCD" x 2048;
60986      }
60987
60988      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
60989      $fh = undef;
60990
60991      # To close the SFTP channel, we have to explicitly destroy the object
60992      $sftp = undef;
60993
60994      $ssh2->disconnect();
60995    };
60996
60997    if ($@) {
60998      $ex = $@;
60999    }
61000
61001    $wfh->print("done\n");
61002    $wfh->flush();
61003
61004  } else {
61005    eval { server_wait($config_file, $rfh) };
61006    if ($@) {
61007      warn($@);
61008      exit 1;
61009    }
61010
61011    exit 0;
61012  }
61013
61014  # Stop server
61015  server_stop($pid_file);
61016
61017  $self->assert_child_ok($pid);
61018
61019  if ($ex) {
61020    test_append_logfile($log_file, $ex);
61021    unlink($log_file);
61022
61023    die($ex);
61024  }
61025
61026  my ($logged_user, $filename, $full_path, $filesize, $xfertime);
61027  ($logged_user, $cmd, $filename, $full_path, $filesize, $xfertime) = get_sftplog($db_file);
61028  my $expected;
61029
61030  $expected = 'STOR';
61031  $self->assert($expected eq $cmd,
61032    test_msg("Expected '$expected', got '$cmd'"));
61033
61034  $expected = 'test.txt';
61035  $self->assert($expected eq $filename,
61036    test_msg("Expected '$expected', got '$filename'"));
61037
61038  $expected = File::Spec->rel2abs("$tmpdir/test.txt");
61039  $self->assert($expected eq $full_path,
61040    test_msg("Expected '$expected', got '$full_path'"));
61041
61042  $expected = 32768;
61043  $self->assert($expected == $filesize,
61044    test_msg("Expected $expected, got $filesize"));
61045
61046  unlink($log_file);
61047}
61048
61049sub sftp_sql_log_appe_vars {
61050  my $self = shift;
61051  my $tmpdir = $self->{tmpdir};
61052
61053  my $config_file = "$tmpdir/sftp.conf";
61054  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
61055  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
61056
61057  my $log_file = test_get_logfile();
61058
61059  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
61060  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
61061
61062  my $user = 'proftpd';
61063  my $passwd = 'test';
61064  my $group = 'ftpd';
61065  my $home_dir = File::Spec->rel2abs($tmpdir);
61066  my $uid = 500;
61067  my $gid = 500;
61068
61069  # Make sure that, if we're running as root, that the home directory has
61070  # permissions/privs set for the account we create
61071  if ($< == 0) {
61072    unless (chmod(0755, $home_dir)) {
61073      die("Can't set perms on $home_dir to 0755: $!");
61074    }
61075
61076    unless (chown($uid, $gid, $home_dir)) {
61077      die("Can't set owner of $home_dir to $uid/$gid: $!");
61078    }
61079  }
61080
61081  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
61082    '/bin/bash');
61083  auth_group_write($auth_group_file, $group, $gid, $user);
61084
61085  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
61086  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
61087
61088  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
61089
61090  # Build up sqlite3 command to create users, groups tables and populate them
61091  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
61092
61093  if (open(my $fh, "> $db_script")) {
61094    print $fh <<EOS;
61095CREATE TABLE sftplog (
61096  user TEXT NOT NULL,
61097  operation TEXT NOT NULL,
61098  filename TEXT NOT NULL,
61099  full_path TEXT NOT NULL,
61100  filesize INTEGER NOT NULL,
61101  xfertime INTEGER NOT NULL
61102);
61103EOS
61104
61105    unless (close($fh)) {
61106      die("Can't write $db_script: $!");
61107    }
61108
61109  } else {
61110    die("Can't open $db_script: $!");
61111  }
61112
61113  my $cmd = "sqlite3 $db_file < $db_script";
61114
61115  if ($ENV{TEST_VERBOSE}) {
61116    print STDERR "Executing sqlite3: $cmd\n";
61117  }
61118
61119  my @output = `$cmd`;
61120  if (scalar(@output) > 0 &&
61121      $ENV{TEST_VERBOSE}) {
61122    print STDERR "Output: ", join('', @output), "\n";
61123  }
61124
61125  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
61126  if (open(my $fh, "> $test_file")) {
61127    close($fh);
61128
61129  } else {
61130    die("Can't open $test_file: $!");
61131  }
61132
61133  my $config = {
61134    PidFile => $pid_file,
61135    ScoreboardFile => $scoreboard_file,
61136    SystemLog => $log_file,
61137    TraceLog => $log_file,
61138    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
61139
61140    AuthUserFile => $auth_user_file,
61141    AuthGroupFile => $auth_group_file,
61142
61143    AllowOverwrite => 'on',
61144    AllowStoreRestart => 'on',
61145
61146    IfModules => {
61147      'mod_delay.c' => {
61148        DelayEngine => 'off',
61149      },
61150
61151      'mod_sftp.c' => [
61152        "SFTPEngine on",
61153        "SFTPLog $log_file",
61154        "SFTPHostKey $rsa_host_key",
61155        "SFTPHostKey $dsa_host_key",
61156      ],
61157
61158      'mod_sql.c' => {
61159        SQLEngine => 'log',
61160        SQLBackend => 'sqlite3',
61161        SQLConnectInfo => $db_file,
61162        SQLLogFile => $log_file,
61163
61164        SQLNamedQuery => 'log-appe FREEFORM "INSERT INTO sftplog (user, operation, filename, full_path, filesize, xfertime) VALUES (\'%u\', \'%m\', \'%F\', \'%f\', %b, %T)"',
61165        SQLLog => 'APPE log-appe',
61166      },
61167    },
61168  };
61169
61170  my ($port, $config_user, $config_group) = config_write($config_file, $config);
61171
61172  # Open pipes, for use between the parent and child processes.  Specifically,
61173  # the child will indicate when it's done with its test by writing a message
61174  # to the parent.
61175  my ($rfh, $wfh);
61176  unless (pipe($rfh, $wfh)) {
61177    die("Can't open pipe: $!");
61178  }
61179
61180  require Net::SSH2;
61181
61182  my $ex;
61183
61184  # Ignore SIGPIPE
61185  local $SIG{PIPE} = sub { };
61186
61187  # Fork child
61188  $self->handle_sigchld();
61189  defined(my $pid = fork()) or die("Can't fork: $!");
61190  if ($pid) {
61191    eval {
61192      my $ssh2 = Net::SSH2->new();
61193
61194      sleep(1);
61195
61196      unless ($ssh2->connect('127.0.0.1', $port)) {
61197        my ($err_code, $err_name, $err_str) = $ssh2->error();
61198        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
61199      }
61200
61201      unless ($ssh2->auth_password($user, $passwd)) {
61202        my ($err_code, $err_name, $err_str) = $ssh2->error();
61203        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
61204      }
61205
61206      my $sftp = $ssh2->sftp();
61207      unless ($sftp) {
61208        my ($err_code, $err_name, $err_str) = $ssh2->error();
61209        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
61210      }
61211
61212      my $fh = $sftp->open('test.txt', O_WRONLY|O_APPEND, 0644);
61213      unless ($fh) {
61214        my ($err_code, $err_name) = $sftp->error();
61215        die("Can't open test.txt: [$err_name] ($err_code)");
61216      }
61217
61218      # Note: there's a limit on the size of SSH packets, and thus an
61219      # SFTP WRITE request with data will not necessarily be as large as the
61220      # Perl code would have one expect.  And Net::SSH2 does not do a great
61221      # job of handling such cases.  So we break it down into individual
61222      # writes.  C'est la vie.
61223      for (my $i = 0; $i < 4; $i++) {
61224        print $fh "ABCD" x 2048;
61225      }
61226
61227      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
61228      $fh = undef;
61229
61230      # To close the SFTP channel, we have to explicitly destroy the object
61231      $sftp = undef;
61232
61233      $ssh2->disconnect();
61234    };
61235
61236    if ($@) {
61237      $ex = $@;
61238    }
61239
61240    $wfh->print("done\n");
61241    $wfh->flush();
61242
61243  } else {
61244    eval { server_wait($config_file, $rfh) };
61245    if ($@) {
61246      warn($@);
61247      exit 1;
61248    }
61249
61250    exit 0;
61251  }
61252
61253  # Stop server
61254  server_stop($pid_file);
61255
61256  $self->assert_child_ok($pid);
61257
61258  if ($ex) {
61259    test_append_logfile($log_file, $ex);
61260    unlink($log_file);
61261
61262    die($ex);
61263  }
61264
61265  my ($logged_user, $filename, $full_path, $filesize, $xfertime);
61266  ($logged_user, $cmd, $filename, $full_path, $filesize, $xfertime) = get_sftplog($db_file);
61267  my $expected;
61268
61269  $expected = 'APPE';
61270  $self->assert($expected eq $cmd,
61271    test_msg("Expected '$expected', got '$cmd'"));
61272
61273  $expected = 'test.txt';
61274  $self->assert($expected eq $filename,
61275    test_msg("Expected '$expected', got '$filename'"));
61276
61277  $expected = File::Spec->rel2abs("$tmpdir/test.txt");
61278  $self->assert($expected eq $full_path,
61279    test_msg("Expected '$expected', got '$full_path'"));
61280
61281  $expected = 32768;
61282  $self->assert($expected == $filesize,
61283    test_msg("Expected $expected, got $filesize"));
61284
61285  unlink($log_file);
61286}
61287
61288sub sftp_sql_log_init_vars {
61289  my $self = shift;
61290  my $tmpdir = $self->{tmpdir};
61291
61292  my $config_file = "$tmpdir/sftp.conf";
61293  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
61294  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
61295
61296  my $log_file = test_get_logfile();
61297
61298  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
61299  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
61300
61301  my $user = 'proftpd';
61302  my $passwd = 'test';
61303  my $group = 'ftpd';
61304  my $home_dir = File::Spec->rel2abs($tmpdir);
61305  my $uid = 500;
61306  my $gid = 500;
61307
61308  # Make sure that, if we're running as root, that the home directory has
61309  # permissions/privs set for the account we create
61310  if ($< == 0) {
61311    unless (chmod(0755, $home_dir)) {
61312      die("Can't set perms on $home_dir to 0755: $!");
61313    }
61314
61315    unless (chown($uid, $gid, $home_dir)) {
61316      die("Can't set owner of $home_dir to $uid/$gid: $!");
61317    }
61318  }
61319
61320  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
61321    '/bin/bash');
61322  auth_group_write($auth_group_file, $group, $gid, $user);
61323
61324  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
61325  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
61326
61327  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
61328
61329  # Build up sqlite3 command to create users, groups tables and populate them
61330  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
61331
61332  if (open(my $fh, "> $db_script")) {
61333    print $fh <<EOS;
61334CREATE TABLE sftplog (
61335  user TEXT NOT NULL,
61336  operation TEXT NOT NULL,
61337  filename TEXT NOT NULL,
61338  full_path TEXT NOT NULL,
61339  filesize INTEGER NOT NULL,
61340  xfertime INTEGER NOT NULL
61341);
61342EOS
61343
61344    unless (close($fh)) {
61345      die("Can't write $db_script: $!");
61346    }
61347
61348  } else {
61349    die("Can't open $db_script: $!");
61350  }
61351
61352  my $cmd = "sqlite3 $db_file < $db_script";
61353
61354  if ($ENV{TEST_VERBOSE}) {
61355    print STDERR "Executing sqlite3: $cmd\n";
61356  }
61357
61358  my @output = `$cmd`;
61359  if (scalar(@output) > 0 &&
61360      $ENV{TEST_VERBOSE}) {
61361    print STDERR "Output: ", join('', @output), "\n";
61362  }
61363
61364  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
61365  if (open(my $fh, "> $test_file")) {
61366    close($fh);
61367
61368  } else {
61369    die("Can't open $test_file: $!");
61370  }
61371
61372  my $config = {
61373    PidFile => $pid_file,
61374    ScoreboardFile => $scoreboard_file,
61375    SystemLog => $log_file,
61376    TraceLog => $log_file,
61377    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
61378
61379    AuthUserFile => $auth_user_file,
61380    AuthGroupFile => $auth_group_file,
61381
61382    IfModules => {
61383      'mod_delay.c' => {
61384        DelayEngine => 'off',
61385      },
61386
61387      'mod_sftp.c' => [
61388        "SFTPEngine on",
61389        "SFTPLog $log_file",
61390        "SFTPHostKey $rsa_host_key",
61391        "SFTPHostKey $dsa_host_key",
61392      ],
61393
61394      'mod_sql.c' => {
61395        SQLEngine => 'log',
61396        SQLBackend => 'sqlite3',
61397        SQLConnectInfo => $db_file,
61398        SQLLogFile => $log_file,
61399
61400        SQLNamedQuery => 'log-init FREEFORM "INSERT INTO sftplog (user, operation, filename, full_path, filesize, xfertime) VALUES (\'%u\', \'%m\', \'%F\', \'%f\', %b, %T)"',
61401        SQLLog => 'INIT log-init',
61402      },
61403    },
61404  };
61405
61406  my ($port, $config_user, $config_group) = config_write($config_file, $config);
61407
61408  # Open pipes, for use between the parent and child processes.  Specifically,
61409  # the child will indicate when it's done with its test by writing a message
61410  # to the parent.
61411  my ($rfh, $wfh);
61412  unless (pipe($rfh, $wfh)) {
61413    die("Can't open pipe: $!");
61414  }
61415
61416  require Net::SSH2;
61417
61418  my $ex;
61419
61420  # Ignore SIGPIPE
61421  local $SIG{PIPE} = sub { };
61422
61423  # Fork child
61424  $self->handle_sigchld();
61425  defined(my $pid = fork()) or die("Can't fork: $!");
61426  if ($pid) {
61427    eval {
61428      my $ssh2 = Net::SSH2->new();
61429
61430      sleep(1);
61431
61432      unless ($ssh2->connect('127.0.0.1', $port)) {
61433        my ($err_code, $err_name, $err_str) = $ssh2->error();
61434        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
61435      }
61436
61437      unless ($ssh2->auth_password($user, $passwd)) {
61438        my ($err_code, $err_name, $err_str) = $ssh2->error();
61439        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
61440      }
61441
61442      my $sftp = $ssh2->sftp();
61443      unless ($sftp) {
61444        my ($err_code, $err_name, $err_str) = $ssh2->error();
61445        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
61446      }
61447
61448      my $fh = $sftp->open('sftp.conf', O_RDONLY, 0644);
61449      unless ($fh) {
61450        my ($err_code, $err_name) = $sftp->error();
61451        die("Can't open sftp.conf: [$err_name] ($err_code)");
61452      }
61453
61454      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
61455      $fh = undef;
61456
61457      # To close the SFTP channel, we have to explicitly destroy the object
61458      $sftp = undef;
61459
61460      $ssh2->disconnect();
61461    };
61462
61463    if ($@) {
61464      $ex = $@;
61465    }
61466
61467    $wfh->print("done\n");
61468    $wfh->flush();
61469
61470  } else {
61471    eval { server_wait($config_file, $rfh) };
61472    if ($@) {
61473      warn($@);
61474      exit 1;
61475    }
61476
61477    exit 0;
61478  }
61479
61480  # Stop server
61481  server_stop($pid_file);
61482
61483  $self->assert_child_ok($pid);
61484
61485  if ($ex) {
61486    test_append_logfile($log_file, $ex);
61487    unlink($log_file);
61488
61489    die($ex);
61490  }
61491
61492  my ($logged_user, $filename, $full_path, $filesize, $xfertime);
61493  ($logged_user, $cmd, $filename, $full_path, $filesize, $xfertime) = get_sftplog($db_file);
61494  my $expected;
61495
61496  $expected = $user;
61497  $self->assert($expected eq $logged_user,
61498    test_msg("Expected '$expected', got '$logged_user'"));
61499
61500  $expected = 'INIT';
61501  $self->assert($expected eq $cmd,
61502    test_msg("Expected '$expected', got '$cmd'"));
61503
61504  $expected = '-';
61505  $self->assert($expected eq $filename,
61506    test_msg("Expected '$expected', got '$filename'"));
61507
61508  $expected = '-';
61509  $self->assert($expected eq $full_path,
61510    test_msg("Expected '$expected', got '$full_path'"));
61511
61512  $expected = 0;
61513  $self->assert($expected == $filesize,
61514    test_msg("Expected $expected, got $filesize"));
61515
61516  unlink($log_file);
61517}
61518
61519sub sftp_sql_log_pass_vars {
61520  my $self = shift;
61521  my $tmpdir = $self->{tmpdir};
61522
61523  my $config_file = "$tmpdir/sftp.conf";
61524  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
61525  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
61526
61527  my $log_file = test_get_logfile();
61528
61529  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
61530  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
61531
61532  my $user = 'proftpd';
61533  my $passwd = 'test';
61534  my $group = 'ftpd';
61535  my $home_dir = File::Spec->rel2abs($tmpdir);
61536  my $uid = 500;
61537  my $gid = 500;
61538
61539  # Make sure that, if we're running as root, that the home directory has
61540  # permissions/privs set for the account we create
61541  if ($< == 0) {
61542    unless (chmod(0755, $home_dir)) {
61543      die("Can't set perms on $home_dir to 0755: $!");
61544    }
61545
61546    unless (chown($uid, $gid, $home_dir)) {
61547      die("Can't set owner of $home_dir to $uid/$gid: $!");
61548    }
61549  }
61550
61551  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
61552    '/bin/bash');
61553  auth_group_write($auth_group_file, $group, $gid, $user);
61554
61555  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
61556  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
61557
61558  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
61559
61560  # Build up sqlite3 command to create users, groups tables and populate them
61561  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
61562
61563  if (open(my $fh, "> $db_script")) {
61564    print $fh <<EOS;
61565CREATE TABLE sftplog (
61566  user TEXT NOT NULL,
61567  operation TEXT NOT NULL,
61568  filename TEXT NOT NULL,
61569  full_path TEXT NOT NULL,
61570  filesize INTEGER NOT NULL,
61571  xfertime INTEGER NOT NULL
61572);
61573EOS
61574
61575    unless (close($fh)) {
61576      die("Can't write $db_script: $!");
61577    }
61578
61579  } else {
61580    die("Can't open $db_script: $!");
61581  }
61582
61583  my $cmd = "sqlite3 $db_file < $db_script";
61584
61585  if ($ENV{TEST_VERBOSE}) {
61586    print STDERR "Executing sqlite3: $cmd\n";
61587  }
61588
61589  my @output = `$cmd`;
61590  if (scalar(@output) > 0 &&
61591      $ENV{TEST_VERBOSE}) {
61592    print STDERR "Output: ", join('', @output), "\n";
61593  }
61594
61595  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
61596  if (open(my $fh, "> $test_file")) {
61597    close($fh);
61598
61599  } else {
61600    die("Can't open $test_file: $!");
61601  }
61602
61603  my $config = {
61604    PidFile => $pid_file,
61605    ScoreboardFile => $scoreboard_file,
61606    SystemLog => $log_file,
61607    TraceLog => $log_file,
61608    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
61609
61610    AuthUserFile => $auth_user_file,
61611    AuthGroupFile => $auth_group_file,
61612
61613    IfModules => {
61614      'mod_delay.c' => {
61615        DelayEngine => 'off',
61616      },
61617
61618      'mod_sftp.c' => [
61619        "SFTPEngine on",
61620        "SFTPLog $log_file",
61621        "SFTPHostKey $rsa_host_key",
61622        "SFTPHostKey $dsa_host_key",
61623      ],
61624
61625      'mod_sql.c' => {
61626        SQLEngine => 'log',
61627        SQLBackend => 'sqlite3',
61628        SQLConnectInfo => $db_file,
61629        SQLLogFile => $log_file,
61630
61631        SQLNamedQuery => 'log-pass FREEFORM "INSERT INTO sftplog (user, operation, filename, full_path, filesize, xfertime) VALUES (\'%u\', \'%m\', \'%F\', \'%f\', %b, %T)"',
61632        SQLLog => 'PASS log-pass',
61633      },
61634    },
61635  };
61636
61637  my ($port, $config_user, $config_group) = config_write($config_file, $config);
61638
61639  # Open pipes, for use between the parent and child processes.  Specifically,
61640  # the child will indicate when it's done with its test by writing a message
61641  # to the parent.
61642  my ($rfh, $wfh);
61643  unless (pipe($rfh, $wfh)) {
61644    die("Can't open pipe: $!");
61645  }
61646
61647  require Net::SSH2;
61648
61649  my $ex;
61650
61651  # Ignore SIGPIPE
61652  local $SIG{PIPE} = sub { };
61653
61654  # Fork child
61655  $self->handle_sigchld();
61656  defined(my $pid = fork()) or die("Can't fork: $!");
61657  if ($pid) {
61658    eval {
61659      my $ssh2 = Net::SSH2->new();
61660
61661      sleep(1);
61662
61663      unless ($ssh2->connect('127.0.0.1', $port)) {
61664        my ($err_code, $err_name, $err_str) = $ssh2->error();
61665        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
61666      }
61667
61668      unless ($ssh2->auth_password($user, $passwd)) {
61669        my ($err_code, $err_name, $err_str) = $ssh2->error();
61670        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
61671      }
61672
61673      my $sftp = $ssh2->sftp();
61674      unless ($sftp) {
61675        my ($err_code, $err_name, $err_str) = $ssh2->error();
61676        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
61677      }
61678
61679      my $fh = $sftp->open('sftp.conf', O_RDONLY, 0644);
61680      unless ($fh) {
61681        my ($err_code, $err_name) = $sftp->error();
61682        die("Can't open sftp.conf: [$err_name] ($err_code)");
61683      }
61684
61685      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
61686      $fh = undef;
61687
61688      # To close the SFTP channel, we have to explicitly destroy the object
61689      $sftp = undef;
61690
61691      $ssh2->disconnect();
61692    };
61693
61694    if ($@) {
61695      $ex = $@;
61696    }
61697
61698    $wfh->print("done\n");
61699    $wfh->flush();
61700
61701  } else {
61702    eval { server_wait($config_file, $rfh) };
61703    if ($@) {
61704      warn($@);
61705      exit 1;
61706    }
61707
61708    exit 0;
61709  }
61710
61711  # Stop server
61712  server_stop($pid_file);
61713
61714  $self->assert_child_ok($pid);
61715
61716  if ($ex) {
61717    test_append_logfile($log_file, $ex);
61718    unlink($log_file);
61719
61720    die($ex);
61721  }
61722
61723  my ($logged_user, $filename, $full_path, $filesize, $xfertime);
61724  ($logged_user, $cmd, $filename, $full_path, $filesize, $xfertime) = get_sftplog($db_file);
61725  my $expected;
61726
61727  $expected = $user;
61728  $self->assert($expected eq $logged_user,
61729    test_msg("Expected '$expected', got '$logged_user'"));
61730
61731  $expected = 'PASS';
61732  $self->assert($expected eq $cmd,
61733    test_msg("Expected '$expected', got '$cmd'"));
61734
61735  $expected = '-';
61736  $self->assert($expected eq $filename,
61737    test_msg("Expected '$expected', got '$filename'"));
61738
61739  $expected = '-';
61740  $self->assert($expected eq $full_path,
61741    test_msg("Expected '$expected', got '$full_path'"));
61742
61743  $expected = 0;
61744  $self->assert($expected == $filesize,
61745    test_msg("Expected $expected, got $filesize"));
61746
61747  unlink($log_file);
61748}
61749
61750sub sftp_sql_log_exit_vars {
61751  my $self = shift;
61752  my $tmpdir = $self->{tmpdir};
61753
61754  my $config_file = "$tmpdir/sftp.conf";
61755  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
61756  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
61757
61758  my $log_file = test_get_logfile();
61759
61760  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
61761  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
61762
61763  my $user = 'proftpd';
61764  my $passwd = 'test';
61765  my $group = 'ftpd';
61766  my $home_dir = File::Spec->rel2abs($tmpdir);
61767  my $uid = 500;
61768  my $gid = 500;
61769
61770  # Make sure that, if we're running as root, that the home directory has
61771  # permissions/privs set for the account we create
61772  if ($< == 0) {
61773    unless (chmod(0755, $home_dir)) {
61774      die("Can't set perms on $home_dir to 0755: $!");
61775    }
61776
61777    unless (chown($uid, $gid, $home_dir)) {
61778      die("Can't set owner of $home_dir to $uid/$gid: $!");
61779    }
61780  }
61781
61782  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
61783    '/bin/bash');
61784  auth_group_write($auth_group_file, $group, $gid, $user);
61785
61786  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
61787  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
61788
61789  my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db");
61790
61791  # Build up sqlite3 command to create users, groups tables and populate them
61792  my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql");
61793
61794  if (open(my $fh, "> $db_script")) {
61795    print $fh <<EOS;
61796CREATE TABLE sftplog (
61797  user TEXT NOT NULL,
61798  operation TEXT NOT NULL,
61799  filename TEXT NOT NULL,
61800  full_path TEXT NOT NULL,
61801  filesize INTEGER NOT NULL,
61802  xfertime INTEGER NOT NULL
61803);
61804EOS
61805
61806    unless (close($fh)) {
61807      die("Can't write $db_script: $!");
61808    }
61809
61810  } else {
61811    die("Can't open $db_script: $!");
61812  }
61813
61814  my $cmd = "sqlite3 $db_file < $db_script";
61815
61816  if ($ENV{TEST_VERBOSE}) {
61817    print STDERR "Executing sqlite3: $cmd\n";
61818  }
61819
61820  my @output = `$cmd`;
61821  if (scalar(@output) > 0 &&
61822      $ENV{TEST_VERBOSE}) {
61823    print STDERR "Output: ", join('', @output), "\n";
61824  }
61825
61826  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
61827  if (open(my $fh, "> $test_file")) {
61828    close($fh);
61829
61830  } else {
61831    die("Can't open $test_file: $!");
61832  }
61833
61834  my $config = {
61835    PidFile => $pid_file,
61836    ScoreboardFile => $scoreboard_file,
61837    SystemLog => $log_file,
61838    TraceLog => $log_file,
61839    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
61840
61841    AuthUserFile => $auth_user_file,
61842    AuthGroupFile => $auth_group_file,
61843
61844    IfModules => {
61845      'mod_delay.c' => {
61846        DelayEngine => 'off',
61847      },
61848
61849      'mod_sftp.c' => [
61850        "SFTPEngine on",
61851        "SFTPLog $log_file",
61852        "SFTPHostKey $rsa_host_key",
61853        "SFTPHostKey $dsa_host_key",
61854      ],
61855
61856      'mod_sql.c' => {
61857        SQLEngine => 'log',
61858        SQLBackend => 'sqlite3',
61859        SQLConnectInfo => $db_file,
61860        SQLLogFile => $log_file,
61861
61862        SQLNamedQuery => 'log-exit FREEFORM "INSERT INTO sftplog (user, operation, filename, full_path, filesize, xfertime) VALUES (\'%u\', \'%m\', \'%F\', \'%f\', %b, %T)"',
61863        SQLLog => 'EXIT log-exit',
61864      },
61865    },
61866  };
61867
61868  my ($port, $config_user, $config_group) = config_write($config_file, $config);
61869
61870  # Open pipes, for use between the parent and child processes.  Specifically,
61871  # the child will indicate when it's done with its test by writing a message
61872  # to the parent.
61873  my ($rfh, $wfh);
61874  unless (pipe($rfh, $wfh)) {
61875    die("Can't open pipe: $!");
61876  }
61877
61878  require Net::SSH2;
61879
61880  my $ex;
61881
61882  # Ignore SIGPIPE
61883  local $SIG{PIPE} = sub { };
61884
61885  # Fork child
61886  $self->handle_sigchld();
61887  defined(my $pid = fork()) or die("Can't fork: $!");
61888  if ($pid) {
61889    eval {
61890      my $ssh2 = Net::SSH2->new();
61891
61892      sleep(1);
61893
61894      unless ($ssh2->connect('127.0.0.1', $port)) {
61895        my ($err_code, $err_name, $err_str) = $ssh2->error();
61896        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
61897      }
61898
61899      unless ($ssh2->auth_password($user, $passwd)) {
61900        my ($err_code, $err_name, $err_str) = $ssh2->error();
61901        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
61902      }
61903
61904      my $sftp = $ssh2->sftp();
61905      unless ($sftp) {
61906        my ($err_code, $err_name, $err_str) = $ssh2->error();
61907        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
61908      }
61909
61910      my $fh = $sftp->open('sftp.conf', O_RDONLY, 0644);
61911      unless ($fh) {
61912        my ($err_code, $err_name) = $sftp->error();
61913        die("Can't open sftp.conf: [$err_name] ($err_code)");
61914      }
61915
61916      # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle
61917      $fh = undef;
61918
61919      # To close the SFTP channel, we have to explicitly destroy the object
61920      $sftp = undef;
61921
61922      $ssh2->disconnect();
61923
61924      # Let a little time pass, so that the server handles the session
61925      # ending properly.
61926      sleep(1);
61927    };
61928
61929    if ($@) {
61930      $ex = $@;
61931    }
61932
61933    $wfh->print("done\n");
61934    $wfh->flush();
61935
61936  } else {
61937    eval { server_wait($config_file, $rfh) };
61938    if ($@) {
61939      warn($@);
61940      exit 1;
61941    }
61942
61943    exit 0;
61944  }
61945
61946  # Stop server
61947  server_stop($pid_file);
61948
61949  $self->assert_child_ok($pid);
61950
61951  if ($ex) {
61952    test_append_logfile($log_file, $ex);
61953    unlink($log_file);
61954
61955    die($ex);
61956  }
61957
61958  my ($logged_user, $filename, $full_path, $filesize, $xfertime);
61959  ($logged_user, $cmd, $filename, $full_path, $filesize, $xfertime) = get_sftplog($db_file);
61960  my $expected;
61961
61962  # The user (%u) is blank here because the session.user field has been
61963  # cleared.
61964  $expected = $user;
61965  $self->assert($expected eq $logged_user,
61966    test_msg("Expected '$expected', got '$logged_user'"));
61967
61968  $expected = 'EXIT';
61969  $self->assert($expected eq $cmd,
61970    test_msg("Expected '$expected', got '$cmd'"));
61971
61972  $expected = '-';
61973  $self->assert($expected eq $filename,
61974    test_msg("Expected '$expected', got '$filename'"));
61975
61976  $expected = '-';
61977  $self->assert($expected eq $full_path,
61978    test_msg("Expected '$expected', got '$full_path'"));
61979
61980  $expected = 0;
61981  $self->assert($expected == $filesize,
61982    test_msg("Expected $expected, got $filesize"));
61983
61984  unlink($log_file);
61985}
61986
61987sub scp_ifsess_protocols {
61988  my $self = shift;
61989  my $tmpdir = $self->{tmpdir};
61990
61991  my $config_file = "$tmpdir/sftp.conf";
61992  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
61993  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
61994
61995  my $log_file = test_get_logfile();
61996
61997  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
61998  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
61999
62000  my $user = 'proftpd';
62001  my $passwd = 'test';
62002  my $group = 'ftpd';
62003  my $home_dir = File::Spec->rel2abs($tmpdir);
62004  my $uid = 500;
62005  my $gid = 500;
62006
62007  # Make sure that, if we're running as root, that the home directory has
62008  # permissions/privs set for the account we create
62009  if ($< == 0) {
62010    unless (chmod(0755, $home_dir)) {
62011      die("Can't set perms on $home_dir to 0755: $!");
62012    }
62013
62014    unless (chown($uid, $gid, $home_dir)) {
62015      die("Can't set owner of $home_dir to $uid/$gid: $!");
62016    }
62017  }
62018
62019  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
62020    '/bin/bash');
62021  auth_group_write($auth_group_file, $group, $gid, $user);
62022
62023  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
62024  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
62025
62026  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
62027
62028  my $config = {
62029    PidFile => $pid_file,
62030    ScoreboardFile => $scoreboard_file,
62031    SystemLog => $log_file,
62032    TraceLog => $log_file,
62033    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
62034
62035    AuthUserFile => $auth_user_file,
62036    AuthGroupFile => $auth_group_file,
62037
62038    IfModules => {
62039      'mod_delay.c' => {
62040        DelayEngine => 'off',
62041      },
62042
62043      'mod_sftp.c' => [
62044        "SFTPEngine on",
62045        "SFTPLog $log_file",
62046        "SFTPHostKey $rsa_host_key",
62047        "SFTPHostKey $dsa_host_key",
62048      ],
62049    },
62050  };
62051
62052  my ($port, $config_user, $config_group) = config_write($config_file, $config);
62053
62054  if (open(my $fh, ">> $config_file")) {
62055    print $fh <<EOC;
62056<IfModule mod_ifsession.c>
62057  <IfUser foo>
62058    Protocols sftp scp
62059  </IfUser>
62060
62061  <IfUser $user>
62062    Protocols sftp
62063  </IfUser>
62064</IfModule>
62065EOC
62066
62067    unless (close($fh)) {
62068      die("Can't write $config_file: $!");
62069    }
62070
62071  } else {
62072    die("Can't open $config_file: $!");
62073  }
62074
62075  # Open pipes, for use between the parent and child processes.  Specifically,
62076  # the child will indicate when it's done with its test by writing a message
62077  # to the parent.
62078  my ($rfh, $wfh);
62079  unless (pipe($rfh, $wfh)) {
62080    die("Can't open pipe: $!");
62081  }
62082
62083  require Net::SSH2;
62084
62085  my $ex;
62086
62087  # Ignore SIGPIPE
62088  local $SIG{PIPE} = sub { };
62089
62090  # Fork child
62091  $self->handle_sigchld();
62092  defined(my $pid = fork()) or die("Can't fork: $!");
62093  if ($pid) {
62094    eval {
62095      my $ssh2 = Net::SSH2->new();
62096
62097      sleep(1);
62098
62099      unless ($ssh2->connect('127.0.0.1', $port)) {
62100        my ($err_code, $err_name, $err_str) = $ssh2->error();
62101        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
62102      }
62103
62104      unless ($ssh2->auth_password($user, $passwd)) {
62105        my ($err_code, $err_name, $err_str) = $ssh2->error();
62106        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
62107      }
62108
62109      my $res = $ssh2->scp_put($config_file, 'test.txt');
62110      if ($res) {
62111        die("SCP upload succeeded unexpectedly");
62112      }
62113
62114      my ($err_code, $err_name, $err_str) = $ssh2->error();
62115
62116      $ssh2->disconnect();
62117
62118      if (-f $test_file) {
62119        die("File $test_file exists unexpectedly");
62120      }
62121    };
62122
62123    if ($@) {
62124      $ex = $@;
62125    }
62126
62127    $wfh->print("done\n");
62128    $wfh->flush();
62129
62130  } else {
62131    eval { server_wait($config_file, $rfh) };
62132    if ($@) {
62133      warn($@);
62134      exit 1;
62135    }
62136
62137    exit 0;
62138  }
62139
62140  # Stop server
62141  server_stop($pid_file);
62142
62143  $self->assert_child_ok($pid);
62144
62145  if ($ex) {
62146    test_append_logfile($log_file, $ex);
62147    unlink($log_file);
62148
62149    die($ex);
62150  }
62151
62152  unlink($log_file);
62153}
62154
621551;
62156