132 lines
3.1 KiB
Perl
132 lines
3.1 KiB
Perl
#!perl -w
|
|
|
|
package PerlSvc;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Net::Ping::External qw(ping);
|
|
|
|
my $service = 'Pingz';
|
|
my $servno = 0;
|
|
my $logfile = 'c:/Pingz.log';
|
|
my $configfile = 'c:/Pingz.conf';
|
|
my $delay = 1;
|
|
|
|
my @options = ('log=s' => \$logfile,
|
|
'config=s' => \$configfile,
|
|
);
|
|
|
|
# turn on autoflush
|
|
$|=1;
|
|
|
|
(my $progname = $0) =~ s/.*?([^\\]+?)(\.\w+)$/$1/;
|
|
our(%Config,$Verbose);
|
|
|
|
sub get_options {
|
|
require Getopt::Long;
|
|
my @options = @_;
|
|
my $usage = pop @options;
|
|
$SIG{__WARN__} = sub { print "$usage\n$_[0]"; exit 1 };
|
|
Getopt::Long::GetOptions(@options);
|
|
$SIG{__WARN__} = 'DEFAULT';
|
|
}
|
|
sub configure {
|
|
%Config = (ServiceName => "Pingz",
|
|
DisplayName => "Pingz",
|
|
Parameters => "--log $logfile --config $configfile",
|
|
Description => "Pingz");
|
|
}
|
|
sub Startup {
|
|
get_options(@options, <<__USAGE__);
|
|
Try `$progname --help` to get a list of valid options.
|
|
__USAGE__
|
|
|
|
Log("\n$Config{DisplayName} starting at: ".localtime);
|
|
my ($FILE)=@ARGV;
|
|
open FH, "<$configfile";
|
|
my @CONF=<FH>;
|
|
close FH;
|
|
while (ContinueRun($delay)) {
|
|
my $ok;
|
|
my $err=" ";
|
|
my $wrlog=0;
|
|
foreach my $line (@CONF) {
|
|
chomp $line;
|
|
next if ($line =~ /^#/);
|
|
$ok=ping(hostname => "$line", count => 1, size => 32, timeout => 1);
|
|
$err=$err . "$line:$ok ";
|
|
$wrlog=1 if ($ok==0);
|
|
}
|
|
Log(localtime()."$err") if ($wrlog);
|
|
}
|
|
Log("$Config{DisplayName} stopped at: ".localtime);
|
|
}
|
|
sub Log {
|
|
my $msg = shift;
|
|
open(my $f, ">>$logfile") or die $!;
|
|
print $f "$msg\n";
|
|
close $f;
|
|
}
|
|
sub Install {
|
|
#get_options('name=s' => \$service, @options, <<__USAGE__);
|
|
get_options(@options, <<__INSTALL__);
|
|
Valid --install suboptions are:
|
|
|
|
auto automatically start service
|
|
--log log file name [$logfile]
|
|
--config config file name [$configfile]
|
|
|
|
For example:
|
|
|
|
$progname --install auto --log logfile --config configfile
|
|
|
|
__INSTALL__
|
|
|
|
configure();
|
|
}
|
|
sub Help {
|
|
print <<__HELP__;
|
|
|
|
Sends WakeOnLan Packets to MAC addresses defined in configfile
|
|
|
|
Install it as a service:
|
|
|
|
$progname --install auto --log logfile --config configfile
|
|
net start $service
|
|
|
|
You can pause and resume the service with:
|
|
|
|
net pause $service
|
|
net continue $service
|
|
|
|
To remove the service from your system, stop und uninstall it:
|
|
|
|
net stop $service
|
|
$progname --remove
|
|
|
|
servicenumber defaults to 0
|
|
logfile defaults to c:\\Pingz.log
|
|
configfile defaults to c:\\Pingz.conf
|
|
__HELP__
|
|
|
|
# Don't display standard PerlSvc help text
|
|
$Verbose = 0;
|
|
}
|
|
sub Pause {
|
|
Log("$Config{ServiceName} is about to pause at ".localtime);
|
|
}
|
|
sub Continue {
|
|
Log("$Config{ServiceName} is continuing at ".localtime);
|
|
}
|
|
sub Remove {
|
|
# get_options('service=s' => \$servno, <<__REMOVE__);
|
|
#Valid --remove suboptions are:
|
|
# --service service number [$servno]
|
|
#
|
|
#For example:
|
|
#
|
|
# $progname --remove --service 0
|
|
#__REMOVE__
|
|
$Config{ServiceName} = "$service";
|
|
$Config{DisplayName} = "$service";
|
|
} |