#!/usr/local/bin/perl
eval 'exec perl -S $0 "$@"'
if 0;
##############################################################################
#
# May be distributed under the terms of the Artistic License
#
# Copyright @ 1998, Hewlett-Packard, Inc.,
# All Rights Reserved
#
##############################################################################
#
# @(#)$Id: rlsmgrd,v 1.1 1999/08/08 23:19:33 randyr Exp $
#
# Description: This is a daemon that periodically looks in the release
# manager's incoming area for new packages that need to be
# deployed into the the HTTP content area.
#
# Functions: check_sanity
# dispatch_job
# child_reaper
# cleanup
# write_lockfile
#
# Libraries: Carp Core lib, cleaner error reporting
# Getopt::Long Core lib, cmd-line opts parsing
# File::Basename Core lib, utility function
# Cwd Core lib, portable cwd function
# IO::File Core lib, file I/O class
# DirHandle Core lib, clean dir-reading class
# IMS::ReleaseMgr::Utils Locally-developed lib
#
# Global Consts: $cmd This tool's name
# $USAGE Error message for bad dash-opts
#
# Environment: PATH Will drastically trim PATH
#
#
# YET TO DO: Use a signal (maybe SIGINT or SIGCONT) to signal a need
# to re-read DB config
# Manual page
#
##############################################################################
use vars qw($cmd);
($cmd = $0) =~ s|.*/||o;
use 5.004;
use strict;
use vars qw($USAGE %opts $trace $tfile $period $script $dh %child_hash $file
@files $job_limit $in_dir $fork_requested $logdir %opts $dir
$mirror_group $config $VERSION $revision);
use subs qw(fork_this check_sanity dispatch_job child_reaper cleanup
show_version write_lockfile write_log_line reread_config
dump_info);
use Carp 'croak';
use Getopt::Long 'GetOptions';
use File::Basename 'dirname';
use Cwd 'cwd';
use Net::Domain 'hostfqdn';
require DirHandle;
require IO::File;
use IMS::ReleaseMgr::Utils qw(fork_as_daemon write_log_line
file_mirror_specification file_error
DBI_mirror_specification
DBI_match_mirror_to_host
DBI_error);
$VERSION = do {my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
$revision = q{$Id: rlsmgrd,v 1.1 1999/08/08 23:19:33 randyr Exp $ };
$USAGE = "Usage: $cmd mirror_group [ -H host ] [ -t level ] [ -T file ] [ -f ]
\t[ -c file ]
Where:
-H host\t\tHostname for use in a mirror environment
-t num\t\tEnable tracing (num sets level)
-T file\t\tSend trace information to 'file' instead of tty
-f\t\tFork and run in background as a daemon
-c file\t\tRead configuration from file rather than from DBMS
``mirror_group'' is the name of the host-pool grouping that this process is
running as a part of. It is used as a search key in the DBMS.
";
if (grep($_ eq '-h', @ARGV))
{
print "$USAGE\n" .
q{$Id: rlsmgrd,v 1.1 1999/08/08 23:19:33 randyr Exp $ } . "\n";
exit 0;
}
exit show_version if (grep(/-version/i, @ARGV));
$SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /bad free/oi; };
Getopt::Long::config 'no_ignore_case';
GetOptions(\%opts, 'H=s', 't=i', 'T=s', 'f', 'c=s') or croak "$USAGE\nStopped";
croak "$USAGE\nStopped" unless (defined($mirror_group = $ARGV[0]));
$ENV{PATH} = '/bin:/usr/bin:/usr/sbin'; # This is purposeful!!!
$dir = dirname $0;
$dir = cwd if ((! $dir) or $dir eq '.');
$ENV{PATH} = "$dir:/bin:/usr/bin:/usr/sbin";
#
# Global variables:
#
# %opts Options parsed out from @ARGV by getopts
# $trace True/false whether tracing is enabled
# $tfile Filehandle (class IO::File) for tracefile (STDOUT if ! -T)
# $period Sleep-cycle period, defaults to 120 (measured in seconds)
# $script Script to call to deploy the actual data
# $in_dir Directory to monitor for incoming files
# $logdir Directory in which general tool-action logging is done
# $job_limit Maximum number of child '$script' processes at a time
# $mirror_group The name of the mirror group we belong to. Less important
# for a stand-alone system, critical for a mirror pool.
# %child_hash A hash table whose keys are active child processes. These
# are used by the dispatch_job and child_reaper routines
# to track and manage sub-processes
#
$trace = $opts{t} || 0;
%child_hash = ();
if (defined $opts{c} and $opts{c})
{
#
# I shouldn't do this, since it supports bad habits, but not enough people
# (and I forget, too) know that the process changes the working dir. Thus,
# the config file may not be readable by sub-processes, or if we receive a
# SIGHUP. So, ensure that the file is an absolute path. Add this working
# dir if it isn't.
#
if ($opts{c} !~ m|^/|o)
{
my $wdir = cwd;
$opts{c} = "$wdir/$opts{c}";
}
}
reread_config(undef); # Trick the HUP handler into reading the configuration
$period = $config->{SCAN_PERIOD_SECS} || 120;
$script = $config->{STAGE_2_TOOL} || 'deploy_content';
$job_limit = $config->{MAX_CHILD_PROCS} || 5;
$in_dir = $config->{INCOMING_DIR} || '/opt/ims/incoming';
$logdir = $config->{LOGGING_DIR} || '/opt/ims/logs';
$tfile = $opts{T} || "$logdir/$cmd-trace";
check_sanity;
#
# If the sanity check passed, go ahead and fork (if so requested)
#
chdir $in_dir;
fork_as_daemon if (defined $opts{f} and $opts{f});
if ($trace)
{
write_log_line $tfile, sprintf("$cmd [$$] [%s] Started with tracing",
(scalar localtime));
}
write_log_line("$logdir/$cmd",
sprintf("%s [$$]: started for mirror group $mirror_group",
(scalar localtime)));
if ($trace & 12) # bxxxx11xx
{
write_log_line($tfile,
map {
sprintf("$cmd [$$] CONFIG: %18s => %s",
$_, $config->{$_})
} (sort keys %$config));
}
write_lockfile;
$SIG{CHLD} = \&child_reaper;
$SIG{USR1} = \&SIG_inc_trace;
$SIG{USR2} = \&SIG_dec_trace;
$SIG{HUP} = \&reread_config;
$SIG{INT} = \&cleanup;
$SIG{QUIT} = \&cleanup;
$SIG{POLL} = \&dump_info;
#
# Isolate ourselves in terms of specific hosts and mirror pools. If we were
# *not* given a -H option, try to deduce our host pseudonym from either the
# MIRROR_POOL_HOST_LIST Oracle tables or the mirror list file.
#
if (! defined($opts{H}))
{
my $myhost = hostfqdn;
if (defined $opts{c})
{
$opts{H} = file_match_mirror_to_host(-file => "$opts{c}.mir",
-host => $myhost);
}
else
{
$opts{H} = DBI_match_mirror_to_host(-mirror => $mirror_group,
-host => $myhost);
}
# Errors were ignored simply because an undef $opts{H} has its own meaning
}
while (1)
{
write_log_line($tfile,
sprintf("$cmd [$$] [%s] Checking $in_dir for packages",
(scalar localtime)))
if ($trace & 8); # bxxxx1xxx
if (($trace & 4) and (keys %child_hash)) # bxxxxx1xx
{
for (sort keys %child_hash)
{
write_log_line $tfile, "-->\tChild $_ not yet reaped";
}
}
$dh = new DirHandle "$in_dir";
if (! defined $dh)
{
write_log_line("$logdir/$cmd",
"$cmd: Could not open $in_dir for reading: $!, exiting.");
exit -1;
}
@files = grep(/\.info$/o, $dh->read);
$dh->close;
undef $dh;
#
# Sort @files by age, oldest first. First come, first severed...
#
@files = sort
{ (stat("$in_dir/$a"))[9] <=> (stat("$in_dir/$b"))[9] }
@files;
for $file (@files)
{
#
# The return value from dispatch_job is zero if there were no child
# slots available. If there was a legitimate error, then it should
# have croaked itself so that the line number reference pointed to it.
# dispatch_job waits a reasonable time for slots to open, so if it
# comes back 0, we're pretty bogged down and should wait, anyway.
#
last if (! dispatch_job $file);
}
#
# Clear this list. If we didn't process all of the jobs, they'll be at the
# head of the list next time around.
#
@files = ();
sleep $period;
}
exit 0;
##############################################################################
#
# Sub Name: child_reaper
#
# Description: Catch a SIGCHLD and remove the completed child from the
# hash %child_hash, which will free the slot up for the next
# job.
#
# Arguments: NAME IN/OUT TYPE DESCRIPTION
# $sig in scalar Signal name
#
# Globals: %child_hash
# $trace
# $tfile
#
# Environment: None.
#
# Returns: void context
#
##############################################################################
sub child_reaper
{
my $sig = shift; # ...we don't use it, just clear it out of @_
my $child = wait;
$SIG{$sig} = \&child_reaper; # In case of broken SysV signals
delete $child_hash{$child} if (exists $child_hash{$child});
write_log_line($tfile,
sprintf("$cmd [$$] [%s] Registered exit of child $child",
(scalar localtime)))
if ($trace & 2); # bxxxxxx1x
return;
}
##############################################################################
#
# Sub Name: dispatch_job
#
# Description: Fork a child process to run the specified script on an
# info file, to cause the deployment of the content file.
#
# Arguments: NAME IN/OUT TYPE DESCRIPTION
# $file in scalar Name of info file to use
#
# Globals: %child_hash
# $script
# $job_limit
# $logdir
#
# Environment: None.
#
# Returns: Success: pid of child
# Failure: 0, could not get a job slot
#
##############################################################################
sub dispatch_job
{
my $file = shift;
my ($pid, @cmd, $current_kids, $i);
#
# Construct the command to exec. Split the value of $script in case the
# caller specified some flags there. Add in the legacy flags that the
# child needs, then add in the file itself.
#
@cmd = split(/\s+/, $script);
push(@cmd, '-H' => $opts{H}) if (defined $opts{H} and $opts{H});
push(@cmd, '-t' => $trace) if ($trace);
push(@cmd, '-T' => $tfile) if ($tfile ne '-');
push(@cmd, '-c' => $opts{c}) if (defined $opts{c} and $opts{c});
push(@cmd, $mirror_group, $file);
$current_kids = scalar(keys %child_hash);
$i = 0;
while ($current_kids >= $job_limit)
{
last if ($i++ > 10); # Arbitrary
sleep 2; # Arbitrary... could be changed
$current_kids = scalar(keys %child_hash);
}
if ($current_kids >= $job_limit)
{
write_log_line($tfile,
sprintf("$cmd [$$] [%s] No child slots available for " .
"$file",
(scalar localtime)))
if ($trace & 2); # bxxxxxx1x
return 0;
}
if ($trace & 4) # bxxxxx1xx
{
#
# Spit out the full command for debugging
#
write_log_line $tfile, sprintf("$cmd [$$] [%s] Running: @cmd",
scalar localtime);
}
if ($pid = fork)
{
# parent
$child_hash{$pid} = 1;
write_log_line($tfile,
sprintf("$cmd [$$] [%s] Launched child $pid for $file",
(scalar localtime)))
if ($trace & 2); # bxxxxxx1x
write_log_line("$logdir/$cmd",
sprintf("%s [$$]: job $pid launched for $file",
(scalar localtime)));
return $pid;
}
else
{
# child -- never returns
exec @cmd;
}
}
##############################################################################
#
# Sub Name: check_sanity
#
# Description: Make certain that there is not already a lockfile in the
# directory that we are monitoring.
#
# Arguments: None.
#
# Globals: $in_dir
# $cmd
#
# Environment: None.
#
# Returns: Success: 1
# Failure: exits
#
##############################################################################
sub check_sanity
{
my $lockfile = "$in_dir/.$cmd";
my @parts;
if (-e $lockfile)
{
#
# Read it for a pid and check that it's another rlsmgrd. If the
# process $pid isn't another daemon, then it's a stale lockfile and
# remove it. If it is, then silently exit.
#
my $fh = new IO::File "< $lockfile";
croak "Could not open $lockfile for reading: $!, stopped"
unless (defined $fh);
my $pid = <$fh>;
$fh->close;
chomp $pid;
open(PIPE, "ps -e |");
$_ = <PIPE>; # Skip line that has column headers
while (defined($_ = <PIPE>))
{
chomp;
s/^\s+//o;
@parts = split(/\s+/, $_);
next unless ($parts[0] == $pid);
if ($parts[3] eq $cmd)
{
# OK, we're already running on this directory
close PIPE;
exit 0;
}
}
# Either not found at all, or not a rlsmgrd process
unlink $lockfile;
close(PIPE);
}
1;
}
##############################################################################
#
# Sub Name: write_lockfile
#
# Description: Create a lockfile for this process in the directory that
# is being monitored. This allows multiple daemons to run,
# as long as none are trying to monitor the same directory.
#
# Arguments: None.
#
# Globals: $in_dir
# $cmd
#
# Environment: None.
#
# Returns: Success: 1
# Failure: 0
#
##############################################################################
sub write_lockfile
{
my $fh = new IO::File "> $in_dir/.$cmd";
if (! defined $fh)
{
croak "Error opening $in_dir/.$cmd as a lockfile: $!, stopped";
}
print $fh "$$\n";
$fh->close;
1;
}
###############################################################################
#
# Sub Name: reread_config
#
# Description: When the specific signal (probably HUP) is received, go and
# read the configuration again, from file or Oracle,
# depending on whether -c was originally passed. If the value
# of $sig is undef, that's because I hate duplicate code and
# I've called this for the initial configuration read, being
# the sneaky sort that I am.
#
# Arguments: NAME IN/OUT TYPE DESCRIPTION
# $sig in scalar Signal that was received
#
# Globals: %opts
# $config
# $mirror_group
# $cmd
# $dir
#
# Environment: None.
#
# Returns: Success: 1
# Failure: 0
#
###############################################################################
sub reread_config
{
my $sig = shift;
if (defined $sig)
{
$SIG{$sig} = \&reread_config;
write_log_line("$logdir/$cmd",
sprintf("%s [$$]: Re-loading configuration on SIG$sig.",
(scalar localtime)));
write_log_line($tfile,
sprintf("$cmd [$$] [%s] Re-loading configuration on " .
"SIG$sig", (scalar localtime)))
if ($trace); # bxxxxxxxx
}
if (defined $opts{c} and $opts{c})
{
$config = file_mirror_specification(-file => $opts{c});
if (! defined $config)
{
write_log_line($tfile,
sprintf("$cmd [$$] [%s] Error re-reading config " .
"file $opts{c}: %s",
(scalar localtime), file_error))
if ($trace); # bxxxxxxxx
croak "$cmd was unable to get data for $mirror_group from file " .
"$opts{c}, stopped";
}
}
else
{
$config = DBI_mirror_specification(-mirror => $mirror_group);
if (! defined $config)
{
write_log_line($tfile,
sprintf("$cmd [$$] [%s] Error loading from Oracle" .
": %s, stopping.",
(scalar localtime), DBI_error))
if ($trace); # bxxxxxxxx
croak "$cmd was unable to get data for $mirror_group from " .
"Oracle:" . DBI_error . ", stopped";
}
}
if (defined $sig and defined $config->{INCOMING_DIR})
{
croak "$cmd could not chdir to $config->{INCOMING_DIR}: $!, stopped"
unless (chdir $config->{INCOMING_DIR});
}
return;
}
###############################################################################
#
# Sub Name: dump_info
#
# Description: Upon receipt of a signal, send a dump of relevant
# configuration information to the trace-file
#
# Arguments: NAME IN/OUT TYPE DESCRIPTION
# $sig in scalar Signal that triggered this
#
# Globals: $trace
# $tfile
# $cmd
#
# Environment: None.
#
# Returns: Success: 1
# Failure: 0
#
###############################################################################
sub dump_info
{
my $sig = shift;
my $date = scalar localtime;
my $base = "$cmd [$$] [$date]"; # Sort of a prefix used in the output lines
write_log_line($tfile,
"$base Dumping configuration information on signal $sig",
"$base Config source is " .
((defined $opts{c} and $opts{c}) ? "file $opts{c}" : "DBI"),
(map { sprintf "$base %-24s = %s", $_, $config->{$_} }
(sort keys %{$config})));
1;
}
###############################################################################
#
# Sub Name: cleanup
#
# Description: Clean up any lingering bits on exit.
#
# Arguments: $sig
#
# Globals: $in_dir
# $cmd
#
# Environment: None.
#
# Returns: Success: 1
# Failure: 0
#
###############################################################################
sub cleanup
{
my $sig = shift;
write_log_line("$logdir/$cmd",
sprintf("%s [$$]: exiting.", (scalar localtime)));
write_log_line($tfile,
sprintf("$cmd [$$] [%s] exiting after receiving SIG$sig",
(scalar localtime)))
if ($trace & 1); # bxxxxxxx1
unlink "$in_dir/.$cmd" if (-e "$in_dir/.$cmd");
exit 0;
}
__END__
=head1 NAME
rlsmgrd - Daemon process for the IMSS web content release manager system
=head1 SYNOPSIS
rlsmgrd [ B<-t> I<num> ] [ B<-T> I<file> ] [ B<-f> ] [ B<-c> I<file> ] mirror-group
=head1 DESCRIPTION
The B<rlsmgrd> tool is the first of a three-stage release management process.
This tool runs in the background as a daemon process, monitoring a designated
directory for incoming files, and launching sub-processes to manage the
deployment of the content contained in those files into the web server areas.
The scope of B<rlsmgrd> is strictly limited to the tasks of monitoring the
incoming directory and managing child processes. No external calls to untar
archives or move files is performed by this tool.
=head1 OPTIONS
B<rlsmgrd> requires that a I<mirror group> be specified on the command-line.
This group name uniquely identifies a group of one or more servers that handle
a given externally-visible hostname. In addition to that required value, the
following options are recognized:
=over
=item B<-f>
Causes the process to fork and run as a daemon process. Performs all the
tasks that a daemon should; closes all inheritied file descriptors, detaches
itself from the controlling TTY, etc. This may, in the future, become the
default behavior.
=item B<-t I<num>>
Specify a tracing level to be used for diagnostics (see the B<-T> option
below). The value is used internally as a bit-mask, so a value of 5 is in
fact specifying the combination of 1 and 4, while exluding 2. Currently, only
the first three bits are used. (A detailed description of what each bit does
will soon follow.)
=item B<-T I<file>>
Specifiy the file that diagnostics are written to. Not to be confused with
the general tool logfile, which generally only notes the very high-level
events. If not specified, and a non-zero value for B<-t> is specified, this
will default to ``rlsmgrd-trace'' in the same logging directory as other logs
are written to.
=item B<-c I<file>>
Instruct the tool to read configuration from the specified file rather than
the Oracle database. This is meant mainly for debugging and for mirror groups
that contain only one host. This is not a good idea for mirror groups with
two or more hosts, as the database is specifically utilized so as to avoid
configurations diverging from one host to the next. (Description of the
configuration file format will be added later.)
=item B<-H I<hostname>>
In a mirror-pool environment, a host running this daemon is almost certainly
monitoring a virtual hostname that differs from the physical hostname. This
option specifies what the B<rlsmgrd> process should consider the hostname to
be, rather than using the system hostname.
=back
All of the above arguments (except for B<-f>) are passed along to the
child process that gets spawned to handle an incoming package.
=head1 CONFIGURATION SPECIFICATION
In order to read configuration data from the Oracle RDBMS, the tool must
have a database name/address, and a user ID and password. It would be insecure
to pass these either on the command-line or via environment variables. To that
end, if the tool attempts to use the Oracle data source (in the absence of
a B<-c> option, above) then it looks for a control file in the same directory
as the tool itself resides in. The name of the control file must be the mirror
group name as passed on the command line, with a suffix of ``C<.rc>'' added.
The file itself should contain only one or two lines. The first line should
be of the form:
username:password
The password should I<not> be encrypted. The second line, if specified, should
be the database name. If this is not specified, the value of the environment
variable B<ORACLE_SID> is used. It is assumed that the environment variable
B<ORACLE_HOME> is already set.
This specification will be used by all release manager tools located in the
same directory.
=head1 FILES
=over
=item $TOOL_DIR/*.rc
Where C<$TOOL_DIR> is the directory in which the tool is installed, the
files that provide Oracle information, for the sake of connecting to the
Oracle server. This file is not referenced if the B<-c> option is passed.
=back
=head1 SEE ALSO
L<deploy_content>, L<process_content>
=head1 AUTHOR
Randy J. Ray (randyr@nafohq.hp.com)
=cut