view release on metacpan or  search on metacpan

Honeypot.pm  view on Meta::CPAN

	sock	=> $dns,
	alarm	=> 0,
#	name	=> '4.3.2.1.in-addr.arpa',
#	read	=> \&dns_rcv
  };
  $dns = {};					# dns transaction hash
}

sub my_dump {
  my %names;
  local *pref = __PACKAGE__ . '::';
  foreach(keys %{*pref}) {
    $names{'*'.$_} = \&{*pref->{$_}};
  }
  my @d = (
	$threads	=> 'threads',
	$dns		=> 'dns',
  );
  for ($_=0;$_<@d;$_+=2) {
    my $d = new Data::Dumper([$d[$_]],[$d[$_+1]]);
    $d->Seen(\%names);
    @_ = split(/\n/,$d->Dump);
    foreach(@_) {
      logit($_ ."\n");
    }
  }
}

sub daemon {
  unless ($syslog && $syslog eq 'STDERR') {
    open STDERR, '>/dev/null' or die "Can't dup STDERR to /dev/null: $!";
  }

# initialization complete, log start up message
  logit('Initiated...');

  my $run = 1;
  local $SIG{TERM} = sub {$run = 0};
  local $SIG{USR1} = \&my_dump;
  local $SIG{PIPE} = 'IGNORE';

  my $then = time;
  my $sock = open_listenNB($port,$laddr);
  die "could not open listen socket on port $port\n"
	unless $sock;
  my $fileno = fileno($sock);
  my $go_listen = $threads->{$fileno} = {
	sock	=> $sock,
	alarm	=> 0,
	read	=> \&newthread,
#	next	=> \&next thing to do
  };
  my($rin,$win,$rout,$wout,$delta,$nfound);
  while($run) {
    $win = $rin = '';
    $threads->{$DNSfileno}->{read} = \&dns_rcv;		# always armed
    foreach(grep(!/\D/,keys %$threads)) {		# each thread key
      vec($rin,$_,1) = 1 if $threads->{$_}->{read};	# set read selects
      vec($win,$_,1) = 1 if $threads->{$_}->{write};	# set write selects
    }
    $go_listen->{read} = \&newthread;			# re-arm listner if it was busy
    $nfound = select($rout=$rin,$wout=$win,undef,1);	# tick each second

    if ($nfound > 0) {
      do_thread($wout,'write') if $wout;
      do_thread($rout,'read') if $rout;
    }
    elsif ($delta = ($_ = time) - $then) {		# timer = next second or more
      $then = $_;
      my @threads = keys %$threads;
      foreach(@threads) {				# each receive thread
        next unless exists $threads->{$_};
	my $tptr = $threads->{$_};
	if ($tptr->{alarm} &&
	  ($tptr->{alarm} + $delay) < $then) {
	  $tptr->{alarm} = time + $disconnect - $delay;
	  my($logtxt,$go);
	  if ($tptr->{tout}) {
	    $go = $tptr->{tout};
	    $logtxt = 'tout ';
	  } else {
	    $go = $tptr->{next};
	    $logtxt = 'next ';
	  }
	  if ($verbose > 3) {			# deep trace
	    $logtxt = &who ."delay ended for '$_' $logtxt => ".
		(exists $subref{$go}) ? $subref{$go} : 'sub ref not defined';
	    logit($logtxt);
	  }
	  elsif ($verbose > 2) {
	    logit(&who ."delay ended for '$_'\n");
	  }
	  $go->($_);
	  if (exists $threads->{$_} && ! $threads->{$_}->{tout}) {
	    $threads->{$_}->{tout} = \&terminate
	  }
	  last;
	}
      }
      foreach(keys %$dns) {				# each dns thread
	if ($dns->{$_}->{alarm} &&
	  ($dns->{$_}->{alarm} + $delay) < $then) {
	  logit(&who ."dns ended for id $_ for $dns->{$_}->{fileno}\n") unless $verbose < 3;
	  delete $dns->{$_};
	  last;						# only do one per check for efficiancy
	}
      }
    }
  }
  &close_all;
  logit('Exiting...');
  closelog();
  exit 0;
}

#
# execute a thread based on what the select routine returns
# sort used for testing only
#

sub do_thread {		# t => do_thread.t