1# -*- perl -*- 2# 3# $Id: config.t,v 1.2 1999/08/12 14:28:59 joe Exp $ 4# 5require 5.004; 6use strict; 7 8use IO::Socket (); 9use Config (); 10use Net::Daemon::Test (); 11use Socket (); 12 13 14my $CONFIG_FILE = "t/config"; 15my $numTests = 5; 16 17 18sub RunTest ($$) { 19 my $config = shift; my $numTests = shift; 20 21 if (!open(CF, ">$CONFIG_FILE") || !(print CF $config) || !close(CF)) { 22 die "Error while creating config file $CONFIG_FILE: $!"; 23 } 24 25 my($handle, $port) = Net::Daemon::Test->Child 26 ($numTests, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', '--debug', 27 '--mode=single', '--configfile', $CONFIG_FILE); 28 my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1', 29 'PeerPort' => $port); 30 my $result; 31 my $success = $fh && $fh->print("1\n") && 32 defined($result = $fh->getline()) && $result =~ /2/; 33 $handle->Terminate(); 34 $success ? "" : "not "; 35} 36 37 38print "Testing config file with open client list.\n"; 39my $ok = RunTest(q/{'mode' => 'single', 'timeout' => 60}/, 40 $numTests); 41print "${ok}ok 1\n"; 42 43print "Testing config file with client 127.0.0.1.\n"; 44$ok = RunTest(q/ 45 { 'mode' => 'single', 46 'timeout' => 60, 47 'clients' => [ { 'mask' => '^127\.0\.0\.1$', 'accept' => 1 }, 48 { 'mask' => '.*', 'accept' => 0 } 49 ] 50 }/, undef); 51print "${ok}ok 2\n"; 52 53print "Testing config file with client !127.0.0.1.\n"; 54$ok = RunTest(q/ 55 { 'mode' => 'single', 56 'timeout' => 60, 57 'clients' => [ { 'mask' => '^127\.0\.0\.1$', 'accept' => 0 }, 58 { 'mask' => '.*', 'accept' => 1 } 59 ] 60 }/, undef); 61print(($ok ? "" : "not "), "ok 3\n"); 62 63my $hostname = gethostbyaddr(Socket::inet_aton("127.0.0.1"), 64 Socket::AF_INET()); 65if ($hostname) { 66 my $regexp = $hostname; 67 $regexp =~ s/\./\\\./g; 68 print "Testing config file with client $hostname.\n"; 69 $ok = RunTest(q/ 70 { 'mode' => 'single', 71 'timeout' => 60, 72 'clients' => [ { 'mask' => '^/ 73 . $regexp . q/$', 'accept' => 1 }, 74 { 'mask' => '.*', 'accept' => 0 } 75 ] 76 }/, undef); 77 print "${ok}ok 4\n"; 78 79 print "Testing config file with client !$hostname\n"; 80 $ok = RunTest(q/ 81 { 'mode' => 'single', 82 'timeout' => 60, 83 'clients' => [ { 'mask' => '^/ 84 . $regexp . q/$', 'accept' => 0 }, 85 { 'mask' => '.*', 'accept' => 1 } 86 ] 87 }/, undef); 88 print(($ok ? "" : "not "), "ok 5\n"); 89} else { 90 print "ok 4 # skip\n"; 91 print "ok 5 # skip\n"; 92} 93 94END { 95 if (-f "ndtest.prt") { unlink "ndtest.prt" } 96} 97