Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: DEB_5_7_6_1
Fetching contributors…

Cannot retrieve contributors at this time

208 lines (162 sloc) 4.562 kb
#!/usr/bin/perl
##!~_~perlpath~_~
#
# Interchange cron editor
#
# Copyright (C) 2005-2009 Interchange Development Group
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program 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. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301 USA.
use lib '/usr/local/interchange/lib';
#use lib '~_~INSTALLPRIVLIB~_~';
use lib '/usr/local/interchange';
#use lib '~_~INSTALLARCHLIB~_~';
BEGIN {
($Global::VendRoot = $ENV{MINIVEND_ROOT})
if defined $ENV{MINIVEND_ROOT};
$Global::VendRoot = $Global::VendRoot || '/usr/local/interchange';
# $Global::VendRoot = $Global::VendRoot || '~_~INSTALLARCHLIB~_~';
if(-f "$Global::VendRoot/interchange.cfg") {
$Global::ExeName = 'interchange';
$Global::ConfigFile = 'interchange.cfg';
}
else {
$Global::ExeName = 'interchange';
$Global::ConfigFile = 'interchange.cfg';
}
}
### END CONFIGURATION VARIABLES
use POSIX qw/tmpnam/;
use Vend::Cron;
my $prospect = tmpnam();
use File::Copy;
use Term::ReadLine;
use FindBin;
my $term = new Term::ReadLine 'Simple';
use Safe;
my $safe = new Safe;
my $configstring = `$FindBin::Bin/interchange -globalconfig`;
if ($?) {
die "Error retrieving global configuration.\n";
}
chdir $Global::VendRoot
or die "Unable to chdir to $Global::VendRoot: $!\n";
my $Global = $safe->reval($configstring)
or die "Unable to read configuration via $FindBin::Bin/interchange.\n";
my $hupit = 1;
if(! $Global->{HouseKeepingCron}) {
warn "No HouseKeepingCron is defined, this will do nothing.\n";
warn "Add:\n\n\tHouseKeepingCron <crontab\n\nto interchange.cfg to activate.\n";
undef $hupit;
}
$Vend::Quiet = 1;
my $file = "$Global->{ConfigDir}/crontab";
#warn "Cron file is $file\n";
if(-f $file) {
File::Copy::copy($file, $prospect);
}
my $ed = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
my @needed = qw/
:restart
:reconfig
:jobs
/;
EDCRON: {
system "$ed $prospect";
my $status = `diff $prospect $file`;
unless($?) {
warn "Crontab unchanged.\n";
exit;
}
open NEWCRON, "< $prospect"
or die "Cannot open prospective cron file: $!\n";
local($/);
my $lines = <NEWCRON>;
close NEWCRON;
#warn "Read lines (" . length($lines) . " bytes)\n";
my $obj;
eval {
$obj = Vend::Cron::read_cron($lines);
};
if(! $obj or $@) {
print "Cron file problem: $@\n";
my $prompt = "Retry? [y]";
my $ans = $term->readline($prompt);
if($ans =~ /^\s*n/) {
last EDCRON;
}
else {
redo EDCRON;
}
}
my %wanted = qw/ :reconfig 1 :jobs 1 /;
for(@$obj) {
my $things = $_->{things};
for(@$things) {
next unless $wanted{$_};
delete $wanted{$_};
}
}
my @errmsg;
for(keys %wanted) {
push @errmsg, sprintf("WARNING: suggested cron entry '%s' not present.", $_);
}
if(@errmsg) {
print join "\n", @errmsg, '';
my $prompt = "Retry? [y]";
my $ans = $term->readline($prompt);
unless ($ans =~ /^\s*n/) {
redo EDCRON;
}
}
#warn "read_cron returned $obj.\n";
File::Copy::copy($prospect, $file);
print "Wrote crontab file $file.\n";
#warn "copied $prospect to $file\n";
unlink $prospect;
if($hupit) {
open CRON, "< $file"
or die "Can't read cron file $file: $!\n";
my $lines = <CRON>;
close CRON;
my $rsfile = "$Global->{RunDir}/restart";
open RESTART, ">> $rsfile"
or die "Cannot write restart file: $!\n";
print RESTART "HouseKeepingCron <<EndOfCrontab\n";
print RESTART $lines;
print RESTART "\nEndOfCrontab\n";
close RESTART;
#warn "created restart file\n";
my $pidfile = $Global->{PIDfile};
unless (-f $pidfile) {
warn "Interchange not running, cannot tell to reread ($pidfile).\n";
}
open PID, "< $pidfile"
or die "Cannot read PID file $pidfile: $!\n";
my $pid = <PID>;
close PID;
$pid =~ s/\s+.*//s;
$pid =~ s/\D+//g;
#warn "Found pid=$pid\n";
chomp $pid;
if ($pid) {
kill 'HUP', $pid;
print "Sent HUP signal to Interchange server at $pid.\n";
}
else {
die "Unable to find pid at $pidfile.\n";
}
}
}
Jump to Line
Something went wrong with that request. Please try again.