Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

146 lines
3.8 KiB

package cookie;
use strict;
use lib $ENV{RAZZLETOOLPATH};
use Win32::Event;
use Win32::IPC;
use Logmsg;
# declare globals for this package
my( $LogFile, $ScriptName, $Ext );
$LogFile = $ENV{ "LOGFILE" };
unless ( defined( $LogFile ) ) {
$0 =~ /(.*)\.(.*?)$/;
$ScriptName = $1;
$Ext = "\L$2";
if ( $Ext ne "log" ) { $LogFile = $ScriptName . ".log"; }
else { $LogFile = $ScriptName . ".logfile"; }
}
return( 1 );
#
# CreateCookie( $CookieName )
#
# this routine will firstly query to make sure an event with the requested name
# does not yet exist. if it doesn't, it attempts to create an event. upon
# failure of either of these tasks, we log an error and return undef. upon
# success, we return the event created.
#
sub CreateCookie
{
# get passed args
my( $CookieName ) = @_;
# declare locals
my( $Event );
# check to make sure we don't already have a cookie with this name
if ( &QueryCookie( $CookieName ) ) {
errmsg( "A cookie with name '$CookieName' already exists.",
$LogFile );
return( undef );
}
$Event = Win32::Event->new( 1, 0, $CookieName );
unless ( defined( $Event ) ) {
errmsg( "Failed to create cookie '$CookieName'.", $LogFile );
return( undef );
}
# at this point, we've created our cookie.
# just return the cookie name.
return( $Event );
}
#
# QueryCookie( $CookieName )
#
# this routine will simply query to see if a cookie with the given name already
# exists. if so, we return the event. if not, we return undef.
#
sub QueryCookie
{
# get passed args
my( $CookieName ) = @_;
# declare locals
my( $Event );
$Event = Win32::Event->open( $CookieName );
# at this point, if event is defined, we created the cookie. if not, we
# didn't. so event is what we want to return.
return( $Event );
}
#
# KillCookie( $CookieName, $ForceKill )
#
# BUGBUG
# perl does not support a kill for events! thus, we can't really kill an
# event using the Win32::Event module. so instead, we just return undef.
#
# this routine will kill the cookie with the given name. if the $ForceKill
# parameter is true (non-undef), it will not report errors attempting to kill
# the cookie. if the kill succeeds, we return the cookie name, otherwise undef.
#
sub KillCookie
{
# get passed args
my( $CookieName, $ForceKill ) = @_;
# declare locals
my( $ReturnCode );
# BUGBUG
# perl doesn't support a kill for events, so just return for now.
return( undef );
# close the event
$ReturnCode = Win32::Event->close( $CookieName );
if ( $ReturnCode != 0 ) {
if ( ! ( defined( $ForceKill ) ) ) {
errmsg( "Failed to kill cookie '$CookieName'.",
$LogFile );
}
return( undef );
}
# we successfully killed the cookie, return the cookie name.
return( $CookieName );
}
#
# CreateCookieQuiet( $CookieName )
#
# this routine will firstly query to make sure an event with the requested name
# does not yet exist. if it doesn't, it attempts to create an event. upon
# failure of either of these tasks, we log an error and return undef. upon
# success, we return the event created.
#
# this routine differs from CreateCookie in that it will not attempt any
# logging.
#
sub CreateCookieQuiet
{
# get passed args
my( $CookieName ) = @_;
# declare locals
my( $Event );
# check to make sure we don't already have a cookie with this name
if ( &QueryCookie( $CookieName ) ) {return( undef ); }
$Event = Win32::Event->new( 1, 0, $CookieName );
unless ( defined( $Event ) ) {return( undef ); }
# at this point, we've created our cookie.
# just return the cookie name.
return( $Event );
}