Листинг 1. Команды загрузки PPM.
ppm
install net-ping
set repository RTO http://rto.dk/packages/
set save
install mail-sendmail
quit
Листинг 2. Фрагмент сценария
TheftDetector.pl.
use Mail::Sendmail;
use Net::Ping;
use strict;
system («title Theft detection script»);
system («color 1F»);
# название сценария: 
# назначение: проверка ответа компьютеров на запрос ping
# требуется два входных файла: 
# TestObjects.txt содержит список всех опрашиваемых компьютеров.
# PagerRecipients.txt - список адресов электронной 
почты всех получателей сообщений
# сценарий запускается как задача на одной из машин, которые точно не отключаются на ночь
# Указывает сервер SMTP, через который отправляются сообщения на пейджер.
 
A
 $main::SMTP_Server=»mail.yourcompany.com»;
 
# Задает имя, от которого отправляются сообщения

B
 $main::Sender = 'fredsmith@yourcompany.com';

# Задает местоположение файлов TestObjects.txt и
PagerRecipients.txt.

C
 $main::pathtoobjectslist=»D:ScriptsTestObjects.txt»;
 $main::pathtopagerlist=»D:ScriptsPagerRecipients.txt»;
 
# определяет папку для создания файлов журнала
 
D
$main::pathtologfile=»D:ScriptsLogs»;

# создаем папку для журналов, если таковой еще нет
if ( ! -e $main::pathtologfile) {
print «$main::pathtologfile does not exist attempting creation
»;
mkdir ($main::pathtologfile, 0777) || die «Can't create log file folder: $!»;
}
# определяем дату и время для файла журнала
$main::datetime =localtime(time);
$main::datetime =~ s/ / /g;
$main::datetime =~ s/:/./g;
# формируем имя файла журнала
$main::pathtologfile= «$main::pathtologfile$main::datetime FailureLog.txt»;
# читаем имена получателей сообщений, если не 
получается - выдаем сообщение об ошибке
open(OBJECTFILE,»<$main::pathtoobjectslist») || die
 «Unable to open test objects file!»;
 my @Object_array = ;
 close(OBJECTFILE) || die «close0: $!»;
%main::server;
@main::pinglist;
open(PAGERFILE,»<$main::pathtopagerlist») ||
 die «Unable to open pager recipient list file!»;
