Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

sysmon.pl

by DaveRoberts (Novice)
on Jan 21, 2002 at 17:17 UTC ( #140381=sourcecode: print w/ replies, xml ) Need Help??

Category: Win32 Stuff
Author/Contact Info DaveRoberts@iname.com
Description: This script controls the System Monitoring Service (SysMon). SysMon is an NT service that executes various perl scripts and command files using a non-deterministic schedule. SysMon allows scripts to be added and removed as it executes, and creates a log of each scripts execution, as well as a history of previous executions. I use this to distribute scripts to, and to manage, around 30 NT based servers on a relativly thin network. see POD for more info. Note that this script requires the perlcaller script to operate succesfully....
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

Comment on sysmon.pl
Download Code
Re: sysmon.pl
by Anonymous Monk on Apr 02, 2002 at 14:03 UTC
    Dave, I have to congratulate you on a very nice piece of code. This is the most usable Win32::Daemon code that I've come across.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://140381]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2014-07-10 02:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (198 votes), past polls