view release on metacpan or  search on metacpan

tests/pNET.mtest  view on Meta::CPAN

# Hej, Emacs, give us -*- perl -*- mode here!
#
#   $Id: pNET.mtest,v 1.1.1.1 1999/07/13 08:14:45 joe Exp $
#
# database specific definitions for the DBI proxy 'DBD::pNET'


#
#   DSN being used; EDIT THIS!
#
my $cipherDef = "";
my ($hostname, $dsn);
if (!$test_dsn) {
    die "Need \$test_dsn being set in lib.pl.\n";
}
if ($dbdriver eq 'Ingres') {
    $hostname = $ENV{'II_HOST'} || $ENV{'PNET_HOST'} || 'localhost';
} else {
    $hostname = $ENV{'PNET_HOST'} || 'localhost';
}
TryToConnect($hostname, $test_dsn, $test_user, $test_password);
$dsn = "DBI:pNET:hostname=$hostname:port=3334";
$@ = '';
eval "use Crypt::DES";
if (!$@) {
    $dsn .= ":key=0123456789abcdef:cipher=DES";
    $cipherDef .= "        encryption DES\n"
	. "        key 0123456789abcdef\n"
	    . "        encryptModule Crypt::DES\n";
    eval "use Crypt::IDEA";
    if (!$@) {
	$dsn .= ":userkey=0123456789abcdef0123456789abcdef"
	    . ":usercipher=IDEA";
	$cipherDef .= "        $test_user encrypt=\"Crypt::IDEA,IDEA,"
	    . "0123456789abcdef0123456789abcdef\"\n"
	    }
}
$test_dsn = "$dsn:dsn=DBI:$dbdriver:test";


#  For testing DBD::pNET, we need a server available. So, fork
#  a child and let it run as a server.

$childPid = undef;

sub childGone () {
    my $pid = wait;
    if (defined($childPid) && $pid == $childPid) {
	undef $childPid;
    }
    $SIG{'CHLD'} = \&childGone;
}

sub StartServer () {
    my ($path, $file, $clients);
    if (!open(CLIENTS, ">t/clients")) {
	die "Cannot create 'clients' file: $!\n";
    }
    print CLIENTS <<"EOF";
accept localhost
	users $test_user
$cipherDef

deny .*
EOF
    close(CLIENTS);

    foreach $file ("./blib/script/pNETagent",
		   "../blib/script/pNETagent",
		   "./pNETagent",
		   "../pNETagent") {
	if (-x $file) {
	    $path = $file;
	    last;
	}
    }

    if (!$path) {
	die "Cannot find pNETagent script.\n";
    }

    $SIG{'CHLD'} = \&childGone;

    my $pid;
    if (!defined($pid = fork())) {
	die "Cannot fork: $!";
    }
    if (!$pid) {
	# This is the child, start as the server