view release on metacpan or  search on metacpan

ddc-tee.perl  view on Meta::CPAN

  die(@_) if ($^S);
  error(@_);
  die(@_);
};

$SIG{$_} = \&die_gracefully
  foreach (qw(INT TERM KILL HUP));
sub die_gracefully {
  my $sig = shift;
  die("terminating on signal $sig");
}

##======================================================================
## utils

our %default_host = (peer=>'127.0.0.1', 'local'=>'0.0.0.0');

## \%connect = parseAddr($addr, $PEER_OR_LOCAL, %opts)
sub parseAddr {
  my $addr = shift;
  my $type = shift || "Peer";
  my %connect = (Domain=>'INET', UserAddr=>$addr, @_);
  if ($addr =~ m{^/} || $addr =~ s{^unix:(?://)?}{}) {
    $connect{Domain}  = 'UNIX';
    $connect{$type} = $addr;
  } else {
    $addr =~ s{^(?:inet|tcp):(?://)?}{};
    my ($host,$port) = split(':',$addr,2);
    ($port,$host) = ($host,$port) if (!$port);
    $host ||= $default_host{lc($type)};
    @connect{"${type}Addr","${type}Port"} = ($host,$port);
  }
  return \%connect;
}


## $str = addrstr($addr, $PEER_OR_LOCAL)
## $str = addrstr(\%addr,$PEER_OR_LOCAL)
## $str = addrstr($dcli, $PEER_OR_LOCAL)
## $str = addrstr($sock, $PEER_OR_LOCAL)
sub addrstr {
  my ($addr,$prefix) = @_;
  $prefix ||= 'Peer';
  return (UNIVERSAL::isa($addr,'DDC::Client')
          ? $addr->addrStr(undef,$prefix)
          : DDC::Client->addrStr($addr,$prefix));
}

## $bool = write_pidfile($pid => $pidfile)
sub write_pidfile {
  my ($pid,$pidfile) = @_;
  return if (!defined($pidfile));
  open(my $fh, ">$pidfile")
    or die("$prog: open failed for $pidfile: $!");
  print $fh $pid, "\n";
  close($fh)
    or die("$prog: close failed for $pidfile: $!");
}

##======================================================================
## callbacks


## undef = cb_client($cli_sock)
sub cb_client {
  my $csock = shift;
  my $cli   = DDC::Client->new( sock=>$csock, encoding=>undef );
  my $req   = $cli->readData();

  ##-- spawn clients
  for (my $bi=1; $bi <= $#b_clients; ++$bi) {
    threads->new(\&cb_client_channel, undef, $req, $b_clients[$bi])->detach();
  }
  cb_client_channel($cli, $req, $b_clients[0]) if (@b_clients);
}

## undef = cb_client_channel($cli_or_undef, $req, $backend_cli)
sub cb_client_channel {
  my ($cli,$req,$bcli) = @_;
  #$prog .= "#".threads->tid();

  if ($cli) {
    ##-- primary back-end: 2-way communications REQUEST<->BCLI
    trace("wrap ", addrstr($cli->{sock}), " <-> ", addrstr($bcli), "\n");
    my $rsp = $bcli->requestNC($req);
    while (defined($rsp) && $cli->{sock}->connected) {
      $cli->send($rsp);
      $req = $rsp = undef;
      eval { $req = $cli->readData(); };
      $@ = '';
      last if (!defined($req));
      $rsp = $bcli->requestNC($req);
    }
    $cli->close();
  }
  if (!$cli) {
    ##-- secondary back-end: 1-way communications REQUEST->BCLI
    trace("forward -> ", addrstr($bcli), "\n");
    $bcli->requestNC($req);
  }
  $bcli->close();
}

##======================================================================
## MAIN

##-- setup logging
if ($verbose !~ /^[0-9]+$/) {
  if (exists($verbose{lc($verbose)})) {
    $verbose = $verbose{lc($verbose)};
  } else {
    warn("$prog: unknown verbosity level '$verbose' - using 'info'");
    $verbose = $verbose{info};
  }
}
if ($log_syslog) {
  openlog($prog, "pid", LOG_DAEMON)
    or die("$prog: failed to open connection to syslog: $!");
  setlogmask( LOG_UPTO(vprio($verbose)) );
}