while () {
 # пропускаем пустые строки
 S/ or next;
 # удаляем лишние символы
 chomp($_);
 push (@main::PagerRecipients, «$_»);
}
close(PAGERFILE) || die «close0: $!»;
print «Recipients:
@main::PagerRecipients
»;
# запускаем Initialize, чтобы определить, кого будем опрашивать
&Initialize(@main::PagerRecipients);
# начинаем бесконечный цикл опроса
do {
 print «
*************** TESTING ***************
»;
 &TestObjects;
 # Замечание: если необходимо использовать сценарий в обычном режиме 
 # тестирования, можно закомментировать следующие 
8 строк и снять комментарии 
 # с 9-й и 10-й строк
 # 
 # 
 if (keys(%main::server) > 0) {
 print «Entering Heightened Alert State.
»;
 print «************* SLEEPING **************
»;
 sleep (10);
 } else {
 print «************* SLEEPING **************
»;
 sleep (30);
 }
} while ( $main::pathtoobjectslist );
################################################
sub TestObjects # опрос узлов сети
################################################
{
 my ($Risk);
 # создаем объект Ping
 my $p = Net::Ping->new(«icmp»);
 # открываем файл журнала отказов для добавления
 open(LOGFILE, «>>$main::pathtologfile») || die «Unable to open log file!»;
 foreach my $item(@main::pinglist) {
 # Удаляем лишние символы
 chomp($item);
 # выделяем имя хоста и его местоположение
 my ($host, $location) = split(/,/, $item);
 # опрос хоста
 
E
 if ($p->ping($host, 5)) {
 
 # если отозвавшийся узел отказывал в прошлый опрос, 
он есть в списке
 # %server. Удаляем его из списка - компьютер работает, включился.
 # сообщаем об этом 
 if ( $main::server{$host} ) {
 delete $main::server{$host};
 &Page(«$host @ $location !PC Back Online!», 
 «All Clear Message»);
 } else {
 print «$host Ping OKAY on try #1
»;
 }
 } else {
 print «$host ping failed on try #1 going for #2
»;
 sleep (1);
 
F
 if ($p->ping($host, 5)) {
 
 if ( $main::server{$host} ) {
 delete $main::server{$host};
 &Page(«$host @ $location !PC Back Online!»,
 «All Clear Message»);
 } else {
 print «$host Ping OKAY on try #2
»;
 }
 } else {
 print «$host ping failed on try #1 and #2
»;
 # Если данный узел отказывал и в прошлый опрос, он должен находиться в
 # списке %server. Если его там нет, значит, в прошлый раз он еще работал,
 # так что теперь надо послать уведомление об отключившемся компьютере,
 # так как это новый отключенный
 if ( ! $main::server{$host} ) {
 $main::server{$host} = «off»;
 # проверяем количество отключившихся компьютеров для оценки
 # степени риска. ЗАМЕЧАНИЕ: в режиме тестирования можно закомментировать 
 # следующие 10 (11) строк и снять комментарий с 11(12)-й строки
 if ( keys(%main::server) == 1) {
 $Risk = «Low»;
 }
 if ( keys(%main::server) == 2) {
 $Risk = «Medium»;
 }
 if ( keys(%main::server) > 2 ) {
 $Risk = «High»;
 }
 &Page(«$host @ $location !Possible theft in progress!
 Risk $Risk», «Warning Message»);
 } else {
 print «$host page skipped due to previous failure
»;
 }
 }
 }
 }
close(LOGFILE) || die «close0: $!»;
$p->close();
} # End TestObjects sub
################################################
sub Page # Отправка сообщений по почте или на пейджер
################################################
{
 my ($Message, $Subject) = @_;
 # добавить текущее время в текст сообщения на пейджер
 $Message = «$Message «.localtime(time);
 # отправить сообщение по почте или на пейджер
 my %mail;
 $mail{From} = «$main::Sender»;
 $mail{To} = «@main::PagerRecipients»;
 $mail{Smtp} = $main::SMTP_Server;
 $mail{Subject} = «$Subject»;
 $mail{Message} = «$Message»;
 sendmail(%mail) or warn «Error sending message:
$Sendmail::error»;
 # Снимите комментарий со следующей строки для просмотра журнала Sendmail
 print «$Message
»;
 print LOGFILE «$Message 
»;
 # при желании можно использовать net send для отправки сообщений на компьютеры
 
G
 # system («net send %computername% $Message»);
 # system («net send server5 $Message»);
 
} # End Page sub
################################################
sub Initialize 
# формируем массив включенных компьютеров, которые мы 
# будем опрашивать в текущем сеансе работы сценария
################################################
{
 my $counteron = 0;
 my $counteroff = 0;
 my ($conunits,$coffunits);
 # создаем объект Ping
 my $p = Net::Ping->new(«icmp»);
 # открываем файл журнала и распечатываем список компьютеров, которые будут тестироваться
 open(LOGFILE, «>>$main::pathtologfile») || die «Unable to open log file!»;
 # Печатаем заголовок файла журнала
 print LOGFILE «************** «.localtime(time).» ****************
»;
 # печатаем получателей пейджинговых сообщений в журнал
 print LOGFILE «Pager recipients:
@main::PagerRecipients

»;
 # открываем файл со списком объектов тестирования и формируем массив для опроса
 open(OBJECTFILE,»<$main::pathtoobjectslist») ||
 die «Unable to open test objects file!»;
 my @Object_array = ;
 close(OBJECTFILE) || die «close0: $!»;
 # удаляем символы перехода на новую строку
 chomp(@Object_array);
 foreach my $Object (@Object_array) {
 # проверка пустых строк
 $Object =~ /S/ or next;
 # разбираем прочитанную строку на имя компьютера и местоположение
 my ($host, $location) = split(/,/, $Object);
 # опрашиваем узел сети
 
H
 if ($p->ping($host, 5)) {
 
 # добавляем 1 к счетчику включенных
 $counteron++;
 # печатаем на экран и в журнал имя и местоположение компьютера
 print «$host,$location online
»;
 print LOGFILE «$host,$location online
»;
 # добавляем узел в массив компьютеров, которые будут опрашиваться
 push (@main::pinglist, «$host,$location»);
 } else {
 # компьютер выключен
 # добавляем 1 к счетчику выключенных
 $counteroff++;
 # печатаем на экран и в журнал имя и местоположение компьютера
 print «$host,$location offline-excluded from test
»;
 print LOGFILE «$host,$location offline-excluded from test
»;
 }
 }
# обрабатываем единственное/множественное
 число 
if ( $counteron == 1 ) {
 $conunits = «unit»;
} else {
 $conunits = «units»
}
if ( $counteroff == 1 ) {
 $coffunits = «unit»;
} else {
 $coffunits = «units»
}
# Напечатать на экран и в файл счетчики включенных и отключенных
print «
$counteron $conunits on & $counteroff $coffunits ff
»;
print LOGFILE «
$counteron $conunits on & $counteroff $coffunits off
»;
# закрыть открытые файлы
close(LOGFILE) || die «close0: $!»;
# закрыть объект Ping
$p->close();
# конец процедуры инициализации