view release on metacpan or  search on metacpan

CAB/Server/HTTP/UNIX.pm  view on Meta::CPAN

## Methods: Local: error handling: inherited

##==============================================================================
## PACKAGE: DTA::CAB::Server::HTTP::UNIX::ClientConn
package DTA::CAB::Server::HTTP::UNIX::ClientConn;
use File::Basename qw(basename);
use DTA::CAB::Utils qw(:proc);
our @ISA = qw(HTTP::Daemon::ClientConn);

## ($pid,$uid,$gid) = $sock->peercred()
##  + gets peer credentials; returns (-1,-1,-1) on failure
sub peercred {
  my $sock = shift;
  if ($sock->can('SO_PEERCRED')) {
    my $buf = $sock->sockopt($sock->SO_PEERCRED);
    return unpack('lll',$buf);
  }
  return (-1,-1,-1);
}

## \%env = $sock->peerenv()

CAB/Server/HTTP/UNIX.pm  view on Meta::CPAN

  }

  ##-- debug
  #print STDERR "PEERENV($sock): $_=$env{$_}\n" foreach (sort keys %env);

  ${*$sock}{'peerenv'} = \%env;
}

## $str = $sock->peerstr()
## $str = $sock->peerstr($uid,$gid,$pid)
##  + returns stringified unix peer credentials: "${USER}.${GROUP}[${PID}]"
sub peerstr {
  my ($sock,$pid,$uid,$gid) = @_;
  ($pid,$uid,$gid) = $sock->peercred() if (@_ < 4);
  return (
	  (defined($uid) ? (getpwuid($uid)//'?') : '?')
	  .'.'
	  .(defined($gid) ? (getgrgid($gid)//'?') : '?')
	  .':'
	  .(defined($pid) ? (basename(pid_cmd($pid)//'?')."[$pid]") : '?[?]')
	 );
}

## $host = peerhost()
##  + for relayed connections, gets underlying TCP peer via socat environment
##  + for unix connections, returns UNIX credentials as as for peerstr()
sub peerhost {
  my $sock = shift;

  ##-- get UNIX socket credentials
  my ($pid,$uid,$gid) = $sock->peercred();
  if (defined($pid) && basename(pid_cmd($pid)//'?') eq 'socat') {
    ##-- get socat environment variable if applicable
    my $env = $sock->peerenv();
    return $env->{DTA_CAB_RELAY_PEERADDR} if ($env && $env->{DTA_CAB_RELAY_PEERADDR});
  }

  ##-- return UNIX socket credentials
  return $sock->peerstr($pid,$uid,$gid);
}

## $port = peerport()
##  + for relayed connections, gets underlying TCP port via socat environment
##  + for unix connections, returns socket path
sub peerport {
  my $sock = shift;

  ##-- get UNIX socket credentials
  my ($pid,$uid,$gid) = $sock->peercred();
  if (defined($pid) && basename(pid_cmd($pid)//'?') eq 'socat') {
    ##-- get socat environment variable if applicable
    my $env = $sock->peerenv();
    return $env->{DTA_CAB_RELAY_PEERPORT} if ($env && $env->{DTA_CAB_RELAY_PEERPORT});
  }

  ##-- return UNIX socket path
  return $sock->peerpath();
}

CAB/Server/HTTP/UNIX.pm  view on Meta::CPAN

L<DTA::CAB::Server::HTTP::UNIX|DTA::CAB::Server::HTTP::UNIX::ClientConn>
inherits from
L<HTTP::Daemon::ClientConn|HTTP::Daemon>
and should support most HTTP::Daemon::ClientConn methods.

=item peercred

 ($pid,$uid,$gid) = $sock->peercred();

Gets UNIX socket peer credentials; returns (-1,-1,-1) on failure.

=item peerenv

 \%env = $sock->peerenv();
 \%env = $sock->peerenv($pid);

Attempts to retrieve environment variables for peer process, if possible.
Uses cached value in ${*sock}{peerenv} if present,
otherwise attempts to open and parse F</proc/$pid/environ>.
Returns undef on failure.

=item peerstr

 $str = $sock->peerstr();
 $str = $sock->peerstr($uid,$gid,$pid);

Returns stringified unix peer credentials, "${USER}.${GROUP}[${PID}]".

=item peerhost

 $host = peerhost();

For relayed connections, gets underlying TCP peer via socat environment (INET emulation);
for unix connections, returns UNIX credentials as as for peerstr().

=item peerport

 $port = peerport();

For relayed connections, gets underlying TCP port via socat environment (INET emulation);
for unix connections, returns socket path:

=back