view release on metacpan or  search on metacpan

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

  }

  @{$tmp} = sort @{[ @{$cfgattrs}, qw( associatedDomain
				       authorizedService
				       description
				       entryUUID
				       entryCSN
				       createTimestamp
				       creatorsName
				       modifiersName
				       modifyTimestamp ) ]};
  @{$cfgattrs} = uniqstr @{$tmp};

  #
  ## -=== MAIN LOOP =====================================================-
  #

  my $ldap_opt      = $self->cf->getnode(qw(ldap opt))->as_hash;
  my $uri           = delete $ldap_opt->{uri};
  while ( $self->o('last_forever') ) {
    if ( $self->cf->is_set(qw(core altroot)) ) {
      chdir($self->cf->get(qw(core altroot))) || do {
	$self->l->cc( pr => 'err', fm => "%s:%s: main: unable to chdir to %s",
		  ls => [ __FILE__,__LINE__, $self->cf->get(qw(core altroot)) ] );
	exit 1;
      };
    }

    $self->{_opt}{ldap} =
      Net::LDAP->new( $uri, @{[ map { $_ => $ldap_opt->{$_} } %$ldap_opt ]} )
	|| do {
	  $self->l->cc( pr => 'err', fm => "%s:%s: Unable to connect to %s; error: %s",
			ls => [ __FILE__,__LINE__, $uri, $! ] );
	  if ( $self->o('strict') ) {
	    exit LDAP_CONNECT_ERROR;
	  } else {
	    next;
	  }
	};

    my $start_tls_options = $self->cf->getnode(qw(ldap ssl))->as_hash if $self->cf->is_section(qw(ldap ssl));
    if ( exists $start_tls_options->{ssl} && $start_tls_options->{ssl} eq 'start_tls' ) {
      delete $start_tls_options->{ssl};
      eval {
	$mesg =
	  $self->o('ldap')->start_tls( @{[ map { $_ => $start_tls_options->{$_} } %$start_tls_options ]} );
      };
      if ( $@ ) {
	$self->l->cc( pr => 'err', fm => "%s:%s: TLS negotiation failed: %s", ls => [ __FILE__,__LINE__, $! ] );
	if ( $self->o('strict') ) {
	  exit LDAP_CONNECT_ERROR;
	} else {
	  next;
	}
      } else {
	$self->l->cc( pr => 'info', fm => "%s: TLS negotiation succeeded" ) if $self->o('v') > 1;
      }
    }

    my $bind = $self->cf->getnode(qw(ldap bnd))->as_hash if $self->cf->is_section(qw(ldap bnd));
    if ( ref($bind) eq 'HASH' ) {
      if ( exists $bind->{dn} ) {
	my @bind_options;
	push @bind_options, delete $bind->{dn};
	while ( my($k, $v) = each %{$bind} ) {
	  push @bind_options, $k => $v;
	}
	$mesg = $self->o('ldap')->bind( @bind_options );
	if ( $mesg->code ) {
	  ####### !!!!!!! TODO: to implement exponential delay on error sending to awoid log file/notify
	  ####### !!!!!!! queue overflow
	  $self->l->cc( pr => 'err', fm => "%s:%s: bind error: %s",
			ls => [ __FILE__,__LINE__, $mesg->error ] );
	  if ( $self->o('strict') ) {
	    exit $mesg->code;
	  } else {
	    next;
	  }
	}
      }
    }

    $self->{_opt}{req} =
      Net::LDAP::Control::SyncRequest->new( mode     => LDAP_SYNC_REFRESH_AND_PERSIST,
					    critical => 1,
					    cookie   => undef, );

    $mesg = $self->o('ldap')->search( base     => $self->cf->get(qw(ldap srch base)),
				      scope    => $self->cf->get(qw(ldap srch scope)),
				      control  => [ $self->o('req') ],
				      callback => sub {$self->ldap_search_callback(@_)},
				      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 ) {