Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

sysmon.pl

by DaveRoberts (Novice)
on Jan 21, 2002 at 17:17 UTC ( [id://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
Replies are listed 'Best First'.
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.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2024-03-28 13:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found