1
2use strict;
3use File::Path;
4use File::Copy;
5
6push @INC, "$ENV{SRCDIR}/tst";
7require 'vstr_tst_examples.pl';
8
9our $root = "ex_httpd_root";
10our $truncate_segv = 0;
11
12sub http_cntl_list
13  { # FIXME: see if it looks "OK"
14    my $list_pid = tst_proc_fork();
15    if (!$list_pid) {
16      sleep(2);
17      system("./ex_cntl -e list ex_httpd_cntl > /dev/null");
18      _exit(0);
19    }
20    return $list_pid;
21  }
22
23sub httpd__munge_ret
24  {
25    my $output = shift;
26
27    # Remove date, because that changes each time
28    $output =~ s/^(Date:).*$/$1/gm;
29    # Remove last-modified = start date for error messages
30    $output =~
31      s!(HTTP/1[.]1 \s (?:30[1237]|40[03456]|41[0234567]|50[0135]) .*)$ (\n)
32	^(Date:)$ (\n)
33	^(Server:.*)$ (\n)
34	^(Last-Modified:) .*$
35	!$1$2$3$4$5$6$7!gmx;
36    # Remove last modified for trace ops
37    $output =~
38      s!^(Last-Modified:).*$ (\n)
39        ^(Content-Type: \s message/http.*)$
40	!$1$2$3!gmx;
41
42    return $output;
43  }
44
45sub httpd_file_tst
46  {
47    my $io_r = shift;
48    my $io_w = shift;
49    my $xtra = shift || {};
50    my $sz   = shift;
51
52    my $data = daemon_get_io_r($io_r);
53
54    $data =~ s/\n/\r\n/g;
55
56    my $output = daemon_io($data,
57			   $xtra->{shutdown_w}, $xtra->{slow_write}, 1);
58
59    $output = httpd__munge_ret($output);
60    daemon_put_io_w($io_w, $output);
61  }
62
63sub httpd_gen_tst
64  {
65    my $io_r = shift;
66    my $io_w = shift;
67    my $xtra = shift || {};
68    my $sz   = shift;
69
70    my $data = daemon_get_io_r($io_r);
71
72    if (length($data) != 0)
73      { failure(sprintf("data(%d) on gen tst", length($data))); }
74
75    if (! exists($xtra->{gen_output}))
76      { $xtra->{gen_output} = \&httpd__munge_ret; }
77
78    $data = $xtra->{gen_input}->();
79
80    my $output = daemon_io($data,
81			   $xtra->{shutdown_w}, $xtra->{slow_write}, 1);
82
83    $output = $xtra->{gen_output}->($output);
84
85    daemon_put_io_w($io_w, $output);
86  }
87
88sub gen_tst_e2big
89  {
90    my $gen_cb = sub {
91      my $data = ("\r\n" x 80_000) . ("x" x 150_000);
92      return $data;
93    };
94
95    my $gen_out_cb = sub { # Load ex_httpd_null_out_1 ?
96      $_ = shift;
97      if (m!^HTTP/1.1 400 !)
98	{
99	  $_ = "";
100	}
101
102      return $_;
103    };
104
105    sub_tst(\&httpd_gen_tst, "ex_httpd_null",
106	    {gen_input => $gen_cb, gen_output => $gen_out_cb,
107	     shutdown_w => 0});
108  }
109
110use POSIX; # _exit
111
112sub gen_tst_trunc
113  {
114    return if ($main::truncate_segv);
115
116    my $vhosts = shift;
117    my $pid = 0;
118
119    if (!($pid = tst_proc_fork()))
120      {
121	if (1)
122	  {
123	    open(STDIN,  "< /dev/null") || failure("open(2): $!");
124	    open(STDOUT, "> /dev/null") || failure("open(2): $!");
125	    open(STDERR, "> /dev/null") || failure("open(2): $!");
126	  }
127
128	my $fname = "$main::root/foo.example.com/4mb_2_2mb_$$";
129
130	if (!$vhosts)
131	  {
132	    $fname = "$main::root/4mb_2_2mb_$$";
133	  }
134
135	if (!($pid = tst_proc_fork()))
136	  { # Child goes
137	    sleep(4);
138	    truncate($fname, 2_000_000);
139	    success();
140	  }
141
142	open(OUT, ">> $fname") || failure("open($fname): $!");
143
144	truncate($fname, 4_000_000);
145
146	my $gen_cb = sub {
147	  sleep(1);
148	  my $pad = "x" x 64_000;
149	  my $data = <<EOL;
150GET http://foo.example.com/4mb_2_2mb_$$ HTTP/1.1\r
151Host: $pad\r
152\r
153EOL
154	  $data = $data x 16;
155	  return $data;
156	};
157
158	my $gen_out_cb = sub { # Load ex_httpd_null_out_1 ?
159	  unlink($fname);
160	  success();
161	};
162	# Randomly test as other stuff happens...
163	sub_tst(\&httpd_gen_tst, "ex_httpd_null",
164		{gen_input => $gen_cb, gen_output => $gen_out_cb,
165		 shutdown_w => 0});
166	success();
167      }
168  }
169
170sub gen_tsts
171  {
172    my $vhosts = shift;
173
174    gen_tst_trunc($vhosts);
175    gen_tst_e2big();
176  }
177
178sub all_vhost_tsts()
179  {
180    gen_tsts(1);
181    sub_tst(\&httpd_file_tst, "ex_httpd");
182    if ($>) { # mode 000 doesn't work if running !uid
183    sub_tst(\&httpd_file_tst, "ex_httpd_nonroot"); }
184
185    sub_tst(\&httpd_file_tst, "ex_httpd_errs");
186
187    sub_tst(\&httpd_file_tst, "ex_httpd",
188	    {shutdown_w => 0});
189    if ($>) {
190    sub_tst(\&httpd_file_tst, "ex_httpd_nonroot",
191	    {shutdown_w => 0}); }
192    sub_tst(\&httpd_file_tst, "ex_httpd_errs",
193	    {shutdown_w => 0});
194    sub_tst(\&httpd_file_tst, "ex_httpd_shut",
195	    {shutdown_w => 0});
196
197    sub_tst(\&httpd_file_tst, "ex_httpd",
198	    {                 slow_write => 1});
199    if ($>) {
200    sub_tst(\&httpd_file_tst, "ex_httpd_nonroot",
201	    {                 slow_write => 1}); }
202    sub_tst(\&httpd_file_tst, "ex_httpd_errs",
203	    {                 slow_write => 1});
204
205    sub_tst(\&httpd_file_tst, "ex_httpd",
206	    {shutdown_w => 0, slow_write => 1});
207    if ($>) {
208    sub_tst(\&httpd_file_tst, "ex_httpd_nonroot",
209	    {shutdown_w => 0, slow_write => 1}); }
210    sub_tst(\&httpd_file_tst, "ex_httpd_errs",
211	    {shutdown_w => 0, slow_write => 1});
212    sub_tst(\&httpd_file_tst, "ex_httpd_shut",
213	    {shutdown_w => 0, slow_write => 1});
214  }
215
216sub all_nonvhost_tsts()
217  {
218    gen_tsts(0);
219    sub_tst(\&httpd_file_tst, "ex_httpd_non-virtual-hosts");
220    sub_tst(\&httpd_file_tst, "ex_httpd_non-virtual-hosts",
221	    {shutdown_w => 0});
222    sub_tst(\&httpd_file_tst, "ex_httpd_non-virtual-hosts",
223	    {                 slow_write => 1});
224    sub_tst(\&httpd_file_tst, "ex_httpd_non-virtual-hosts",
225	    {shutdown_w => 0, slow_write => 1});
226  }
227
228sub all_public_only_tsts
229  {
230    if (!@_) { gen_tsts(1); }
231    sub_tst(\&httpd_file_tst, "ex_httpd_public-only");
232    sub_tst(\&httpd_file_tst, "ex_httpd_public-only",
233	    {shutdown_w => 0});
234    sub_tst(\&httpd_file_tst, "ex_httpd_public-only",
235	    {                 slow_write => 1});
236    sub_tst(\&httpd_file_tst, "ex_httpd_public-only",
237	    {shutdown_w => 0, slow_write => 1});
238  }
239
240sub all_none_tsts()
241  {
242    gen_tsts(1);
243    sub_tst(\&httpd_file_tst, "ex_httpd_none");
244    sub_tst(\&httpd_file_tst, "ex_httpd_none",
245	    {shutdown_w => 0});
246    sub_tst(\&httpd_file_tst, "ex_httpd_none",
247	    {                 slow_write => 1});
248    sub_tst(\&httpd_file_tst, "ex_httpd_none",
249	    {shutdown_w => 0, slow_write => 1});
250  }
251
252sub all_conf_5_tsts()
253  {
254    sub_tst(\&httpd_file_tst, "ex_httpd_conf_5");
255    sub_tst(\&httpd_file_tst, "ex_httpd_conf_5",
256	    {shutdown_w => 0});
257    sub_tst(\&httpd_file_tst, "ex_httpd_conf_5",
258	    {                 slow_write => 1});
259    sub_tst(\&httpd_file_tst, "ex_httpd_conf_5",
260	    {shutdown_w => 0, slow_write => 1});
261  }
262
263sub all_conf_6_tsts()
264  {
265    sub_tst(\&httpd_file_tst, "ex_httpd_conf_6");
266    sub_tst(\&httpd_file_tst, "ex_httpd_conf_6",
267	    {shutdown_w => 0});
268    sub_tst(\&httpd_file_tst, "ex_httpd_conf_6",
269	    {                 slow_write => 1});
270    sub_tst(\&httpd_file_tst, "ex_httpd_conf_6",
271	    {shutdown_w => 0, slow_write => 1});
272  }
273
274sub munge_mtime
275  {
276    my $num   = shift;
277    my $fname = shift;
278
279    my ($a, $b, $c, $d,
280	$e, $f, $g, $h,
281	$atime, $mtime) = stat("$ENV{SRCDIR}/tst/ex_httpd_tst_1");
282    $atime -= ($num * (60 * 60 * 24));
283    $mtime -= ($num * (60 * 60 * 24));
284    utime $atime, $mtime, $fname;
285  }
286
287sub make_data
288  {
289    my $num   = shift;
290    my $data  = shift;
291    my $fname = shift;
292
293    open(OUT, "> $fname") || failure("open $fname: $!");
294    print OUT $data;
295    close(OUT) || failure("close");
296
297    munge_mtime($num, $fname);
298  }
299
300sub make_line
301  {
302    my $num   = shift;
303    my $data  = shift;
304    my $fname = shift;
305    make_data($num, $data . "\n", $fname);
306  }
307
308sub make_html
309  {
310    my $num   = shift;
311    my $val   = shift;
312    my $fname = shift;
313
314    my $data = <<EOL;
315<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
316<html>
317  <head>
318    <title>Foo $val</title>
319  </head>
320  <body>
321    <h1>Foo $val</h1>
322  </body>
323</html>
324EOL
325    make_data($num, $data, $fname);
326  }
327
328sub setup
329  {
330    my $big = "";
331
332    # Needs to be big or the .bz2 file won't stay around due to the 95% rule
333    $big .= ("\n" . ("x" x 10) . ("xy" x 10) . ("y" x 10)) x 500;
334    $big .= "\n";
335
336    rmtree($root);
337    mkpath([$root . "/default",
338	    $root . "/default.example.com",
339	    $root . "/blah",
340	    $root . "/foo.example.com/nxt",
341	    $root . "/foo.example.com/corner/index.html",
342	    $root . "/foo.example.com/there",
343	    $root . "/foo.example.com:1234"]);
344
345    make_html(1, "root",    "$root/index.html");
346    make_html(2, "default", "$root/default/index.html");
347    make_html(2, "def$big", "$root/default/index-big.html");
348    make_html(3, "norm",    "$root/foo.example.com/index.html");
349    make_html(4, "port",    "$root/foo.example.com:1234/index.html");
350    make_html(5, "corner",
351	      "$root/foo.example.com/corner/index.html/index.html");
352    make_html(6, "bt",      "$root/foo.example.com:1234/bt.torrent");
353    make_html(7, "plain",   "$root/default/README");
354    make_html(8, "backup",  "$root/default/index.html~");
355    make_html(9, "welcome", "$root/default/welcome.html");
356    make_html(9, "welcome", "$root/default/welcome.txt");
357    make_html(0, "",        "$root/default/noprivs.html");
358    make_html(0, "privs",   "$root/default/noallprivs.html");
359    make_line(10, "a none", "$root/foo.example.com/there/5.2-neg-CT");
360    make_line(10, "a txt",  "$root/foo.example.com/there/5.2-neg-CT.txt");
361    make_line(10, "a html", "$root/foo.example.com/there/5.2-neg-CT.html");
362    make_line(10, "b none", "$root/foo.example.com/there/5.2-neg-AL");
363    make_line(10, "b def",  "$root/foo.example.com/there/5.2-neg-AL.txt");
364    make_line(10, "b jpfb", "$root/foo.example.com/there/5.2-neg-AL.jpfb.txt");
365    make_line(10, "b jp",   "$root/foo.example.com/there/5.2-neg-AL.jp.txt");
366    make_line(10, "b fr",   "$root/foo.example.com/there/5.2-neg-AL.fr.txt");
367    make_line(10, "c none", "$root/foo.example.com/there/5.2-neg");
368    make_line(10, "c deft", "$root/foo.example.com/there/5.2-neg.txt");
369    make_line(10, "c defh", "$root/foo.example.com/there/5.2-neg.html");
370    make_line(10, "c jpbt", "$root/foo.example.com/there/5.2-neg.jpfb.txt");
371    make_line(10, "c jpbh", "$root/foo.example.com/there/5.2-neg.jpfb.html");
372    make_line(10, "c jpt",  "$root/foo.example.com/there/5.2-neg.jp.txt");
373    make_line(10, "c jph",  "$root/foo.example.com/there/5.2-neg.jp.html");
374    make_line(10, "c frt",  "$root/foo.example.com/there/5.2-neg.fr.txt");
375    make_line(10, "c frh",  "$root/foo.example.com/there/5.2-neg.fr.html");
376
377    open(OUT,     "> $root/foo.example.com/empty") || failure("open empty: $!");
378    munge_mtime(44, "$root/foo.example.com/empty");
379
380    system("$ENV{SRCDIR}/gzip-r.pl --force --type=all $root");
381    munge_mtime(0, "$root/index.html.gz");
382    munge_mtime(0, "$root/index.html.bz2");
383    munge_mtime(0, "$root/default/index.html.gz");
384    munge_mtime(0, "$root/default/index.html.bz2");
385    munge_mtime(0, "$root/foo.example.com/index.html.gz");
386    munge_mtime(0, "$root/foo.example.com/index.html.bz2");
387    munge_mtime(0, "$root/foo.example.com:1234/index.html.gz");
388    munge_mtime(0, "$root/foo.example.com:1234/index.html.bz2");
389
390    chmod(0000, "$root/default/noprivs.html");
391    chmod(0600, "$root/default/noallprivs.html");
392
393    system("mkfifo $root/default/fifo");
394
395    my ($a, $b, $c, $d,
396	$e, $f, $g, $h,
397	$atime, $mtime) = stat("$ENV{SRCDIR}/tst/ex_cat_tst_4");
398    copy("$ENV{SRCDIR}/tst/ex_cat_tst_4", "$root/default/bin");
399    utime $atime, $mtime, "$root/default/bin";
400  }
401
402my $clean_on_exit = 1;
403if (@ARGV)
404  {
405    $clean_on_exit = 0;
406    my $cntl_file = shift;
407    my $bind_addr = undef;
408
409    daemon_status($cntl_file);
410
411    while (@ARGV)
412      {
413	my $arg = shift;
414	my $y = 0;
415
416	if ($arg eq "setup")
417	  { setup(); }
418	elsif ($arg eq "trunc")
419	  { $truncate_segv = !$truncate_segv; }
420	elsif ($arg eq "cntl")
421	  { $cntl_file = shift; daemon_status($cntl_file, $bind_addr); }
422	elsif ($arg eq "addr")
423	  { $bind_addr = shift; daemon_status($cntl_file, $bind_addr); }
424	elsif ($arg eq "cleanup")
425	  { $clean_on_exit = !$clean_on_exit; }
426	elsif (($arg eq "virtual-hosts") || ($arg eq "vhosts"))
427	  { all_vhost_tsts(); $y = 1; }
428	elsif ($arg eq "public")
429	  { all_public_only_tsts(); $y = 1; }
430	elsif ($arg eq "none")
431	  { all_none_tsts(); $y = 1; }
432	elsif ($arg eq "conf_5")
433	  { all_conf_5_tsts(); $y = 1; }
434	elsif ($arg eq "conf_6")
435	  { all_conf_6_tsts(); $y = 1; }
436	elsif (($arg eq "non-virtual-hosts") || ($arg eq "non-vhosts"))
437	  { all_nonvhost_tsts(); $y = 1; }
438
439	print "-" x 78 . "\n" if ($y);
440      }
441
442    success();
443  }
444
445our $conf_args_nonstrict = " --configuration-data-jhttpd '(policy <default> (unspecified-hostname-append-port off) (secure-directory-filename no) (HTTP (header-names-strict false)))'";
446our $conf_args_strict = " --configuration-data-jhttpd '(policy <default> (secure-directory-filename no) (unspecified-hostname-append-port off))'";
447
448sub httpd_vhost_tst
449  {
450    daemon_init("ex_httpd", $root, shift);
451    system("cat > $root/default/fifo &");
452    http_cntl_list();
453    all_vhost_tsts();
454    daemon_exit();
455  }
456
457sub conf_tsts
458  {
459    my $beg = shift;
460    my $end = shift;
461    my $args = '';
462
463    for ($beg..$end)
464      { $args .= " -C $ENV{SRCDIR}/tst/ex_conf_httpd_tst_$_"; }
465
466    daemon_init("ex_httpd", $root, $args);
467    my $list_pid = http_cntl_list();
468
469    for ($beg..$end)
470      {
471	if (0) {}
472	elsif ($_ == 1)
473	  {
474	    daemon_status("ex_httpd_cntl", "127.0.0.1");
475	    all_vhost_tsts();
476	    my $old_trunc = $truncate_segv;
477	    $truncate_segv = 1;
478	    daemon_status("ex_httpd_cntl", "127.0.0.2");
479	    all_vhost_tsts();
480	    $truncate_segv = $old_trunc;
481	    daemon_status("ex_httpd_cntl", "127.0.0.3");
482	    all_vhost_tsts();
483	  }
484	elsif ($_ == 2)
485	  {
486	    daemon_status("ex_httpd_cntl", "127.0.1.1");
487	    all_public_only_tsts("no gen tsts");
488	  }
489	elsif ($_ == 3)
490	  {
491	    daemon_status("ex_httpd_cntl", "127.0.2.1");
492	    all_nonvhost_tsts();
493	  }
494	elsif ($_ == 4)
495	  {
496	    daemon_status("ex_httpd_cntl", "127.0.3.1");
497	    all_none_tsts();
498	  }
499	elsif ($_ == 5)
500	  {
501	    daemon_status("ex_httpd_cntl", "127.0.4.1");
502	    all_conf_5_tsts();
503	  }
504	elsif ($_ == 6)
505	  {
506	    daemon_status("ex_httpd_cntl", "127.0.5.1");
507	    all_conf_6_tsts();
508	  }
509      }
510
511    daemon_exit();
512  }
513
514
515END {
516  my $save_exit_code = $?;
517  if ($clean_on_exit)
518    { daemon_cleanup(); }
519  $? = $save_exit_code;
520}
521
5221;
523