Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
use Win32::Daemon; use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1, SplitMultis = +> 1, AllowLoad => 1, qw( :REG_ KEY_READ KEY_WRITE KEY_ALL_ACCESS )); use win32::Process ("DETACHED_PROCESS"); use Win32::Console; use Win32; use Win32::NetResource; use Win32::FileSecurity; use Getopt::Long; use Win32::Lanman; use IO::Handle; #use strict; my ($VERSION)= sprintf("%d.%d", q$Revision: 1.40 $ =~ /(\d+)\.(\d+)/); my ($me) = $0; $me =~ s/.*(\\|\/)([a-zA-Z0-9\.]+)$/$2/; my ($banner) = " $me - version $VERSION\n"; my ($sysmonkey) = "/LMachine/System/CurrentControlSet/Services/sysmon/ +"; my ($paramkey) = $sysmonkey . 'Parameters/'; my ($schedkey) = $paramkey . 'Schedule Dirs/'; my ($jobskey) = $paramkey . 'Code/'; my ($debug,$rkey); my %Config = ( service => 'sysmon', display => 'System Monitoring Service', account => '', password => '', ); &Configure(\%Config); if ( $Config{help} || scalar @ARGV ) { open (MAN,"pod2text $0|"); while (<MAN>) {print " $_";} close MAN; exit 0; }elsif( $Config{install} ) { print "Installing service\n"; InstallService(); exit(); }elsif( $Config{remove} ) { RemoveService(); exit(); }elsif( $Config{reset} ) { SetRegistry(); exit(); }elsif( defined($Config{debug}) ) { if ( $rkey = $Registry->{$sysmonkey} ) { if ($Config{debug} >= 1) { $rkey->{"Parameters/"} = { "Debug" => [ 1 , "REG_SZ" ], }; print "set debug on OK\n"; }else{ $rkey->{"Parameters/"} = { "Debug" => [ 0 , "REG_SZ" ], }; print "set debug off OK\n"; } }else{ print "\n Failed to open registry key $sysmonkey\n"; } exit(); } # Check registry entries are set before starting service unless ( $rkey = $Registry->{$sysmonkey} ) { print <<"EOT"; Registry entries not set for sysmon. The service must be installed before being run. $useage EOT exit(); } my %exec = ( 1 => 'datetime stamp of script has changed', 2 => 'no record of previously executing', 3 => 'scheduled', 4 => 'registry set to force run' ); my (%params,%sched,%scripts,%sparams,$State,$script,$value); ReadRegSettings(); # Start the service...; Win32::Daemon::StartService() || exit(); my ($NewControls) = SERVICE_ACCEPT_STOP || SERVICE_ACCEPT_PAUSE_C +ONTINUE || SERVICE_ACCEPT_SHUTDOWN || SERVICE_ACCEPT_PAR +AMCHANGE || SERVICE_ACCEPT_NETBINDCHANGE; # Win32::Daemon::AcceptedControls( [$NewControls] ); my($PrevState) = SERVICE_START_PENDING; # Register the service Win32::Daemon::ShowService(); my($Buffer) = new Win32::Console(); $Buffer->Display(); $Buffer->Size(80, 120); $Buffer->Window(1, 0, 0, 80, 50); $Buffer->Title("system monitoring service"); $Buffer->Attr( eval($params{Console_FG}) | eval($params{Console_BG}) ) +; $Buffer->Cls( eval($params{Console_FG}) | eval($params{Console_BG}) ); Write("Console Opened\n"); &StartLog; &refresh; if ( $params{"Console"} eq "1" ) { #Write(" showing service...\n"); #Win32::Daemon::ShowService(); }elsif ( $params{"Console"} eq "0" ) { #Win32::Daemon::HideService(); }else{ Write("Registry setting for service show/hide is ambigious\n"); } my ($SERVICE_SLEEP_TIME) = $params{"Sleep Time"}; # How much t +ime do we sleep between polling? my ($REFRESH_COUNT) = $params{"Refresh Count"}; # How often +(in cycles) do we call refresh subroutine my ($TRUNC_LOG_COUNT) = $params{"TruncLogCount"}; # How often +(in cycles) do we call log truncate subroutine my ($refresh_counter) = 1; # Initial Va +lue - force to cycle immediatly my ($PROCESS_COUNT) = $params{"Process Count"}; # How often +(in cycles) do we process schedule scripts.. my ($process_counter) = 1; # Initial Va +lue - force to cycle immediatly my ($trunc_counter) = 1; # Initial Va +lue - to truncate log file if ($params{Debug} > 0 ) { Write ("DEBUG: Sleep Time : $SERVICE_SLEEP_TIME\n"); Write ("DEBUG: Refresh Count : $REFRESH_COUNT\n"); Write ("DEBUG: Truncate Log Count : $TRUNC_LOG_COUNT\n"); foreach (keys %params) { Write( "DEBUG: Param: $_ Val: $params{$_}\n"); } foreach (keys %sched) { Write( "DEBUG: Sched: $_ Val: $sched{$_}\n"); } foreach (keys %scripts) { Write( "DEBUG: Script: $_ Val: $scripts{$_}\n"); } } $debug = $params{Debug}; my(%pr); if ($Config{test}) { Write("called with -test switch - calling main process once only\n") +; &MainCall; # Run main loop once Write("quitting after running with -test switch - finished main proc +ess call\n"); }else{ while ( SERVICE_STOPPED != ( $State = Win32::Daemon::State() ) ){ if( SERVICE_START_PENDING == $State ){ # Initialization code $refresh_counter = 1; # Initial Valu +e - force to cycle immediatly $process_counter = 1; # Initial Valu +e - force to cycle immediatly Win32::Daemon::State( SERVICE_RUNNING ); Write($banner); Write( "Service Started\n" ); $PrevState = SERVICE_RUNNING; }elsif( SERVICE_PAUSE_PENDING == $State ){ # "Pausing..."; Win32::Daemon::State( SERVICE_PAUSED ); Write( "Service Paused\n" ); $PrevState = SERVICE_PAUSED; next; }elsif( SERVICE_CONTINUE_PENDING == $State ){ # "Resuming..."; $refresh_counter = 1; # Initial Valu +e - force to cycle immediatly $process_counter = 1; # Initial Valu +e - force to cycle immediatly Win32::Daemon::State( SERVICE_RUNNING ); Write( "Service Resumed\n" ); $PrevState = SERVICE_RUNNING; next; }elsif( SERVICE_STOP_PENDING == $State ){ Write( "Service Stop Requested\n" ); &KillSpawnedProcesses; # Kill all spawned processes..... Win32::Daemon::State( SERVICE_STOPPED ); $PrevState = SERVICE_STOPPED; Write( "Service Stopped\n" ); next; }elsif( SERVICE_CONTROL_SHUTDOWN == $State ){ # Request 10 seconds to shutdown... Write( "Service Control Shutdown Requested\n" ); Win32::Daemon::State( SERVICE_STOP_PENDING, 10000 ); &KillSpawnedProcesses; # Kill all spawned processes..... Win32::Daemon::State( SERVICE_STOPPED ); Write( "Service Stopped\n" ); $PrevState = SERVICE_STOPPED; }elsif( SERVICE_RUNNING == $State ){ &MainCall; }else{ # Got an unhandled control message Write ("Unhandled Control Message\n"); Win32::Daemon::State( $PrevState ); } # Check for any outstanding commands. Pass in a non zero value # and it resets the Last Message to SERVICE_CONTROL_NONE. if( SERVICE_CONTROL_NONE != ( my $Message = Win32::Daemon::QueryLa +stMessage( 1 ) ) ){ if( SERVICE_CONTROL_INTERROGATE == $Message ){ # Got here if the Service Control Manager is requesting # the current state of the service. This can happen for # a variety of reasons. Report the last state we set. Write ("Recieved Message SERVICE_CONTROL_INTERROGATE\n"); Win32::Daemon::State( $PrevState ); }elsif( SERVICE_CONTROL_SHUTDOWN == $Message ){ # Yikes! The system is shutting down. We had better clean up # and stop. # Tell the SCM that we are preparing to shutdown and that we e +xpect # it to take 10 seconds (so don't terminate us for at least 10 + seconds)... Write( "Service Control Shutdown Requested\n" ); Win32::Daemon::State( SERVICE_STOP_PENDING, 10000 ); &KillSpawnedProcesses; # Kill all spawned processes..... Win32::Daemon::State( SERVICE_STOPPED ); Write( "Service Stopped\n" ); $PrevState = SERVICE_STOPPED; }else{ Write("Message Recieved: $Message\n"); } } sleep( $SERVICE_SLEEP_TIME ); } } exit 0; sub MainCall { # Normal running .... Write ("DEBUG: Main Run routine called\n") if ($params{Debug} > 0 +); # Test to see if its time to truncate the logfile... $trunc_counter --; if ($trunc_counter < 1) { $trunc_counter = $TRUNC_LOG_COUNT; &truncate_file; } # Test to see if its time to refresh... $refresh_counter --; if ($refresh_counter < 1) { &refresh; # refresh service parameters from registry, re-read + schedule jobs... &ReadRegSettings() ; # re-read registry if ($SERVICE_SLEEP_TIME != $params{"Sleep Time"}) { # Ho +w much time do we sleep between polling? if ( $params{"Sleep Time"} ) { # If value exists in registry Write(sprintf "changing Service Sleep Time to %s seconds\n", +$params{"Sleep Time"}); $SERVICE_SLEEP_TIME = $params{"Sleep Time"}; }else{ Write("failed to read service \"Sleep Time\" from registry\n +"); } } if ($REFRESH_COUNT != $params{"Refresh Count"}) { # How +often (in cycles) do we call refresh subroutine if ( $params{"Refresh Count"} ) { # If value exists in registr +y Write(sprintf "changing refresh count to %s cycles before re +-reading registry etc.\n",$params{"Refresh Count"}); $REFRESH_COUNT = $params{"Refresh Count"}; }else{ Write("failed to read service \"Refresh Count\" from registr +y\n"); } } if ($TRUNC_LOG_COUNT != $params{"TruncLogCount"}) { # Ho +w often (in cycles) do we call refresh subroutine if ( $params{"TruncLogCount"} ) { # If value exists in registr +y Write(sprintf "changing truncate log count to %s cycles befo +re re-reading registry etc.\n",$params{"TruncLogCount"}); $TRUNC_LOG_COUNT = $params{"TruncLogCount"}; }else{ Write("failed to read service \"TruncLogCount\" from registr +y\n"); } } if ($PROCESS_COUNT != $params{"Process Count"}) { # How +often (in cycles) do we process schedule scripts.. if ( $params{"Process Count"} ) { # If value exists in registr +y Write(sprintf "changing Process count to %s cycles before re +-reading registry etc.\n",$params{"Process Count"}); $PROCESS_COUNT = $params{"Process Count"}; }else{ Write("failed to read service \"Process Count\" from registr +y\n"); } } if ($debug != $params{"Debug"}) { # Debug value change.. if ( $params{"Debug"} ) { # If value exists in registry Write(sprintf "changing debug to %s \n",$params{"Debug"}); $debug = $params{"Debug"}; } } $refresh_counter = $REFRESH_COUNT; } $process_counter --; Write("DEBUG Process Count: $process_counter\n") if ($params{Debug +} > 0 ); if ($process_counter < 1) { $process_counter = $PROCESS_COUNT; # Check on status of existing spawned processes..... if (%pr) { while (my($script,$ref)=each %pr) { my($ExitCode); my($msg) = " - $script"; $ref->GetExitCode($ExitCode); if ( $ExitCode != 259 ) { Write ("$msg terminated with exit code $ExitCode\n"); delete $pr{$script}; }else{ if (my $pid = $ref->GetProcessID()) { Write ("$msg is still running (PID: $pid)\n"); }else{ Write ("$msg is still running (PID: unable to find PID)\ +n"); } } } } Write("DEBUG: finished checking existing processes\n") if ($para +ms{Debug} > 0 ); ChkScripts: foreach $script (keys %scripts) { my($sched,$ptime,$time,$runtime,$pmtime,$timestamp,$process); Write("DEBUG: Testing if $script is to be executed now\n") if +($params{Debug} > 0 ); my ($exe) = 0; # Set execute flag to zero........ # Open registry key to script values area. my $key = $jobskey . "$script/"; if ($rkey = $Registry->{$key}) { undef %sparams; foreach $value ($rkey->ValueNames) { my( $valueString, $valueType )= $rkey->GetValue($value); $sparams{$value} = $valueString; } }else{ Write("\n Failed to open registry key $key\n"); next ChkScripts; } # Determine DateTimeStamp - and execute script if it has changed my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime +,$ctime,$blksize,$blocks); if ( ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mt +ime,$ctime,$blksize,$blocks) = stat($scripts{$script}) ) { if ( $mtime != hex($sparams{DateTimeStamp}) ) { Write ("DEBUG: DTS of $script has changed\n") if ($params{ +Debug} > 0 ); $exe = 1; # Set to execute - as datetime stamp of script + has changed } unless ( $sparams{LastRunTime} ) { $exe = 2; # Set to execute - as no record of previously e +xecuting }else{ $ptime= $sparams{LastRunTime}; $time = hex($ptime); $runtime = localtime($time); #Write(" last executed $runtime - SchedDir $sparams{\"Sched Dir\"}\n +"); # Find the schedule directory..... $sched = $sparams{"Sched Dir"}; Write(sprintf "DEBUG: %20s %12s %8s %12s\n",$s +cript,$sched,time-$time,$sched{$sched}) if ($params{Debug} > 0 ); if ( (time - $time) > $sched{$sched} ) { $exe = 3 # Scheduled to run now.... } } }else{ Write("Unable to stat $scripts{$script} - removing from sche +dule list\n"); undef $scripts{$script}; } if ( $sparams{ForceRun} && ( $sparams{ForceRun} >= 1 ) ) { $exe = 4; # ForceRun flag set for this programe - so set exe +cute on } if ( $exe >= 1 ) { Write("DEBUG: checking no instance of $script is running\n") + if ($params{Debug} > 0 ); if ( defined $pr{$script} ) { Write("DEBUG: reference exists in \%pr hash for $script\n" +) if ($params{Debug} > 0 ); if (my $pid = $pr{$script}->GetProcessID()) { Write ("unable to spawn $script - a previously launched +copy is running (PID: $pid)\n"); }else{ Write ("unable to spawn $script - a previously launched +copy running (unable to identify PID)\n"); } }else{ Write("DEBUG: launching $script\n") if ($params{Debug} > 0 + ); my($args) = "perl $params{Root}/perl/perlcaller.pl $sparam +s{Log} $scripts{$script}"; my($app) = $^X; $args= Win32::ExpandEnvironmentStrings($args); # - in case + the Log has an ENV to be expanded # Spawn the perlcaller.pl script here. This opens the log file and c +alls the script Write("DEBUG: spawning now...\n") if ($params{Debug} > 0 ) +; if ( Win32::Process::Create( $process, $app, $args, 1, DETACHED_PROCESS, $sparams{"Sched Dir"} ) ) { Write("DEBUG: spawned OK...\n") if ($params{Debug} > 0 ) +; my ($pid); unless ( $pid = $process->GetProcessID() ) { Write("DEBUG: can't determine pid\n") if ($params{Debu +g} > 0 ); } Write("spawned $script PID:$pid ($exec{$exe})\n"); $pr{$script} = $process; # Add process reference to has +h of process references if ($params{Debug} > 0 ) { Write(" app : $app\n"); Write(" args: $args\n"); Write(" dir : " . $sparams{"Sched Dir"} . "\n" ); + } # Identify and record run time in registry $time = time; $ptime = pack("L",$time); $pmtime = pack("L",$mtime); $runtime = localtime($time); $timestamp = localtime($mtime); # Record the rundate as a value $rkey->SetValue( "LastRunTime" , pack("L",$time) , " +REG_DWORD" ); $rkey->SetValue( "Last Run Time" , $runtime , " +REG_SZ" ); $rkey->SetValue( "DateTimeStamp" , pack("L",$mtime) , " +REG_DWORD" ); $rkey->SetValue( "Date Time Stamp", $timestamp , " +REG_SZ" ); # Set ForceRun to 0 if it was set if ( $sparams{ForceRun} ) { $rkey->SetValue( "ForceRun" , 0 , " +REG_SZ" ); } # Don't spawn more than one script at a time....wait for next cycle if ( $params{"Max Processes"} ) { my(@KEYS) = keys %pr; # create array of keys of %pr - +to identify number of elements last ChkScripts if ($#KEYS >= ($params{"Max Processes" +}-1) ); # launch no more processes if Max Processes exceeded (incl th +is one) }else{ Write("Max Processes value missing from registry\n"); last ChkScripts; } }else{ Write("unable to spawn $script $args\n"); } } } } } } sub GetServiceConfig { my $ScriptPath = join( "", Win32::GetFullPathName( $0 ) ); my %Hash = ( name => $Config{service}, display => $Config{display}, path => $^X, user => $Config{account}, password => $Config{password}, parameters => "\"$ScriptPath\"", description=> "sysmon is a schedule framework that runs as a serv +ice, calling system monitoring tasks.", ); $Hash{parameters} .= " -debug" if( $Config{debug} ); $Hash{parameters} .= " -console" if( $Config{console} ); $Hash{parameters} .= " -nopage" if( $Config{nopage} ); return( \%Hash ); } sub InstallService { my @SidList; my @accounts = ( $Config{account} ); #print "Finding SID for $Config{account}\n"; if ( Win32::Lanman::LsaLookupNames( "",\@accounts,\@SidList ) ) { foreach my $Sid ( @SidList ) { my @privileges; if ( Win32::Lanman::LsaEnumerateAccountRights("", $Sid->{sid}, \ +@privileges)) { push (@privileges,SE_SERVICE_LOGON_NAME,SE_INTERACTIVE_LOGON_N +AME); #print "Privs: @privileges\n"; if (Win32::Lanman::LsaAddAccountRights( "",$Sid->{sid},\@privi +leges ) ) { print "Added \n \"Logon As Service\" and \"Interactive Log +on\"\n rights for $Config{account}\n"; }else{ print "Failed to add \n \"Logon As Service\" and \"Interac +tive Logon\"\n rights for $Config{account}\n"; } }else{ print "Failed to enumerate privileges for $Config{account}\n"; } } }else{ print "Unable to find SID for $Config{account}\n"; } my $ServiceConfig = GetServiceConfig(); if( Win32::Daemon::CreateService( $ServiceConfig ) ) { print "The $ServiceConfig->{display} was successfully installed.\n +"; } else { print "Failed to add the $ServiceConfig->{display} service.\nError +: " . GetError() . "\n"; } SetRegistry(); } sub SetRegistry { if ( $rkey = $Registry->{$sysmonkey} ) { my($sysmonroot) = Win32::ExpandEnvironmentStrings("%SystemDrive%/s +ysmon"); my($sysmonlogs) = Win32::ExpandEnvironmentStrings("%SystemDrive%/s +ysmon-logs"); $rkey->{"Parameters/"} = { "Root" => [ $sysmonroot , "REG_SZ" ], "Logs" => [ $sysmonlogs , "REG_SZ" ], "SysMonLogLines"=> [ "10000" , "REG_SZ" ], "SysMonLogAge" => [ "100" , "REG_SZ" ], "Sleep Time" => [ "5" , "REG_SZ" ], # Max tim +e before we respond to svc manager "Refresh Count" => [ "100" , "REG_SZ" ], # "Process Count" => [ "12" , "REG_SZ" ], "TruncLogCount" => [ "8000" , "REG_SZ" ], "Debug" => [ $debug , "REG_SZ" ], "Max Processes" => [ "3" , "REG_SZ" ], # Max no +of processes sysmon is allowed "Console_BG" => [ "BACKGROUND_BLUE", "REG_SZ" ], # Consol +e Background Colour "Console_FG" => [ "\$FG_YELLOW" , "REG_SZ" ], # Console + Foreground Colour "Console" => [ "1" , "REG_SZ" ], # Console + (1 = Visible, 0 = Not) "Schedule Dirs/" => { "allways" => ["1" , "REG_SZ" ], "daily" => ["86400" , "REG_SZ" ], "6hourly" => ["21960" , "REG_SZ" ], "hourly" => ["3660" , "REG_SZ" ], "weekly" => ["604800" , "REG_SZ" ], "oneoff" => ["999999999", "REG_SZ" ], }, "Code/" => { }, }; $rkey->SetValue( "Type" , "0x110" , "REG_DWORD" ); # 0x110 - d +isplay console, else 0x10 print "sysmon service configured OK\n"; }else{ print "\n Failed to open registry key $sysmonkey \n - check that s +ysmon is installed as a service\n"; } } sub RemoveService { my $ServiceConfig = GetServiceConfig(); if( Win32::Daemon::DeleteService( $ServiceConfig->{name} ) ) { print "The $ServiceConfig->{display} was successfully removed.\n"; } else { print "Failed to remove the $ServiceConfig->{display} service.\nEr +ror: " . GetError() . "\n"; } } sub GetError { return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) ); } sub Write { my( $Message ) = @_; $Message = "[" . scalar( localtime() ) . "] $Message"; if (defined $Buffer) { $Buffer->Write($Message); } print $Message; } sub StartLog { # Verify the log directory exists if ( $params{Logs} && ( ! -d $params{Logs} ) ) { if ( mkdir ($params{Logs},0777) ) { Write("Created log directory $params{Logs}\n"); }else{ Write("Unable to create log directory $params{Logs}\n"); } } if ( $params{Logs} && ( -d $params{Logs} ) ) { # Set directory permissions my($dir_sec) = Win32::FileSecurity::MakeMask(qw(FULL GENERIC_ALL)) +; my(%hash); $hash{"Administrator"} = $dir_sec; $hash{"Administrators"} = $dir_sec; Win32::FileSecurity::Set($params{Logs}, \%hash); # Share the log directory as sysmon$ (allows remote collection of logs + etc.) my($sh) = "sysmon\$"; my($shpath,$ShareInfo); if (Win32::NetResource::NetShareGetInfo( $sh, $ShareInfo )){ $shpath = $$ShareInfo{path}; $shpath =~ s/\\/\//g; } if ( $shpath ne $params{Logs} ) { Write("Need to do something about the share\n"); Write("Current Path $shpath\n"); Write("Required Path $params{Logs}\n"); # Delete old share (if it exists) if ( $shpath ) { if (Win32::NetResource::NetShareDel( $sh )) { Write("Removed incorrect sysmon log share $sh\n"); }else{ Write("Failed to delete sysmon log share $sh\n"); } } # Add the share...... my($ShareInfo) = { 'path' => $params{Logs}, 'netname' => $sh, 'remark' => "Sysmon Log Directory", 'passwd' => "", 'current-users' => 0, 'permissions' => 0, 'maxusers' => -1, 'type' => 0, }; my($parm); if (Win32::NetResource::NetShareAdd( $ShareInfo,$parm )) { Write("Added sysmon log share OK as $sh\n"); }else{ Write("Failed to add share for sysmon log directory ( $parm ) +\n"); } } } # Divert STDOUT and STDERR to log file if running as a service my ( $DB_FILE ) = "$params{Logs}/sysmon.log"; open(LOG,">> $DB_FILE") || Err("can't append to log_file \"$DB_FILE\ +": $!");# && exit 1; #open(STDOUT,">&LOG") || Err("can't redirect stdout: $!");# && ex +it 1; select LOG; open(STDERR,">&LOG") || Err("can't redirect stderr: $!");# && exi +t 1; # Enable Autoflush LOG->autoflush(1); STDOUT->autoflush(1); STDERR->autoflush(1); # if( open( LOG, ">> $DB_FILE" ) ) # { # Write("Opened log $DB_FILE\n"); # select LOG; # $|=1; # }else{ # Write("Failed to open log $DB_FILE\n"); # } } sub ReadRegSettings { # read sysmon parameters from registry if ($rkey = $Registry->{$paramkey} ) { undef %params; foreach $value ($rkey->ValueNames) { my( $valueString, $valueType )= $rkey->GetValue($value); $params{$value} = $valueString; } }else{ &Err("Failed to open registry key $paramkey\n"); } } sub refresh { my $schedule; if ( $params{"Root"} ) { Write("DEBUG: finding executable files in schedule\n") if ($params +{Debug} > 0 ); undef %scripts; $schedule = $params{"Root"} . '/schedule'; $schedule =~ s/\/\//\//; # sub a // for / } # read script dirs from registry if ($rkey = $Registry->{$schedkey} ) { undef %sched; foreach $value ($rkey->ValueNames) { my( $valueString, $valueType )= $rkey->GetValue($value); $sched{$schedule . '/' . $value} = $valueString; } }else{ &Err( "Failed to open registry key $schedkey\nThis is required for + the sysmon service\nSetting default registry entries\n"); SetRegistry(); return; } # find executable files in the schedule file structure undef %scripts; foreach my $dir (keys %sched) { #Write("** searching $dir\n"); if ( $rkey = $Registry->{$jobskey} ) { if ( chdir $dir ) { foreach (<*.*>) { next unless m/\.(pl|cmd|bat)$/i; # Ignore all but perl or +batch files $scripts{$_} = $dir . '/' . $_; my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($_); my($pmtime) = pack("L",$mtime); # Create log dir entry... my ($log) = $params{'Logs'} . '/' . $_; $log =~ s/\.([a-zA-Z0-9]+)$/\.log/; $rkey->{"$_/"} = { "DateTimeStamp" => [ $pmtime , "REG_DWORD" ], "Sched Dir" => [ $dir , "REG_SZ"], "Log" => [ $log , "REG_SZ"] }; } } else{ Write ("unable to chdir to $dir\n"); } } else{ print "Failed to open registry key $jobskey\n"; } } } sub Err{ my ($message) = @_; $message = "ERROR: $message"; Write($message); sleep 1; } sub Configure { my( $Config ) = @_; my $WarnSub = $SIG{__WARN__}; #undef $SIG{__WARN__}; Getopt::Long::Configure( "prefix_pattern=(-|\/)" ); GetOptions( $Config, qw( install remove reset account=s password=s debug=s nodebug help test ) ); $SIG{__WARN__} = $WarnSub; } sub KillSpawnedProcesses { # Kill all spawned processes..... if (%pr) { while (my($script,$ref)=each %pr) { my($ExitCode); my($msg) = "child $script"; $ref->GetExitCode($ExitCode); if ( $ExitCode != 259 ) { Write ("$msg (terminated with exit code $ExitCode)\n"); delete $pr{$script}; }else{ # Kill remaining processes if (my $pid = $ref->GetProcessID()) { if ( $ref->Kill( 0 ) ) { $ref->GetExitCode($ExitCode); Write ("$msg (PID: $pid) killed (exit code $ExitCode)\n"); delete $pr{$script}; }else{ Write ("$msg (PID: $pid) failed to kill !\n"); } }else{ Write ("$msg killed (PID: unable to find PID)\n"); } } } } } sub truncate_file { my($line, $lines); my @array = (); my ($size) = $params{SysMonLogLines}; # Max number of lines in the +log file my ($age) = $params{SysMonLogAge}; # Max age of records in the l +og file (in days). To be implemented.... my ( $DB_FILE ) = "$params{Logs}/sysmon.log"; #my ( $T_LOG ) = $DB_FILE; #$T_LOG =~ s/\.log/\.tmp\.log/; #if( open( TLOG, ">> $T_LOG" ) ) #{ # Write("Opened log $T_LOG\n"); # select TLOG; # $|=1; #}else{ # Write("Failed to open temp log $T_LOG\n"); #} #close LOG; my($err) = 0; if( open( FILE, "+>> $DB_FILE" ) ) { # Read file into array while (<FILE>) { push(@array,$_) } close(FILE); # Truncate array and write back to file if ( ($lines = @array) > $size ) { if (open(FILE,"> $DB_FILE")) { for($line = $lines - $size ; $line < $lines; $line++) { print FILE $array[$line]; } $line = $lines - $size ; close(FILE); }else { $err =1; } } }else { $err = 3; } #close TLOG; #&StartLog; if ( $err == 0 ) { if ( $lines > $size ) { Write("Truncated Log File from $lines to $size lines (starting a +t $line)\n"); } }elsif( $err == 1 ) { Err("Truncate Log File - Can't write to file \"$DB_FILE\": $! \n" +); }elsif( $err == 2 ) { Err("Truncate Log File - ????: $!\n"); }elsif( $err == 3 ) { Err("Truncate Log File - Can't open file \"$DB_FILE\": $!\n"); }elsif( $err == 4 ) { Err("Truncate Log File - ????: $!\n"); }else{ Err("Truncate Log File - unknown file truncate error\n"); } } 1; __END__ =head1 NAME sysmon.pl =head1 SYNOPSIS sysmon.pl [-install [-account=XX] [-password=XX] | -remove | -rese +t ] [-help] [-debug=X] [-test] =head1 DESCRIPTION This script controls the System Monitoring Service (SysMon). SysMon i +s an NT service that executes various perl scripts and command files using a non-deterministic sched +ule. SysMon allows scripts to be added and removed as it executes, and creates a log of each scri +pts execution, as well as a history of previous executions. SysMon is configured significantly from registry settings - whose defa +ults are configured when the service is installed. If the service is installed as System, and allowed to interact with th +e desktop, a console is generated for monitoring purposes. The SysMon service also creates a circular log file for recording its +actions. =head1 OPTIONS =over 4 =item -install install sysmon as a service (this can also be used with the account an +d password =item -account the account name the service is to run with (the default option is to +use the System account) =item -password the password for the account =item -remove remove sysmon service =item -reset set default registry settings for the service. =item -debug set verbose (or debug) option (0=off, 1 =on). This can be executed wi +th service running, and will eventually be re-read by the service after which verbose outp +ut will be switched on =item -help show short help message =back =head1 REGISTRY SETTINGS The SysMon is broardly configured through its registry settings. Thes +e are all located at HKLM/System/CurrentControlSet/Services/sysmon/Parameters =over 4 =item Root (REG_SZ) The location of the SysMon directory structure - %SystemDrive%/sysmon +by default =item Logs (REG_SZ) The location of the SysMon service logs - %SystemDrive%/sysmon-logs by + default =item SysMonLogLines (REG_SZ) The number of lines to be maintain in the SysMon log file - deafult 10 +000 =item SysMonLogAge (REG_SZ) The maximum age in days of any entry in the SysMon log file - default +100 (not yet implemenetd =item Sleep Time (REG_SZ) The maximum time interval in seconds before the service responds to th +e service manager =item Refresh Count (REG_SZ) The number of cycles after which SysMon re-reads its registry settings + - default 100. (so using default settings the registry will be re-read every 500 seco +nds) =item Process Count (REG_SZ) The number of cycles after which SysMon service will check to determin +e if any further processes should be spawned, and to report on existing child processes +. - default 12 =item TruncLogCount (REG_SZ) default 8000 =item Debug (REG_SZ) Set to 0 (default) for normal output, and 1 for verbose. =item Max Processes (REG_SZ) The maximum number of processes the SysMon service will generate. If +a script is scheduled or readyto be spawned, and this limit is reached, it will wait until the +number of processes reduces below the macximum - default 3. =item Console_BG (REG_SZ) The console background - set to BACKGROUND_BLUE by default =item Console_FG (REG_SZ) The console foreground (text) colour - set to $FG_YELLOW by default =item Console (REG_SZ) A flag to set the console visible (default 1) or hidden (0) =back The HKLM/System/CurrentControlSet/Services/sysmon/Parameters/Schedule Dirs key contains the names of directories that contain scripts to be executed to a given routine. + The actual directory locations are under the "schedule" directory in the SysMon service Roo +t. The values given below are the default locations, with the scheduled time between script executio +n given in seconds. allways => 1 daily => 86400 6hourly => 21960 hourly => 3660 weekly => 604800 oneoff => 999999999 Additional values for other directories can be added. The HKLM/System/CurrentControlSet/Services/sysmon/Parameters/Code key will have a sub-key created for each script oidentified in a schedule directory. The SysM +on service will maintain key data for each script within this sub-key. This includes the follo +wing values:- =over 4 =item Date Time Stamp (REG_SZ) The date/time of the script - in human readable form =item DateTimeStamp (REG_DWORD) The date/time stamp of the script. If this is seen to have changed (s +cripts are checked at every Process Count) the script will be re-executed as soon a permitted. =item Last Run Time (REG_SZ) The last date/time when the script was executed by the SysMon service +- in human readable form =item LastRunTime (REG_SZ) The last date/time when the script was executed by the SysMon service. + This, together with the schedule period identified by the scedule directory in which the script is loca +ted, is used to determine the next execution time. =item Log (REG_SZ) The log file used to record the STDOUT and STDERR from the script exec +ution. This is derived by the service from the script name and the Logs value =item Sched Dir (REG_SZ) The schedule directory in which the script is located =back =head1 REQUIRED MODULES Win32::Daemon Win32::TieRegistry win32::Process Win32::Console Win32 Win32::NetResource Win32::FileSecurity Getopt::Long Win32::Lanman IO::Handle =head1 SEE ALSO =head1 EXAMPLES =head1 TO DO =head1 AUTHOR Dave Roberts =head1 SUPPORT You can send bug reports and suggestions for improvements on this modu +le to me at DaveRoberts@iname.com. However, I can't promise to offer any other support for this script. =head1 COPYRIGHT This script is Copyright © 2000, 2001 Dave Roberts. All rights reserve +d. This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This script is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. The copyright holder of this script can not be held liable for any general, special, incidental or consequential damages arising out of the use of the script. =head1 CHANGE HISTORY $Log: sysmon.pl $ Revision 1.40 2001/12/18 18:25:44 Dave.Roberts corrected service management errors Revision 1.38 2001/12/14 11:35:51 Dave.Roberts added pod, and used this for the -help option =cut

In reply to sysmon.pl by DaveRoberts

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (6)
As of 2024-03-29 01:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found