#!/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 <net@dirty-bastard.pthbb.org>.
# 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<bcrond/BUGS>
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 <nobody@localhost> /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</usr/local/sbin:/sbin:/bin:/usr/sbin:/usr/bin> (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<perl> 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(<DEFAULT>){
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( <TAB> ){
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<file>] [B<-L> I<log>] [B<-M>] [B<-O>] [B<-S>] [B<-U>] [B<-X>] [B<-f> F<file>] [B<-h>] [B<-s>] [B<-x> [I<debugflag>]]
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<crontab>
X
XLike B<-f> below except that it expects a user (6th) field.
X
X=item B<-L> I<log>
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<cron> forks and then the specified command.
XWith B<-O> commands denoted by C<#!perl -e> are C<eval>d 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<fork>, 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<cron> from daemonizing; forces B<-s> and does not seperate
Xfrom the terminal.
X
X=item B<-f> F<crontab>
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<cron> to serialize job processing. 
X
XThis can produce unexpected results if you are setUIDing; running jobs
Xvia B<-F> or from F</etc/crontab> or F</etc/cron.d>.
X
X=item B<-x> [I<debugflag>]
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<Cron> needs to C<fork> in order to handle all the SetUIDing
Xit does for security. It tries to catch perls which cannot
XC<fork> and C<die>s, 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<Cron> was unable to open crontab AAA.
X
X=item Couldn't create pipe: AAA
X
XB<Cron> 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<Cron> uses nothing save PATH from it's environment.
XHowever crontabs may contain environment variable settings for jobs.
XSee L<crontab(5)>.
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</etc/defaults/cron>;
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</var/log/cron/>; and is equivalent to B<-L> I<log>.
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</etc/crontab>
X
X=item F</etc/cron.d/>
X
X=item F</var/spool/cron> OR F</var/spool/cron/crontabs> (Solaris)
X
XThese are the default crontabs that list the jobs B<cron> is supposed to run.
XSee B<-f>.
X
X=item F</etc/default/cron>
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</var/log/cron/info>
X
X=item F</var/log/cron/warnings>
X
X=item F</var/log/cron/errors>
X
XB<Cron> 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<perl> implements C<pipe>.
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 <jpierce@cpan.org>
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<ftp://ftp.vix.com/pub/vixie/>
X
X=head1 EXTENSIONS
X
XAlmost every feature of Belga Cron is an extension of the original B<cron>.
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 <dir>\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<file>] [B<-L> I<log>] [B<-M>] [B<-O>] [B<-S>] [B<-U>] [B<-X>] [B<-f> F<file>] [B<-h>] [B<-s>] [B<-x> [I<debugflag>]]

=head1 DESCRIPTION

Same as Vixie Cron blah blah blah.

=head1 README

This is a par E<lt>http://www.perl.com/language/ppt/src/par/index.htmlE<gt>
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 <jpierce@cpan.org>

=head1 EXTENSIONS

Almost every feature of Belga Cron is an extension of the original B<cron>.
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