Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

226 lines (188 sloc) 5.783 kb
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use AE;
use AnyEvent::DateTime::Cron;
use Getopt::Long;
use Pod::Usage;
use Config::Crontab;
use Log::Minimal;
use File::Spec;
use URI::Escape;
use Time::Piece;
use File::Path 2 qw(make_path);
use Fcntl ':seek';
use Email::Simple;
use Email::Simple::Creator;
use Email::Sender;
use Email::Sender::Simple qw(sendmail);
STDOUT->autoflush(1);
my $mailto;
GetOptions(
'm|mailto=s' => \$mailto,
'c|config=s' => \my $fname,
'd|logdir=s' => \my $logdir,
) or pod2usage();
make_path($logdir);
pod2usage() unless $fname;
my $cron = AnyEvent::DateTime::Cron->new();
my $w = AE::signal HUP => sub {
infof("received SIGHUP. reloading configuration.");
reload_config();
};
my $wchld = AE::signal CHLD => sub {
infof("finished: $?, %s", @_);
};
my %watching;
my $PPID = $$;
my %env;
&main; exit;
sub main {
infof("[$$] Starting $0");
load_config($fname);
if ($ENV{MYCRON_DEBUG}) {
run_event(q{perl -e 'die "OOPS"'});
run_event(q!perl -e 'die $ENV{FOO}'!);
}
$cron->start->recv;
}
sub load_config {
my $parser = Config::Crontab->new();
$parser->read(-file => $fname);
undef %env;
for my $block ($parser->blocks()) {
for my $line ($block->lines) {
if ($line->isa('Config::Crontab::Env') && $line->active) {
# $line->name
# $line->value
$env{$line->name} = $line->value;
if ($line->name eq 'MAILTO') {
$mailto = $line->value;
}
} elsif ($line->isa('Config::Crontab::Event') && $line->active) {
infof("Registering %s, %s", $line->datetime, $line->command);
$cron->add(
$line->datetime,
sub { run_event($line->command) }
);
}
}
}
}
sub run_event {
my $command = shift or die "run_event(command)";
infof("[$command] spawning");
eval {
infof("[%s] starting $$", $command);
my $logfname = File::Spec->catfile($logdir, uri_escape($command) . Time::Piece->new->strftime('-%Y%m%d.log'));
open my $logfh, '>>', $logfname
or critf("Cannot open log file: $logfname");
$logfh->autoflush(1);
print $logfh '-'x78, "\n";
my $logpos = tell $logfh;
die "failed to obtain position of logfile:$!"
if $logpos == -1;
seek $logfh, $logpos, SEEK_SET
or die "cannot seek within logfile:$!";
pipe my $logrh, my $logwh
or die "failed to create pipe:$!";
my $_log = sub {
print $logfh (
'[' . scalar(localtime) . '] ',
@_
);
};
unless (my $pid = fork) {
if (defined $pid) {
local %ENV = (%ENV, %env);
close $logrh;
close $logfh;
open STDERR, '>&', $logwh
or die "failed to redirect STDERR to logfile";
open STDOUT, '>&', $logwh
or die "failed to redirect STDOUT to logfile";
close $logwh;
exec $command;
die "exec(2) failed:$!:@ARGV";
} else {
close $logrh;
close $logwh;
die "fork(2) failed:$!\n";
}
} else {
close $logwh;
$_log->($_) while <$logrh>;
close $logrh;
$watching{$pid} = AE::child($pid, sub {
my ($pid, $status) = @_;
delete $watching{$pid};
if ($status == -1) {
$_log->("failed to execute command:$!\n");
} elsif ($status & 127) {
$_log->("command died with signal:" . ($status & 127) . "\n");
} else {
$_log->("command exited with code:" . ($status >> 8) ."\n");
}
if ($status != 0) {
# print log to stdout
open my $fh, '<', $logfname
or die "failed to open $logfname:$!";
seek $fh, $logpos, SEEK_SET
or die "failed to seek to the appropriate position in logfile:$!";
my $err = do { local $/; <$fh> };
send_error_mail($command, $err);
close $fh;
}
});
}
};
if ($@) {
critical_error(sprintf '[%s] %s', $command, $@);
if ($PPID != $$) {
infof("child process");
exit 1;
}
}
}
sub critical_error {
# TODO: send mail
critf(@_);
}
sub send_error_mail {
my ($command, $body) = @_;
# TODO: send mail
if ($mailto) {
infof("[$command] Sending e-mail $mailto");
my $email = Email::Simple->create(
header => [
To => $mailto,
Subject => "'$command' failed",
From => "$ENV{USER}\@$ENV{HOSTNAME}",
],
body => $body,
attributes => {
content_type => 'text/plain',
charset => 'utf-8',
},
);
Email::Sender::Simple->send($email, {from => "$ENV{USER}\@$ENV{HOSTNAME}"});
}
}
sub reload_config {
$cron->delete($cron->jobs);
load_config();
}
__END__
=head1 NAME
mycron - yet another periodicaly script runner
=head1 SYNOPSIS
% mycron -c config.pl
=head1 DESCRIPTION
Yet another cron-ish task manager. mycron runs your jobs periodicaly.
=head1 SIGNALS
=over 4
=item SIGHUP
mycron reloads configuration file when got SIGHUP.
=back
=cut
Jump to Line
Something went wrong with that request. Please try again.