view release on metacpan or  search on metacpan

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

    $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 ) {
    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 ) = @_;