view release on metacpan or  search on metacpan

lib/App/Regather.pm  view on Meta::CPAN

# my @DAEMONARGS = ($0, @ARGV);
our $VERSION   = '0.85.00';

sub new {
  my $class = shift;
  my $self =
    bless {
	   _progname => fileparse($0),
	   _daemonargs => [$0, @ARGV],
	   _opt   => {
		      ch          => undef,
		      cli         => undef,
		      colors      => 0,
		      config      => '/usr/local/etc/regather.conf',
		      fg          => 0,
		      force       => 0,
		      plugin_list => 0,
		      strict      => 0,
		      ts_fmt      => "%a %F %T %Z (%z)",
		      v           => 0,
		     }
	   }, $class;

  GetOptions(
	     'f|foreground' => \$self->{_opt}{fg},
	     'F|force'      => \$self->{_opt}{force},
	     'c|config=s'   => \$self->{_opt}{config},
	     'colors'       => \$self->{_opt}{colors},
	     'C|cli=s%'     => \$self->{_opt}{cli},
	     'S|strict'     => \$self->{_opt}{strict},
	     'config-help'  => \$self->{_opt}{ch},
	     'plugin-list'  => \$self->{_opt}{plugin_list},
	     'v+'           => \$self->{_opt}{v},
	     'h'            => sub { pod2usage(-exitval => 0, -verbose => 2); exit 0 },
	    );

  $self->{_opt}{l} = new
    App::Regather::Logg( prognam    => $self->{_progname},
			 foreground => $self->{_opt}{fg},
			 colors     => $self->{_opt}{colors} );

  if ( $self->{_opt}{plugin_list} ) {
    App::Regather::Plugin->new( 'list' )->run;
    exit 0;
  }

  if ( ! -e $self->{_opt}{config} || -z $self->{_opt}{config} ) {
    $self->{_opt}{l}->cc(          pr => 'err', fm => "config file does not exist or is empty" );
    $self->{_opt}{l}->cc( fg => 1, pr => 'err', fm => "config file does not exist or is empty" );
    pod2usage(-exitval => 2, -sections => [ qw(USAGE) ]);
    exit 1;
  }

  $self->{_opt}{cf} = new
    App::Regather::Config ( filename => $self->{_opt}{config},
			    logger   => $self->{_opt}{l},
			    cli      => $self->{_opt}{cli},
			    verbose  => $self->{_opt}{v} );

  my $cf_mode = (stat($self->{_opt}{config}))[2] & 0777;
  my $fm_msg;
  if ( $cf_mode & 002 || $cf_mode & 006 ) {
    $fm_msg = 'world';
  } elsif ( $cf_mode & 020 || $cf_mode & 060) {
    $fm_msg = 'group';
  }
  if ( defined $fm_msg ) {
    $self->{_opt}{l}->cc(          pr => 'err', fm => 'config file is accessible by ' . $fm_msg);
    $self->{_opt}{l}->cc( fg => 1, pr => 'err', fm => 'config file is accessible by ' . $fm_msg);
    pod2usage(-exitval => 2, -sections => [ qw(USAGE) ]);
    exit 1;
  }

  $self->{_opt}{last_forever} = 1;

  # !!! TO CORRECT
  if ( ! defined $self->{_opt}{cf} ) {
    $self->l->cc(          pr => 'err', fm => "do fix config file ..." );
    $self->l->cc( fg => 1, pr => 'err', fm => "do fix config file ..." );
    pod2usage(-exitval => 2, -sections => [ qw(USAGE) ]);
    exit 1;
  }

  if ( $self->{_opt}{ch} ) {
    $self->{_opt}{cf}->config_help;
    exit 1;
  }

  return $self;
}

sub progname { shift->{_progname} }

sub progargs { return join(' ', @{shift->{_daemonargs}}); }

sub cf { shift->{_opt}{cf} }

sub l { shift->{_opt}{l} }

sub o {
  my ($self,$opt) = @_;
  croak "unknown/undefined variable"
    if ! exists $self->{_opt}{$opt};
  return $self->{_opt}{$opt};
}

sub run {
  my $self = shift;

  $self->l->cc( pr => 'info', fm => "%s:%s: options provided from CLI:\n%s", ls => [ __FILE__,__LINE__, $self->o('cli') ] )
    if defined $self->o('cli') && keys( %{$self->o('cli')} ) && $self->o('v') > 1;

  $self->l->set_m( $self->cf->getnode('log')->as_hash );
  $self->l->set( notify       => [ $self->cf->get('core', 'notify') ] );
  $self->l->set( notify_email => [ $self->cf->get('core', 'notify_email') ] );

  $self->l->cc( pr => 'info', fm => "%s: Dry Run is set on, no file is to be changed\n" )
    if $self->cf->get(qw(core dryrun));
  $self->l->cc( pr => 'info', fm => "%s:%s: Config::Parse object as hash:\n%s",
	        ls => [ __FILE__,__LINE__, $self->cf->as_hash ] ) if $self->o('v') > 3;

lib/App/Regather.pm  view on Meta::CPAN

				      filter   => $self->cf->get(qw(ldap srch filter)),
				      attrs    => $cfgattrs,
				      sizelimit=> $self->cf->get(qw(ldap srch sizelimit)),
				      timelimit=> $self->cf->get(qw(ldap srch timelimit)),
				    );
    if ( $mesg->code ) {
      $self->l->cc( pr => 'err',
		    fm => "%s:%s: LDAP search ERROR...\n% 13s%s\n% 13s%s\n% 13s%s\n% 13s%s\n\n",
		    ls => [ __FILE__,__LINE__,
			    'base: ',   $self->cf->get(qw(ldap srch base)),
			    'scope: ',  $self->cf->get(qw(ldap srch scope)),
			    'filter: ', $self->cf->get(qw(ldap srch filter)),
			    'attrs: ',  join("\n", @{$cfgattrs}) ] );
      $self->l->cc_ldap_err( mesg => $mesg );
      exit $mesg->code if $self->o('strict');
    } else {
      $self->l->cc( pr => 'info',
		    fm => "%s:%s: LDAP search:\n% 13s%s\n% 13s%s\n% 13s%s\n% 13s%s\n\n",
		    ls => [ __FILE__,__LINE__,
			    'base: ',   $self->cf->get(qw(ldap srch base)),
			    'scope: ',  $self->cf->get(qw(ldap srch scope)),
			    'filter: ', $self->cf->get(qw(ldap srch filter)),
			    'attrs: ',  join("\n", @{$cfgattrs}) ] ) if $self->o('v') > 2;
    }
  }

  $mesg = $self->o('ldap')->unbind;
  if ( $mesg->code ) {
    $self->l->cc_ldap_err( mesg => $mesg );
    exit $mesg->code;
  }

  closelog();

}

