view release on metacpan or  search on metacpan

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

      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;

  my ( $s, $st, $mesg, $entry, @entries, $ldif, $map,
       $out_file_pfx_old,
       $tmp_debug_msg,
       $rdn, $rdn_old, $rdn_re,
       $pp, $chin, $chou, $chst, $cher, $email, $email_body );

  ######## !! not needed ?
  my $out_file_old;
  
  $self->l->cc( pr => 'debug', fm => "%s:%s: syncstate: %s", ls => [ __FILE__,__LINE__, $syncstate ] )
    if $self->o('v') > 5;
  $self->l->cc( pr => 'debug', fm => "%s:%s: object: %s", ls => [ __FILE__,__LINE__, $obj ] ) if $self->o('v') > 5;

  if ( defined $obj && $obj->isa('Net::LDAP::Entry') ) {
    $rdn = ( split(/=/, ( split(/,/, $obj->dn) )[0]) )[0];
    if ( defined $syncstate && $syncstate->isa('Net::LDAP::Control::SyncState') ) {
      $self->l->cc( pr => 'debug', fm => "%s:%s: SYNCSTATE:\n%s:", ls => [ __FILE__,__LINE__, $syncstate ] )
	if $self->o('v') > 4;
      $st = $syncstate->state;
      my %reqmod;
      $self->l->cc( fm => "%s:%s: received control %s: dn: %s", ls => [ __FILE__,__LINE__, SYNST->[$st], $obj->dn ] );

      #######################################################################
      ####### --- PRELIMINARY STUFF ----------------------------->>>>>>>>> 0
      #######################################################################

      ### LDAP_SYNC_DELETE arrives for both cases, object deletetion and attribute
      ### deletion and in both cases Net::LDAP::Entry obj, provided contains only DN,
      ### so, we need to "re-construct" it for further processing
      if ( $st == LDAP_SYNC_DELETE ) {
	$mesg = $self->o('ldap')->search( base     => $self->cf->get(qw(ldap srch log_base)),
			       scope    => 'sub',
			       sizelimit=> $self->cf->get(qw(ldap srch sizelimit)),
			       timelimit=> $self->cf->get(qw(ldap srch timelimit)),
			       filter   => '(reqDN=' . $obj->dn . ')', );
	if ( $mesg->code ) {
	  $self->l->cc( pr => 'err', nt => 1,
		    fm => "%s:%s: LDAP accesslog search on %s, error:\n% 13s%s\n% 13s%s\n% 13s%s\n\n",
		    ls => [ __FILE__,__LINE__, SYNST->[$st],
			    'base: ',   $self->cf->get(qw(ldap srch log_base)),
			    'scope: ',  'sub',
			    'filter: ', '(reqDN=' . $obj->dn . ')' ] );
	  $self->l->cc_ldap_err( mesg => $mesg );
	  # exit $mesg->code; # !!! NEED TO DECIDE WHAT TO DO
	} else {
	  if ( $mesg->count == 0 ) {
	    $self->l->cc( pr => 'err', nt => 1,