#!/usr/bin/perl # This is a Perl archive (produced by par 0.08). # To extract the files from this archive, save it to some FILE, remove # everything before the '#!/usr/bin/perl' line above, then type 'perl FILE'. # # Made on Sat Jan 11 06:34:45 2003 by . # Source directory was '/tmp'. # # Existing files will *not* be overwritten unless '-c' is specified. # # This par contains: # length mode name # ------ ---------- ------------------------------------------ # 1118 0664 bcrond-0.82/CHANGES # 4688 0644 bcrond-0.82/TODO.pod # 14341 0644 bcrond-0.82/bcrond # 6747 0644 bcrond-0.82/bcrond.pod # 495 0644 bcrond-0.82/crontab.F # 216 0644 bcrond-0.82/crontab.f # 298 0755 bcrond-0.82/run-parts # # ============= bcrond-0.82 ============== unless (-d 'bcrond-0.82') { warn "x - creating directory bcrond-0.82\n"; mkdir 'bcrond-0.82', 0777 or die "Couldn't mkdir 'bcrond-0.82': $!"; } # ============= bcrond-0.82/CHANGES ============== if (-e 'bcrond-0.82/CHANGES' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/CHANGES (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/CHANGES (text)\n"; $_ = <<'PAR_EOF'; X0.82 Fri Nov 16 23:57:54 GMT 2001 X XBUG Lists and ranges now support English abbreviations. X XBUG Fixed DEBUG4 output, it had some fields mixed up. X It also has been reformulated to present the job selection logic. X XBUG Removed embeded newlines (%) RESTRICTIONS, they are now handled X properly. X XBUG Fixed mail sending, I broke it somewhere along the line. X XFEATURE Changed the implementation of exploding ranges and lists, X I now use a cache. This makes for less DEBUG4 output. X XFEATURE Changed default HOME to /, seems better than null which would X default to wherever bcrond was run from. X XFEATURE Added -U, -S for cross-platform joyfulness. X XFEATURE Added and corrected some DEBUG1 messages. X XOTHER Diagnostics now come wrapped in CARP( ... ) and CROAK( ... ) X XOTHER Rearranged documentation; decided it was bad to have the bulk of X it in EXTENSIONS when most could go elsewhere. X X X0.81 Mon Nov 12 13:33:52 2001 X Reached what I consider a useable state and figured I ought to X start tracking stuff. X X Changed job testing back to check wday and mday at once X to get Vixie (minute && hour && month && (mday || wday)). PAR_EOF open F, "> bcrond-0.82/CHANGES" or die "Couldn't open 'bcrond-0.82/CHANGES': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 1118 == $len or warn "bcrond-0.82/CHANGES: original size 1118, current size $len"; utime 1042266802, 1042266802, 'bcrond-0.82/CHANGES' or die "Couldn't touch 'bcrond-0.82/CHANGES': $!"; chmod 0664, 'bcrond-0.82/CHANGES' or die "Couldn't chmod 'bcrond-0.82/CHANGES': $!"; } # ============= bcrond-0.82/TODO.pod ============== if (-e 'bcrond-0.82/TODO.pod' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/TODO.pod (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/TODO.pod (text)\n"; $_ = <<'PAR_EOF'; X=pod X X=head1 ALMOST CERTAIN X X=over 4 X X=item exclusionary time X XAllow ! in ranges and lists? X X=item L X XParser ought to be validating, and bail if it doesn't look like a crontab. X X=over 4 X X=item B<-T> X XCall validating parser and exit; could be B<-t> but anacrond wants that. X X=back X X=item mail format X XFrom: nobody (Cron Dameon) XSubject: Cron /usr/bin/id X Xuse of localhost in mail headers X X /* if there was output and we could not mail it, X * log the facts so the poor user can figure out X * what's going on. X */ X "mailed %d byte%s of output but got status 0x%04x\n", X bytes, (bytes==1)?"":"s", X status); X X=back X X=head2 Supporting software X X=over 4 X X=item anacron/$ENV{LASTCRON} X XNeed to preserve state; probably in a LASTCRON variable in the crontab itself; Xsuch that B<-X> is truly useful for using in F<.login>. XThe current system of handling ranges and lists simplifies job checking Xat the expense of making this difficult. X XImplement this simply by forking the code (internally based on $0, Xor in codebase) to do anacron type stuff... X XB<-d> = B<-X>, B<-t> = B<-f> X X=item crontab(1) X XNecessary for non-root users to edit ther crontabs in /var/spool/cron. XNeeds to heed /etc/cron.allow and /etc/cron.deny X X=item desync X X desync is a tool which sleeps a random (hostname seeded) X period of time (up to an hour, by default) in order to X skew the network load from several machines running cron X jobs that would otherwise be synchronized. X X An invocation would appear something like X X 42 * * * * desync; /usr/lib/sendmail -q X X in a crontab file. X X=back X X=head1 QUESTIONABLE X X=over 4 X X=item ENVIRONMENT X X=over 4 X X=item PATH X XDon't propagate and default it to XF (like init)? X X=item HOME X Xchdir before job execution? X X=back X X=item (minute && hour && month && (DoM || DoW)) X XAnd an option or syntax to allow X(minute && hour && month && DoM && DoW)? XOr other variants? X X=item use Safe; X XAs an option? Especially for perl jobs? X X=item B B<-T> X XWould be easier if I did the PATH thing under ENVIRONMENT below. X X=item Efficiency X X=over 4 X X=item crontab modification check&reload X XSwitch to disable the check (per Sun); Xwould that need a sig handler to allow forced checking? XA stat doesn't cost much anyways? X X=item MPM X XMeans of specifying an "MPM" a la Proc::Queue? XHow? (B<-M> would be nice but is currently no mail) X X=item reuse middle process X Xa.k.a. child/parent (AOT grandparent/grandchild) X X=back X X=item logging X XAdd "Stopped"(via DESTROY, but only for parent) lines, like Sun? XRHL has no such output... X X=item B<-x> levels X XMake Belga Cron levels match those of Vixie Cron? XCheck out Debug() lines in Vixie source to see if there's useful types Xof debugging I don't provide...? X X=item Perlix X XShould default SHELL be perlsh or s/o? X X=item MIDI X XPrevent multiple instances? Prevent duplicate invocations? X X=item Signal handling X XForced run through of job list? XThis could be done with a seperate invocation with B<-X>. XForced checking of crontabs (if switch to prevent this normally, Xor if default behavior is altered to not check each run through) X X=item Settings inheritance X XAm I making this too complicated? X XAdmin might want to see logs/mail of a user (/prevent turning them off). XOr do strict settings of shell and path? X#Pass SHELL&PATH off as: if they can do it interactive they can do it in cron XHow can admin check what the user is up to if user is able to Xoverride admin settings (in this top-down scheme)? X XMake CRONLOG(MAIL)) trinary? X X YES 1 X MAYBE "0 but true" X NO 0 X X(default > switch ) == top; top > tab X X#This is equivalent to parsing /etc/default/cron, and letting getopts overwrite X#it's also currently done like this X{ X If switch{CRONLOG} true && default{CRONLOG} true set true X If switch{CRONLOG} true && default{CRONLOG} false set true X If switch{CRONLOG} false && default{CRONLOG} true set false X If switch{CRONLOG} false && default{CRONLOG} false set false X} X{ X If top{CRONLOG} true && tab{CRONLOG} true noop X If top{CRONLOG} true +VAL && tab{CRONLOG} true noop X If top{CRONLOG} true && tab{CRONLOG} true +VAL set VAL iff MAYBE X If top{CRONLOG} true +VAL && tab{CRONLOG} true +VAL set VAL iff MAYBE X If top{CRONLOG} true && tab{CRONLOG} false set 0 iff MAYBE X If top{CRONLOG} true +VAL && tab{CRONLOG} false set 0 iff MAYBE X If top{CRONLOG} false && tab{CRONLOG} true noop X If top{CRONLOG} false && tab{CRONLOG} true +VAL noop X If top{CRONLOG} false && tab{CRONLOG} false noop X} X X=back X X=cut PAR_EOF open F, "> bcrond-0.82/TODO.pod" or die "Couldn't open 'bcrond-0.82/TODO.pod': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 4688 == $len or warn "bcrond-0.82/TODO.pod: original size 4688, current size $len"; utime 1042266802, 1042266802, 'bcrond-0.82/TODO.pod' or die "Couldn't touch 'bcrond-0.82/TODO.pod': $!"; chmod 0644, 'bcrond-0.82/TODO.pod' or die "Couldn't chmod 'bcrond-0.82/TODO.pod': $!"; } # ============= bcrond-0.82/bcrond ============== if (-e 'bcrond-0.82/bcrond' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/bcrond (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/bcrond (text)\n"; $_ = <<'PAR_EOF'; X#!/usr/bin/perl -w Xuse strict; XBEGIN{ X $0 = "crond"; X X require 5; X use Fcntl; X use File::Basename; X use File::Spec; X use Getopt::Std; X use POSIX (); X use Symbol; #Support pre 5.6; they don't auto-vivify on open X X $Mail::Sendmail::VERSION = $Mail::Send::VERSION = 0; X eval 'use Mail::Send'; X eval 'use Mail::Sendmail' if $@ || ! $Mail::Send::VERSION; X} Xmy($pid, %EXPLODECACHE, %OPT, $VERSION); X$VERSION = 0.82; X X#Get config/options X{ X my @defbug; X %ENV = ( X CRONDAEMON=>1, #!-X X CRONDEBUG =>0, #!-x X CRONEMBED =>0, #!-O X CRONLOG =>'/var/log/cron/', # -L X CRONMAIL =>1, #!-M; extend this to MAILTO?! X CRONONCE =>0, #!-1 X CRONSERIAL=>0, #!-s X CRONSOGGY =>0, #!-S X CRONUNSAFE=>0, #!-U X HOME =>'/', X LOGNAME =>'', X MAILTO =>'', X PATH =>$ENV{PATH}, X SHELL =>'/bin/sh' X ); X if( -r '/etc/default/cron' && open(DEFAULT, '/etc/default/cron') ){ X my(%default, %verboseOPT); X %verboseOPT = ( X CRONDAEMON=>'X', X CRONDEBUG =>'x', X CRONEMBED =>'O', X CRONLOG =>'L', X CRONMAIL =>'M', X CRONONCE =>'1', X CRONSERIAL=>'s', X CRONUNSAFE=>'U' X ); X while(){ X chomp(); X next if /^\s*(?:\#|$)/; X if( /^\s*([^\s]*?)\s*=\s*(.*)/ ){ X push(@defbug, "DEBUG2 (Setting envar $1 => $2) "); X $default{uc($1)} = $2; next; X } X } X %ENV = (%ENV, %default); X foreach my $var ( grep {/^CRON/ } keys %ENV ){ X $ENV{$var} = 1 if lc($ENV{$var}) eq 'yes'; X $ENV{$var} = 0 if lc($ENV{$var}) eq 'no'; X $OPT{$verboseOPT{$var}} = delete($ENV{$var}); X } X } X getopts('1f:hsx:F:L:MOSUX', \%OPT); X if( $OPT{h} || scalar @ARGV ){ X die("Usage: $0 [-1MOSUXhs] [-F file] [-L dir] [-f file] [-x debugflag]\n"); X } X $OPT{s} = $OPT{X} ? 1 : ($OPT{s} || 0); X #XXX -s could imply -U but for perhaps allowing group changing?! X # multiple levels of U? 1 is all 2 is except groups? X debug(@defbug) if $OPT{x} & 2 && @defbug; X if( $OPT{S} ){ X eval "use File::Temp ':POSIX'"; X if( $@ && $OPT{O} ){ X *tmpnam = *POSIX::tmpnam; X } X else{ X #XXX set security based on $] X #File::Temp->safe_level( File::Temp::HIGH() ); X } X } X if( $OPT{x} & 1 ){ X eval 'use Data::Dumper'; X debug("DEBUG (%OPT = %{\n", Dumper(\%OPT), "})"); X } X} X X X#Be a good little daemon X{ X $OPT{f} = File::Spec->rel2abs($OPT{f}) if $OPT{f}; X $OPT{F} = File::Spec->rel2abs($OPT{F}) if $OPT{F}; X chdir(File::Spec->rootdir) || die("Couldn't chdir to ROOT directory: $!\n"); X if( $OPT{X} ){ X debug("STARTED (no fork)"); X } X else{ X unless( defined($pid = fork()) ){ X die("Couldn't fork: $!\n"); X } X exit 0 if $pid; X POSIX::setsid(); X debug("STARTED (fork ok)"); X open(STDIN, '<'. File::Spec->devnull) || X die("Can't read from NULL device: $!\n"); X open(STDOUT, '>'. File::Spec->devnull) unless $OPT{L} eq '-' || X die("Can't write from NULL device: $!\n"); X } X} X X X X#Set us up the bomb (read configuration) Xmy(@PJOBS, @TABOPT, %TABMTIME); XLOAD: { X my($crontabindex, @crontabs, @crontabpaths, @groups); X $crontabindex =0; X #This is to prevent memory leaks X %EXPLODECACHE = @PJOBS = @TABOPT = (); X X unless( $OPT{U} ){ X while( my @F = getgrent() ){ push @groups, [@F] }; endgrent(); X } X X if( $OPT{f} || $OPT{F} ){ X push(@crontabpaths, [0, $OPT{f}]) if $OPT{f}; #-f X push(@crontabpaths, [1, $OPT{F}]) if $OPT{F}; #-F X } X else{ X # [user(0=none, 1=6th field, 2=filename), file] X @crontabpaths = ( X [1, '/etc/crontab'], #System crontab X [1, '/etc/cron.d'], #System crontabs X [2, '/var/spool/cron'], #User crontabs X [2, '/var/spool/cron/crontabs'] # " " on Sun X ); X } X foreach my $crontabpath ( @crontabpaths ){ X stat $crontabpath->[1]; X if( -d _ && opendir(CRONTABPATH, $crontabpath->[1]) ){ X push(@crontabs, X map([$crontabpath->[0], File::Spec->catfile($crontabpath->[1], $_)], X grep {!/^\./} readdir(CRONTABPATH) ) ); X closedir(CRONTABPATH); X } X elsif( -e _ ){ X push(@crontabs, $crontabpath); X } X else{ X next; X } X $TABMTIME{$crontabpath->[1]} = -M _; X } X X foreach my $tab ( @crontabs ){ X local %ENV = %ENV; X open(TAB, $tab->[1]) || carp("WARN (Couldn't open $tab->[1]: $!)") && next; X debug("DEBUG2 (Reading '$tab->[1]')") if $OPT{x} & 2; X while( ){ X local $ENV{USER}; X chomp(); X next if /^\s*(?:\#|$)/; X if( /^\s*([^\s]*?)\s*=\s*(.*)/ ){ X debug("DEBUG2 (Setting envar $1 => $2)") if $OPT{x} & 2; X $ENV{uc($1)} = $2; next; X } X my @fields = split(/\s+/); X debug("DEBUG2 (", join(',', @fields), ")") if $OPT{x} & 2; X if( $tab->[0] == 1){ X $ENV{USER} = splice(@fields,5,1); X } X elsif( $tab->[0] == 2 ){ X my $user = basename($tab->[1]); X next unless getpwnam($user); X $ENV{USER} = $user; X } X $ENV{USER} ||= $OPT{U} ? 'undef' : scalar getpwuid($<); X $ENV{UID} ||= $OPT{U} ? $< : scalar getpwnam($ENV{USER}) || $<; X if( exists($ENV{MAILTO}) && ! defined($ENV{MAILTO}) ){ X delete($ENV{MAILTO}); X } X else{ X $ENV{MAILTO} ||= $ENV{USER}; X } X unless( $OPT{U} ){ X $ENV{GID} = join(':', map($_->[2], X grep($_->[3] =~ /\b$ENV{USER}\b/,@groups) ) )|| X [grep(lc($_->[0]) eq lc($ENV{USER}), @groups)]->[0]->[2]; X } X else{ X $ENV{GID} = $(; X } X $ENV{LOGNAME} = $ENV{USER}; X $ENV{HOME} ||= $OPT{U} ? File::Spec->rootdir : (getpwnam($ENV{USER}))[7]; X push(@PJOBS, [splice(@fields,0,5), X [$crontabindex, { X GID => delete($ENV{GID}), X UID => delete($ENV{UID}), X HOME => delete($ENV{HOME}), X USER => delete($ENV{USER}), X MAILTO => delete($ENV{MAILTO}), X LOGNAME => delete($ENV{LOGNAME}) }, X join(' ', @fields)]]); X debug("DEBUG2 (Saving job CMD(@fields))") if $OPT{x} & 2; X } X close(TAB); X #XXX debug statement instantiates the key, gets us an error later... X delete $ENV{USER}; X $TABOPT[$crontabindex++] = \%ENV; X } X} X X X#Create EXPLODECACHE X{ X my %verbosetime = (SUN=>0, MON=>1, TUE=>2, WED=>3, THU=>4, FRI=>5, SAT=>6, X JAN=>1, FEB=>2, MAR=>3, APR=>4, MAY=>5, JUN=>6, JUL=>7, X AUG=>8, SEP=>9, OCT=>10,NOV=>11,DEC=>12); X sub explode{ X my @exploded; X return $EXPLODECACHE{$_[0]} if exists $EXPLODECACHE{$_[0]}; X X foreach ( split(/,/, $_[0]) ){ X if( m%\*/(\d+)% ){ X for(my $i=0; $i<60; $i+=$1){ push(@exploded, $i); } X } X elsif( /-/ ){ X my($i, $j, $k) = ($_ =~ m%(\d+)-(\d+)(?:/(\d+))?% ); X $i = $verbosetime{uc($i)} || $i; X $j = $verbosetime{uc($j)} || $j; X $k ||= 1; X for(; $i<=$j; $i+=$k){ push(@exploded, $i); } X } X else{ X push(@exploded, $verbosetime{uc()} || $_); X } X } X $EXPLODECACHE{$_[0]} = [@exploded]; X } X foreach my $job (@PJOBS){ X do { explode($job->[$_]); } for (0..4); X } X} X X X#AD INFINITUM Xwhile(1){ X debug("DEBUG1 (I'm alive and checking)") if $OPT{x} & 1; X X my @time = localtime(time()); X foreach my $job (@PJOBS){ X my $pid; X debug("DEBUG4 (", X "($job->[0] eq '*' || $job->[0] == $time[1]) &&", X "($job->[1] eq '*' || $job->[1] == $time[2]) &&", X "($job->[2] eq '*' || $job->[2] == $time[3]) && (", X "($job->[4] eq '*' || $job->[4] == $time[6]) ||", X "($job->[3] eq '*' || $job->[3] == $time[4]) ) )") if $OPT{x} & 4; X next unless $job->[0] eq '*' || grep($_ == $time[1], X @{$EXPLODECACHE{$job->[0]}} ); X next unless $job->[1] eq '*' || grep($_ == $time[2], X @{$EXPLODECACHE{$job->[1]}} ); X next unless $job->[2] eq '*' || grep($_ == $time[3], X @{$EXPLODECACHE{$job->[2]}} ); X next unless ($job->[4] eq '*' || grep($_ == $time[6], X @{$EXPLODECACHE{$job->[4]}} ) ) || X ($job->[3] eq '*' || grep($_ == $time[4], X @{$EXPLODECACHE{$job->[3]}} ) ); X X next if $job->[5]->[2] =~ /^#/ && ! $OPT{O}; #Save the forks! X X debug("DEBUG4 (Got a job)") if $OPT{x} & 4; X if( $OPT{s} ){ X job($job->[5]); X } X else{ X unless( defined($pid = fork()) ){ X #Really a croak but can't be fatal; since we're the grandparent X carp("DIE (Couldn't fork: $!)"); X next; X } X job($job->[5]) unless $pid; X } X } X $OPT{1} && exit 0; X X #XXXsleep 60; X #XXXdo{ $kid= waitpid(-1, POSIX::WNOHANG()); } until -1 == $kid; X for(my $i=0; $i<12; $i++){ X sleep 5; X while( waitpid(-1, POSIX::WNOHANG()) != -1 ){} X } X foreach (keys %TABMTIME){ X goto LOAD if $TABMTIME{$_} != (-M $_ || 0); X } X} X Xsub carp{ X warn(@_) if $OPT{X} && $OPT{L} ne '-'; X l0g('warnings', 'CARP (', @_, ')'); X} X Xsub croak{ X warn(@_) if $OPT{X} && $OPT{L} ne '-'; X l0g('errors', 'CROAK (', @_, ')'); X exit 0 unless $OPT{s}; X} X Xsub debug{ X l0g('info', @_); X} X Xsub job{ X my($FRMCHLD, $chldinput, $chldoutput, $return, $CHLDSTDIN, $TOCHLD); X $return = "undef"; X X #Don't kill hashes in perl jobs X if( $_[0]->[2] !~ /^#/ && $_[0]->[2] =~ /([^%]+)%(.*)/ ){ X return croak("Embedded newlines (%) not allowed with -S") if $OPT{S}; X $_[0]->[2] = $1; X $chldinput = $2; X $chldinput =~ s/(.)%/ $1 eq "\\" ? '%' : "$1\n" /eg; X pipe($CHLDSTDIN=gensym(), $TOCHLD=gensym()) || X croak("Couldn't create pipe: $!"); X } X X %ENV = (%{$TABOPT[$_[0]->[0]]}, %{$_[0]->[1]}); X if( $OPT{S} ){ X open(STDERR, ">&STDOUT"); X if( $OPT{O} && $_[0]->[2] =~ /#!perl\s+-e\s+(.*)/ ){ X local $/ = undef; X my $TMP = gensym(); X my $tmpfile = tmpnam(); X open($TMP, "+>$tmpfile"); X my $oldout = select($TMP); X $0 = "perl -e $1"; X { X local *STDOUT = $TMP; X local *STDERR = $TMP; X local $SIG{__WARN__} = sub{print STDERR @_}; X eval($1); X } X select($oldout); X if($@){ X return croak("Failed (with $@) evaluting\n$1"); X } X seek($TMP,0,0); X $chldoutput = join('', <$TMP>); X close($TMP); X unlink($tmpfile); X } X else{ X $chldoutput = qx($_[0]->[2]); X } X } X else{ X my $pid = 0 || open($FRMCHLD=gensym(), "-|"); X #XXX Michael Schwern of p5p reports former doesn;t work on VMS in 5.7.2 X #|| open($FRMCHLD=gensym(), "-|", 'perl bug') ;#?! X unless( defined($pid) ){ X croak("Couldn't fork: $!"); X return -1; X } X if( $pid ){ X $0 = uc($0) . "($pid) "; X $ENV{USER} = $_[0]->[1]->{USER}; X if( defined($chldinput) ){ X #close($CHLDSTDIN); #XXX gives SIGPIPE X print $TOCHLD $chldinput; X close($TOCHLD); X } X $chldoutput = join('', <$FRMCHLD>); X $return = close($FRMCHLD); X } X else{ X my $gid; X if( defined($chldinput) ){ X close($TOCHLD); X my $fileno = fileno($CHLDSTDIN); X open(STDIN, "<&$fileno"); X } X open(STDERR, ">&STDOUT"); X X unless( $< || $OPT{U} ){ X $gid = $ENV{GID}; X $gid =~ tr/:/ /; X $gid = $gid =~ / / ? $gid : "$gid $gid"; X $( = $) = $gid; X $< = $> = $ENV{UID}; X sub list{ X my $prev = 'NaN'; X return join(',', grep($_ ne $prev && (($prev) = $_), X sort split($_[0], $_[1] ))); X }; X croak("DIE (Couldn't setregid($(, $gid): $!)") unless X ($( eq $)) && list(' ', $() eq list(':', $ENV{GID}); X croak("DIE (Couldn't setreuid($<, $ENV{UID}): $!") unless X ($< == $>) && ($> == $ENV{UID}); X } X $ENV{PATH} = delete($ENV{SUPATH}) unless $< && ! exists($ENV{SUPATH}); X X if( $OPT{O} && $_[0]->[2] =~ /#!perl\s+-e\s+(.*)/ ){ X $0 = "perl -e $1"; X eval $1; X } X else{ X exec($_[0]->[2]); X } X exit(); X } X } X debug("CMD ($_[0]->[2])[$return]"); X debug("DEBUG8 (\n", $chldoutput, ")") if $OPT{x} & 8; X mail($ENV{MAILTO}, $chldoutput) if $ENV{MAILTO} && $chldoutput; X if( $OPT{s} ){ X $0 = "crond"; X return 0; X } X else{ X exit 0; X } X} X Xsub l0g{ X return unless $OPT{L}; X my $log = shift(); X open(LOG, $OPT{L} eq '-' ? '>-' : ">>$OPT{L}/$log" ) || return; X #Can't rely on LOCK_EX being 2 for cross-platform X flock(LOG, Fcntl::LOCK_EX()) unless $OPT{L} eq '-'; X print LOG scalar localtime(time()), " $0\[$$\]: (", $ENV{USER}||$<,") @_\n"; X close(LOG) unless $OPT{L} eq '-'; X} X Xsub mail{ X return if $OPT{M}; X my @x_cron_env; X foreach my $key ( keys %ENV ){ X push @x_cron_env, "<$key=$ENV{$key}>"; X } X if( $Mail::Send::VERSION ){ X my($msg, $fh); X $msg = new Mail::Send; X $msg->to($_[0]); X $msg->subject($0); X $msg->set('X-Cron-Env', @x_cron_env); X $fh = $msg->open; X print $fh $_[1]; X $fh->close; X } X elsif( $Mail::Sendmail::VERSION ){ X my(%mail, $host); X#XXXbe smarter later... X $host = $mail{smtp} = 'localhost'; X %mail = ( X %mail, X From => "$ENV{USER}\@$host", X To => $_[0] =~ /@/ ? $_[0] : "$_[0]\@$host", X Subject => $0, X Message => $_[1], X "X-Cron-Env" => join(',', @x_cron_env), X ); X #Damn strict vars, maybe this gets optimized out X $Mail::Sendmail::mailcfg = $Mail::Sendmail::mailcfg; X $Mail::Sendmail::mailcfg{mime} = 0; X Mail::Sendmail::sendmail(%mail); X } X else{ X open(MAIL, "|/bin/mail -s \"@{[quotemeta($0)]}\" $_[0]") X || carp("WARN (Couldn't mail $_[0])(\n$_[1]\n)"); X print MAIL join("\n", map("X-Cron-Env: $_", @x_cron_env)), "\n"; X print MAIL $_[1]; X close(MAIL); X } X} PAR_EOF open F, "> bcrond-0.82/bcrond" or die "Couldn't open 'bcrond-0.82/bcrond': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 14341 == $len or warn "bcrond-0.82/bcrond: original size 14341, current size $len"; utime 1042266811, 1042266802, 'bcrond-0.82/bcrond' or die "Couldn't touch 'bcrond-0.82/bcrond': $!"; chmod 0644, 'bcrond-0.82/bcrond' or die "Couldn't chmod 'bcrond-0.82/bcrond': $!"; } # ============= bcrond-0.82/bcrond.pod ============== if (-e 'bcrond-0.82/bcrond.pod' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/bcrond.pod (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/bcrond.pod (text)\n"; $_ = <<'PAR_EOF'; X=pod X X=head1 NAME X Xcron - daemon to execute scheduled commands (Belga Cron) X X=head1 SYNOPSIS X Xcron [B<-F> F] [B<-L> I] [B<-M>] [B<-O>] [B<-S>] [B<-U>] [B<-X>] [B<-f> F] [B<-h>] [B<-s>] [B<-x> [I]] X X=head1 DESCRIPTION X XSame as Vixie Cron blah blah blah. X X=head1 OPTIONS X X=over 4 X X=item B<-1> X XExit after running through the list of jobs once. X X=item B<-F> F X XLike B<-f> below except that it expects a user (6th) field. X X=item B<-L> I X XAbsolute path to write logs; files named errors, info, and warnings; in. XThere are two special values you can set B<-L> to X X=over 4 X X=item 0 X Xno logging is done X X=item - X Xoutput is sent to STDOUT X X=back X X=item B<-M> X XRepress all sending of mail. X X=item B<-O> X XTo process a job B forks and then the specified command. XWith B<-O> commands denoted by C<#!perl -e> are Cd by the child, Xsaving the overhead of invoking a new interpreter when running perl scripts; Xsuch jobs are ignored if B<-O> is not supplied. X XEven though this has been designed to be as safe as possible Xbe sure you understand the potential security implications. X X=item B<-S> X X=cut X XXXX X X=pod X XPrevents magic open and rumored implict C, forces B<-U>. X X=item B<-U> X XThis prevents setUID and setGID, that is it effectively ignores Xthe GID environment variable as well as the user (6th) field of Xcrontabs run as root or with B<-F>. X X=item B<-X> X XPrevents B from daemonizing; forces B<-s> and does not seperate Xfrom the terminal. X X=item B<-f> F X XSupply a specific crontab or directory of crontabs to parse; Xignoring the system default and spool directories. XEspecially useful for debugging or running multiple daemons. XYou might want to consider using B<-L> as well. X X=item B<-h> X XPrint short usage message, and exit. X X=item B<-s> X XThis prevents forking which forces B to serialize job processing. X XThis can produce unexpected results if you are setUIDing; running jobs Xvia B<-F> or from F or F. X X=item B<-x> [I] X XLog debugging information. X X=over 4 X X=item 1 X Xbasic status messages X X=item 2 X Xcrontab parsing messages X X=item 4 X Xjob checking messages X X=item 8 X Xjob output X X=back X XYou may add the values together to form a composite mode. X X=back X X=head1 DIAGNOSTICS X X=over 4 X X=item Can't read from NULL device: AAA X XCouldn't open STDIN from your NULL device e.g; /dev/null. XThis is a common procedure for daemons. Don't you have a NULL? X X=item Couldn't chdir to ROOT directory: AAA X XCouldn't change to ROOT directory. XThis is a common procedure for daemons. Don't you have a root? X X=item Couldn't fork: AAA X XB needs to C in order to handle all the SetUIDing Xit does for security. It tries to catch perls which cannot XC and Cs, though a B<-X> will prevent this test. XYou may also get this error if your process table is full Xor there is insufficient memory to create a child to execute a job. X XThe job was skipped. X X=item Couldn't open AAA: BBB X XB was unable to open crontab AAA. X X=item Couldn't create pipe: AAA X XB was unable to create a pipe which is necessary for Xembeded-newlines (%). X XThe job was skipped. X X=item Couldn't setregid(AAA, BBB): CCC X XA child was unable to change from group ID(s) AAA to effective Xgroup ID(s) BBB before executing a job and exited. X XThe job was skipped. X X=item Couldn't setreuid(AAA, BBB): CCC X XA child was unable to change from user ID AAA to effective Xuser ID BBB before executing a job and exited. X XThe job was skipped. X X=item Embedded newlines (%) not allowed with -s X X=back X X=head1 ENVIRONMENT X XB uses nothing save PATH from it's environment. XHowever crontabs may contain environment variable settings for jobs. XSee L. X X=over 4 X X=item CRON* X XThese are a generalization of CRONLOG. They map Xto options and allow one to system-wide defaults Xin F; X X=item CRONLOG X XAdopted from Sun's Cron which allows you to control logging Xwith this setting in a crontab. X XThis defaults to F; and is equivalent to B<-L> I. X X=item CRONDAEMON X XThis defaults to YES; NO is equivalent to B<-X>. X X=item CRONDEBUG X XThis defaults to NO; YES is equivalent to B<-x>. X X=item CRONEMBED X XThis defaults to NO; YES is equivalent to B<-O>. X X=item CRONMAIL X XThis defaults to YES; NO is equivalent to B<-M>. X X=item CRONONCE X XThis defaults to NO; YES is equivalent to B<-1>. X X=item CRONSERIAL X XThis defaults to NO; YES is equivalent to B<-s>. X X=item CRONUNSAFE X XThis defaults to NO; YES is equivalent to B<-S>. X X=item GID X XSpecify the groups the job process will be a member of; Xthis is a colon delimited list like PATH. X X=item SUPATH X XAnother extension from Sun's Cron. If SUPATH is set it is used Xin lieu of PATH for jobs run as root. X X=back X X=head1 FILES X X=over 4 X X=item F X X=item F X X=item F OR F (Solaris) X XThese are the default crontabs that list the jobs B is supposed to run. XSee B<-f>. X X=item F X XAdopted from Sun's Cron. System wide default settings, Xenvironment and options. X XNOTE: This file is only read at startup and not monitored for changes. X X=item F X X=item F X X=item F X XB logs its various messages to these files. See B<-L>. X X=back X X=head1 BUGS X XThe crontab parser ought to be validating, and bail if it encounters Xsomething that doesn't look like a crontab. For now using crontab(1) Xis recommended, as it validates and will catch any errors avoiding nastiness. X X=head1 RESTRICTIONS X XEmbedded newlines (%) in jobs require that your B implements C. XFor hopefully obvious reasons; *cough* hashes *cough*; I<%> are not Xconsidered newlines for embedded perl jobs. X XEmbedded perl (B<-O>) with B<-S> requires that you have File::Temp installed. X X=head1 NOTES X XAn interesting way to track jobs with GNU ps and grep is: X X ps aux -H | grep -A 2 -i crond X X=head1 SEE ALSO X Xcron(8), crontab(1), crontab(5) X X=cut X XXXX run-parts X X=pod X X=head1 AUTHOR X XJerrad Pierce X X=head1 HISTORY X XIn case you hadn't noticed this is loosely modeled after Vixie Cron. XYou ought to be able to find that at F X X=head1 EXTENSIONS X XAlmost every feature of Belga Cron is an extension of the original B. XMost of them are specific to Belga Cron though some are derived from XSun's implementation and are denoted as such. In addition Xall extensions in Vixie Cron as of 3.0 are supported, Xexcept use of !, namely X X=over 4 X X=item X Xlists and ranges can co-exist in the same field X X=item X X3 letter abbreviations of English names for months and days may be used X X=item X Xjob output is mailed (or not) to a specified user X X=back X X=cut PAR_EOF open F, "> bcrond-0.82/bcrond.pod" or die "Couldn't open 'bcrond-0.82/bcrond.pod': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 6747 == $len or warn "bcrond-0.82/bcrond.pod: original size 6747, current size $len"; utime 1042266808, 1042266802, 'bcrond-0.82/bcrond.pod' or die "Couldn't touch 'bcrond-0.82/bcrond.pod': $!"; chmod 0644, 'bcrond-0.82/bcrond.pod' or die "Couldn't chmod 'bcrond-0.82/bcrond.pod': $!"; } # ============= bcrond-0.82/crontab.F ============== if (-e 'bcrond-0.82/crontab.F' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/crontab.F (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/crontab.F (text)\n"; $_ = <<'PAR_EOF'; XSHELL=/bin/bash XPATH=/sbin:/bin:/usr/sbin:/usr/bin XMAILTO=root X X#A comment X #Another comment X#0 0 0 * 6 nobody #Just a place holder X01 * * * * nobody /usr/bin/id X# run-parts X01 * * * * root #!perl -e @ARGV = ('/etc/cron.hourly' ); do 'run-parts'; X02 4 * * * root #!perl -e @ARGV = ('/etc/cron.daily' ); do 'run-parts'; X22 4 * * 0 root #!perl -e @ARGV = ('/etc/cron.weekly' ); do 'run-parts'; X42 4 1 * * root #!perl -e @ARGV = ('/etc/cron.monthly'); do 'run-parts'; PAR_EOF open F, "> bcrond-0.82/crontab.F" or die "Couldn't open 'bcrond-0.82/crontab.F': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 495 == $len or warn "bcrond-0.82/crontab.F: original size 495, current size $len"; utime 1042266802, 1042266802, 'bcrond-0.82/crontab.F' or die "Couldn't touch 'bcrond-0.82/crontab.F': $!"; chmod 0644, 'bcrond-0.82/crontab.F' or die "Couldn't chmod 'bcrond-0.82/crontab.F': $!"; } # ============= bcrond-0.82/crontab.f ============== if (-e 'bcrond-0.82/crontab.f' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/crontab.f (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/crontab.f (text)\n"; $_ = <<'PAR_EOF'; XTZ=UTC X X#A comment X #Another comment X#0 0 0 * 6 #Just a place holder X* * * * * /bin/echo "It's alive!" X* * * * * #!perl -e print " 1\n"; warn("+1\n"); die("=2\n") X*/2 * * * * /usr/bin/env && echo "Env!" PAR_EOF open F, "> bcrond-0.82/crontab.f" or die "Couldn't open 'bcrond-0.82/crontab.f': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 216 == $len or warn "bcrond-0.82/crontab.f: original size 216, current size $len"; utime 1042266802, 1042266802, 'bcrond-0.82/crontab.f' or die "Couldn't touch 'bcrond-0.82/crontab.f': $!"; chmod 0644, 'bcrond-0.82/crontab.f' or die "Couldn't chmod 'bcrond-0.82/crontab.f': $!"; } # ============= bcrond-0.82/run-parts ============== if (-e 'bcrond-0.82/run-parts' && $ARGV[0] ne '-c') { warn "x - skipping bcrond-0.82/run-parts (file already exists)\n"; } else { warn "x - extracting bcrond-0.82/run-parts (text)\n"; $_ = <<'PAR_EOF'; X#!/usr/bin/perl X# run-parts - concept taken from Debian via RedHat Xdie("Usage: run-parts \n") if $#ARGV; Xdie("Not a directory: $ARGV[0]\n") unless -d $ARGV[0]; X Xopendir(DIR, $ARGV[0]); Xforeach( grep {!/^\./} readdir(DIR) ){ X $_ = "$ARGV[0]/$_"; X next if -d $_; X system($_) if -x $_; X} Xexit 0; PAR_EOF open F, "> bcrond-0.82/run-parts" or die "Couldn't open 'bcrond-0.82/run-parts': $!"; binmode F; s/^X//gm; $len = length; print F $_; close F; 298 == $len or warn "bcrond-0.82/run-parts: original size 298, current size $len"; utime 1042266802, 1042266802, 'bcrond-0.82/run-parts' or die "Couldn't touch 'bcrond-0.82/run-parts': $!"; chmod 0755, 'bcrond-0.82/run-parts' or die "Couldn't chmod 'bcrond-0.82/run-parts': $!"; } __END__ =pod =head1 NAME cron - daemon to execute scheduled commands (Belga Cron) =head1 SYNOPSIS cron [B<-F> F] [B<-L> I] [B<-M>] [B<-O>] [B<-S>] [B<-U>] [B<-X>] [B<-f> F] [B<-h>] [B<-s>] [B<-x> [I]] =head1 DESCRIPTION Same as Vixie Cron blah blah blah. =head1 README This is a par Ehttp://www.perl.com/language/ppt/src/par/index.htmlE archive. You may extract it by running it through perl as perl bcrond-0.82.par or with unpar (at the same URI). This archive contains a perl clone of Vixie cron, with several enhancements. It should be cross-platform compatible, and is known to work under Windows 9x, Linux, and SunOS/Solaris. =head1 SEE ALSO cron(8), crontab(1), crontab(5) =head1 AUTHOR Jerrad Pierce =head1 EXTENSIONS Almost every feature of Belga Cron is an extension of the original B. Most of them are specific to Belga Cron though some are derived from Sun's implementation and are denoted as such. In addition all extensions in Vixie Cron as of 3.0 are supported, except use of !, namely =over 4 =item lists and ranges can co-exist in the same field =item 3 letter abbreviations of English names for months and days may be used =item job output is mailed (or not) to a specified user =back =pod SCRIPT CATEGORIES UNIX/System_administration Win32/Utilities =head1 OSNAMES Please provide bug reports for OSs where this does not work. =cut