#
## ===================================================================
#

sub daemonize {
  my $self = shift;

  my ( $pid, $fh, $pp, $orphaned_pid_mtime );
  if ( -e $self->cf->get(qw(core pid_file)) ) {
    open( $fh, "<", $self->cf->get(qw(core pid_file))) || do {
      die "Can't open $self->cf->get(qw(core pid_file)) for reading: $!";
      exit 1;
    };
    $pid = <$fh>;
    close($fh) || do {
      print "close $self->cf->get(qw(core pid_file)) (opened for reading) failed: $!\n\n";
      exit 1;
    };

    if ( kill(0, $pid) ) {
      print "Doing nothing\npidfile $self->cf->get(qw(core pid_file)) of the proces with pid $pid, exists and the very process is alive\n\n";
      exit 1;
    }

    $orphaned_pid_mtime = strftime( $self->o('ts_fmt'), localtime( (stat( $self->cf->get(qw(core pid_file)) ))[9] ));
    if ( unlink $self->cf->get(qw(core pid_file)) ) {
      $self->l->cc( pr => 'debug', fm => "%s:%s: orphaned %s was removed",
		ls => [ __FILE__,__LINE__, $self->cf->get(qw(core pid_file)) ] )
	if $self->o('v') > 0;
    } else {
      $self->l->cc( pr => 'err', fm => "%s:%s: orphaned %s (mtime: %s) was not removed: %s",
		ls => [ __FILE__,__LINE__, $self->cf->get(qw(core pid_file)), $orphaned_pid_mtime, $! ] );
      exit 2;
    }

    undef $pid;
  }

  $pid = fork();
  die "fork went wrong: $!\n\n" unless defined $pid;
  exit(0) if $pid != 0;

  setsid || do { print "setsid went wrong: $!\n\n"; exit 1; };

  open( $pp, ">", $self->cf->get(qw(core pid_file))) || do {
    print "Can't open $self->cf->get(qw(core pid_file)) for writing: $!"; exit 1; };
  print $pp "$$";
  close( $pp ) || do {
    print "close $self->cf->get(qw(core pid_file)) (opened for writing), failed: $!\n\n"; exit 1; };

  if ( $self->o('v') > 1 ) {
    open (STDIN,  "</dev/null") || do { print "Can't redirect /dev/null to STDIN\n\n";  exit 1; };
    open (STDOUT, ">/dev/null") || do { print "Can't redirect STDOUT to /dev/null\n\n"; exit 1; };
    open (STDERR, ">&STDOUT")   || do { print "Can't redirect STDERR to STDOUT\n\n";    exit 1; };
  }

  $SIG{HUP}  =
    sub { my $sig = @_;
	  $self->l->cc( pr => 'warning', fm => "%s:%s: SIG %s received, restarting", ls => [ __FILE__,__LINE__, $sig ] );
	  exec('perl', @{$self->o('_daemonargs')}); };
  $SIG{INT} = $SIG{QUIT} = $SIG{ABRT} = $SIG{TERM} =
    sub { my $sig = @_;
	  $self->l->cc( pr => 'warning', fm => "%s:%s:  SIG %s received, exiting", ls => [ __FILE__,__LINE__, $sig ] );
	  $self->{_opt}{last_forever} = 0;
	};
  $SIG{PIPE} = 'ignore';
  $SIG{USR1} =
    sub { my $sig = @_;
	  $self->l->cc( pr => 'warning', fm => "%s:%s: SIG %s received, doing nothing" ), ls => [ __FILE__,__LINE__, $sig ] };

  if ( $self->cf->is_set(qw(core uid)) && $self->cf->is_set(qw(core gid)) ) {
    setgid ( $self->cf->get(qw(core gid_number)) ) || do { print "setgid went wrong: $!\n\n"; exit 1; };
    setuid ( $self->cf->get(qw(core uid_number)) ) || do { print "setuid went wrong: $!\n\n"; exit 1; };
  }

  $self->l->cc( pr => 'info', fm => "%s:%s: %s v.%s is started.", ls => [ __FILE__,__LINE__, $self->progname, $VERSION ] );
}

sub ldap_search_callback {
  my ( $self, $msg, $obj ) = @_;


  my @controls = $msg->control;
  my $syncstate = scalar @controls ? $controls[0] : undef;