It happened again.. apparently someone ran our script and had its
inittab file wiped.. It's really killing me..
Here's the complete script time time.. if anyone has any idea WHAT
could be happening in the way of a freak accident, any comments
welcome...!
---------------
require 5.6.0;
use strict;
use Config;
use Getopt::Std;
use File::Basename;
use File::Spec::Functions ':ALL';
use File::Copy;
use File::Path;
use File::Find;
use constant INIT_FILE_NAME => 'irpeinit';
use constant INIT_TAB_FILE => '/etc/inittab';
use constant RC_PATH_LIST => ('/etc/rc.d', '/etc', '/sbin');
my $path;
my $addresses;
my $user;
my $group;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my $base_dir = rel2abs(dirname($0));
my $src_dir = catdir($base_dir, 'src');
my $levels;
my $priority;
my $path;
my $addresses;
my $user;
my $group;
my $uid;
my $gid;
my $init_file;
my @rc_files;
my %options;
getopts('l:n:p:a:u:g:i', \%options);
$levels = $options{l};
$priority = $options{n};
$path = $options{p};
$addresses = $options{a};
$user = $options{u};
$group = $options{g};
HELP_MESSAGE() unless defined($path);
HELP_MESSAGE() unless defined($addresses);
HELP_MESSAGE() unless defined($user);
HELP_MESSAGE() unless defined($group);
$path =~ s/\/+$//;
error("Invalid run level") if defined($levels) && $levels !~
/^[[:alnum:]]+(,[[:alnum:]]+)*$/i;
error("Invalid priority") if defined($priority) && $priority !~ /^\d+$/;
error("Install directory already exists") if -e $path;
error("Invalid IP address") unless $addresses =~
/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(,\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})*$/;
if (defined($user)) {
$uid = $user;
if ($user !~ /^\d+$/) {
$uid = getpwnam($user) or error("User name '$user' does not
exist");
}
}
if (defined($group)) {
$gid = $group;
if ($group !~ /^\d+$/) {
$gid = getgrnam($group) or error("Group name '$group' does not
exist");
}
}
set_init() unless $options{i};
info("Creating install directory");
eval {
mkpath($path);
};
error("Failed to create install directory --> $@") if $@;
perm($path, 1);
find(\&insfile, $src_dir);
config();
init();
info("Installation successful");
info("Starting agent...");
system(catfile($path, 'bin', 'irpectl') . ' start') and error("Failed
to start application --> $?");
exit;
sub set_init() {
unless (defined($levels)) {
my $init_tab_file = INIT_TAB_FILE;
open(my $fh, '<', $init_tab_file) or error("Failed to open file
'$init_tab_file' --> $!");;
while (<$fh>) {
$levels = $1 if /^[^#][^:]*:(\d):initdefault:/
}
close($fh);
error("Cannot find 'initdefault' definition in file
'$init_tab_file'") unless defined($levels);
}
my $rc_path;
foreach my $dir (RC_PATH_LIST) {
next unless -d $dir;
opendir(my $dh, $dir) or fatal("Failed to open directory '$dir'
--> $!");
my @dirs = readdir($dh);
closedir($dh);
if (grep(/^rc\d\.d$/ && -d catdir($dir, $_), @dirs)) {
$rc_path = $dir;
last;
}
}
error("Cannot find run level init directories location (" . join(',',
RC_PATH_LIST) . ")") unless defined($rc_path);
my $init_dir = catdir($rc_path, 'init.d');
$init_dir = $rc_path unless -d $init_dir;
$init_file = catfile($init_dir, INIT_FILE_NAME);
error("Startup script '$init_file' already exists") if -e $init_file;
$priority = '80' unless defined($priority);
foreach my $level (split(',', $levels)) {
my $rc_dir = catdir($rc_path, "rc$level.d");
my $rc_file = catfile($rc_dir, "S$priority" . INIT_FILE_NAME);
error("Run level directory '$rc_dir' does not exist") unless -d
$rc_dir;
error("Startup script link '$rc_file' already exists") if -e
$rc_file || -l $rc_file;
push @rc_files, $rc_file;
}
}
sub perm($;$) {
my $file = shift;
my $exec = shift;
my $mode = ($exec ? 0755 : 0644);
chmod($mode, $file) or error("Failed to change attributes of file
'$file'");
chown($uid, $gid, $file) or error("Failed to change owner of file
'$file'");
}
sub insfile {
my $file = $File::Find::name;
my $rel_file = substr($file, length($src_dir));
return unless length($rel_file);
my (undef, $head_dir) = File::Spec->splitdir($rel_file);
my $dest = $path . $rel_file;
if (-d $file) {
info("Creating directory '$dest'");
mkdir($dest) or error("Failed to create directory '$dest' -->
$!");
perm($dest, 1);
}
else {
info("Copying file '$dest'");
copy($file, $dest) or error("Failed to copy file '$dest' -->
$!");
perm($dest, $head_dir eq 'bin' || $head_dir eq 'plugin');
}
}
sub config() {
info("Generating config file");
my $config_file = catfile($path, 'irpe.cfg');
open(CFGIN, '<', catfile($base_dir, 'config', 'irpe.cfg.in')) or
error("Failed to open input config file --> $!");
open(CFGOUT, '>', $config_file) or error("Failed to open output
config file --> $!");
my $user_cfg = (defined($user) ? "user=$user" : '');
my $group_cfg = (defined($group) ? "group=$group" : '');
while (<CFGIN>) {
s/[EMAIL PROTECTED]@/$addresses/;
s/[EMAIL PROTECTED]@/$user_cfg/;
s/[EMAIL PROTECTED]@/$group_cfg/;
print CFGOUT $_;
}
close CFGIN;
close CFGOUT;
perm($config_file);
}
sub init() {
info("Generating init script");
my $src_init_file = catfile($base_dir, 'init', INIT_FILE_NAME);
open(my $ifh, '<', catfile($base_dir, 'init', INIT_FILE_NAME .
'.in')) or error("Failed to open input init script file --> $!");
open(my $ofh, '>', $src_init_file) or error("Failed to open output
init script file --> $!");
while (<$ifh>) {
s/[EMAIL PROTECTED]@/$path/;
print $ofh $_;
}
close($ifh);
close($ofh);
if ($options{i}) {
info("Note: init script '$src_init_file' not installed, please
do it
manually");
return;
}
copy($src_init_file, $init_file) or error("Failed to copy init script
file '$init_file' --> $!");
chmod(0750, $init_file) or error("Failed to change attributes of init
script file '$init_file'");
foreach my $rc_file (@rc_files) {
symlink($init_file, $rc_file) or error("Failed to create
symbolic
link '$rc_file' to init script '$init_file' --> $!");
}
}
sub ilog($) {
my $msg = shift;
open(my $fh, '>>', catfile($base_dir, 'install.log'));
print $fh "$msg\n";
close($fh);
}
sub info($) {
my $msg = shift;
ilog($msg);
print "$msg\n";
}
sub error($) {
my $msg = shift;
ilog($msg);
warn "Error: $msg\n";
exit 1;
}
sub VERSION_MESSAGE() {}
sub HELP_MESSAGE() {
print "Usage: install [-i] [-l <level>[,<level>...]] [-n <priority>]
-p <path> -a <address>[,<address>...] -u <user> -g <group>\n";
print "Options:\n";
print " level : run level to install the startup script (init
default is used if '-l' option is omitted)\n";
print " priority : init startup priority number (default is 80)\n";
print " path : install directory\n";
print " address : IP address allowed to connect\n";
print " user : system user running the application\n";
print " group : system group running the application\n";
print "Use option -i to disable installation of init startup script.\n";
print "\n";
exit 2;
}
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
