Guys,
I have a threaded service written in perl which spawns a child process
and sends STDOUT/STDERR to disk via windows anonymous pipes. The service
works perfectly in test, and has now gone live across several servers in
our company. The service uses Win32::API to call the api CreateProcess
function, needed to explicitly pass in the pipe handles for
STDOUT/STDERR. Occasionally, the service throws an exception at the
point where CreateProcess is called. It's very intermittant, and I can't
really see a pattern, but I have found that changing the code even
slightly - for instance adding a print statement just before
CreateProcess is called - is often enough to make the service behave
properly. This implies to me that I've got some funny race condition,
but my knowledge of C and the API doesn't go far enough to know where to
start looking. Each server has between 5-25 services using this code,
and it doesn't seem to be load related. It's never all the services on
one box that have a problem, just one or two, the others behaving
properly at the same time.
I can't post a sample script that fails, because I can't make it fail in
test, but the routines in question are encapsulated below. Can anyone...
a) see anything silly I'm doing wrong
b) sugest how I might try to get further debugging info?
c) say whether inclusion of Win32::Daemon and/or threads may have an
impact?
One of our C# developers noted that if you are passing pointers to
unmanaged code from C# you need to tell C# to pin the memory locations,
or the garbage collector will clean them up. Does perl behave similarly?
The error reported in the eventlog at the time of the crash is:
Reporting queued error: faulting application perl.exe, version
5.8.1.807, faulting module kernel32.dll, version 5.2.3790.0, fault
address 0x0001202e.
All services running on Windows 2003 Standard edition.
Grateful for any advice :)
Cheers,
Paul
__BEGIN CODE__
use Win32::API;
use constant {
# Process creation
STARTF_USESTDHANDLES => 0x100,
CREATE_NEW_CONSOLE => 0x10,
DETACHED_PROCESS => 0x8,
STD_ERROR_HANDLE => -12,
STD_INPUT_HANDLE => -10,
STD_OUTPUT_HANDLE => -11,
NORMAL_PRIORITY_CLASS => 0x20,
};
Win32::API::Struct->typedef("SECURITY_ATTRIBUTES", qw(
DWORD nLength;
DWORD lpSecurityDescriptor;
BOOL bInheritHandle;
));
Win32::API::Struct->typedef("STARTUPINFO", qw(
DWORD cb;
LPTSTR lpReserved;
LPTSTR lpDesktop;
LPTSTR lpTitle;
DWORD dwX;
DWORD dwY;
DWORD dwXSize;
DWORD dwYSize;
DWORD dwXCountChars;
DWORD dwYCountChars;
DWORD dwFillAttribute;
DWORD dwFlags;
WORD wShowWindow;
WORD cbReserved2;
DWORD lpReserved2;
DWORD hStdInput;
DWORD hStdOutput;
DWORD hStdError;
));
Win32::API::Struct->typedef("PROCESS_INFORMATION", qw(
HANDLE hProcess;
HANDLE hThread;
DWORD dwProcessId;
DWORD dwThreadId;
));
# Function defs
my $CreateProcess = Win32::API->new("kernel32.dll",
"CreateProcess", "PPSSINNPSS", "I");
my $CreatePipe = Win32::API->new("kernel32.dll", "CreatePipe",
"PPSN", "I");
($read, $write) = CreatePipe();
print "READ: $read, WRITE: $write\n";
($pid, $processHandle, $createResult) =
CreateProcess("C:\\winnt\\system32\\cmd.exe", "cmd /c dir c:\\", $write,
"C:\\");
sub CreateProcess {
my $image = shift;
my $cmd = shift;
my $handle = shift;
my $workdir = shift;
# Define SECURITY_ATTRIBUTES struct
my $SECURITY_ATTRIBUTES =
Win32::API::Struct->new("SECURITY_ATTRIBUTES");
$SECURITY_ATTRIBUTES->{nLength} = 12;
$SECURITY_ATTRIBUTES->{lpSecurityDescriptor} = pack("L", 0);
$SECURITY_ATTRIBUTES->{bInheritHandle} = 1;
my $SECURITY_ATTRIBUTES1 =
Win32::API::Struct->new("SECURITY_ATTRIBUTES");
$SECURITY_ATTRIBUTES1->{nLength} = 12;
$SECURITY_ATTRIBUTES1->{lpSecurityDescriptor} = pack("L", 0);
$SECURITY_ATTRIBUTES1->{bInheritHandle} = 1;
# STARTUPINFO struct - handles go here
my $STARTUPINFO = Win32::API::Struct->new("STARTUPINFO");
#$STARTUPINFO->{"dwFlags"} = STARTF_USESTDHANDLES;
$STARTUPINFO->{"dwFlags"} = STARTF_USESTDHANDLES;
$STARTUPINFO->{"hStdOutput"} = $handle;
$STARTUPINFO->{"hStdError"} = $handle;
$STARTUPINFO->{"cb"} = $STARTUPINFO->sizeof;
# Nice empty PROCESS_INFORMATION to get our goodies
my $PROCESS_INFORMATION =
Win32::API::Struct->new("PROCESS_INFORMATION");
my $inheritHandles = 1;
LogPrint("CREATEPROCESS: Just about to create process");
LogPrint("CREATEPROCESS: $image,$inheritHandles,$workdir");
my $createResult;
eval { $createResult = $CreateProcess->Call($image,
$cmd,
$SECURITY_ATTRIBUTES,
$SECURITY_ATTRIBUTES1,
$inheritHandles,
CREATE_NEW_CONSOLE |
NORMAL_PRIORITY_CLASS,
pack("L", NULL),
$workdir,
$STARTUPINFO,
$PROCESS_INFORMATION
);
};
if ($@) { LogPrint("ERROR: $@") };
LogPrint("CREATEPROCESS: Process created");
return( $PROCESS_INFORMATION->{"dwProcessId"},
$PROCESS_INFORMATION->{"hProcess"}, $createResult);
}
sub LogPrint {
my $msg = shift;
print "$msg\n";
}
sub CreatePipe {
# Struct
my $SECURITY_ATTRIBUTES =
Win32::API::Struct->new("SECURITY_ATTRIBUTES");
$SECURITY_ATTRIBUTES->{nLength} = 12;
$SECURITY_ATTRIBUTES->{lpSecurityDescriptor} = pack("L", 0);
$SECURITY_ATTRIBUTES->{bInheritHandle} = 1;
# Create anonymous pipe our process will write to
my $pipeReadHandle = pack("L", "");
my $pipeWriteHandle = pack("L", "");
my $pipeCreationResult = $CreatePipe->Call($pipeReadHandle,
$pipeWriteHandle, $SECURITY_ATTRIBUTES, 2048);
$pipeReadHandle = unpack("L", $pipeReadHandle);
$pipeWriteHandle = unpack("L", $pipeWriteHandle);
return ($pipeReadHandle, $pipeWriteHandle, $pipeCreationResult);
}
*****************************************************************
Gloucester Research Limited believes the information
provided herein is reliable. While every care has been
taken to ensure accuracy, the information is furnished
to the recipients with no warranty as to the completeness
and accuracy of its contents and on condition that any
errors or omissions shall not be made the basis for any
claim, demand or cause for action.
*****************************************************************
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
