File Coverage

blib/lib/SVN/Utils/ClientIP.pm

Criterion	Covered	Total	%
statement	34	46	73.9
branch	3	12	25.0
condition			n/a
subroutine	7	8	87.5
pod	0	4	0.0
total	44	70	62.8

###########################################
package SVN::Utils::ClientIP;
###########################################
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(ssh_client_ip);
our $VERSION = "0.02";

use Proc::ProcessTable;
use Proc::Info::Environment;

###########################################
sub ssh_client_ip {
###########################################

    my $finder = __PACKAGE__->new();

    my($ip, $pid, $port) = $finder->ssh_client_ip_find();

    if( !defined $ip ) {
        warn $finder->error();
    }

      # only IP
    return $ip;
}

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $proc_info  = Proc::Info::Environment->new();
    my $proc_table = Proc::ProcessTable->new();

    my %ppid_of = ();
    foreach my $proc ( @{$proc_table->table} ) {
      $ppid_of{ $proc->pid() } = $proc->ppid();
    }

    my $self = {
        proc_info           => $proc_info,
        ppid_of             => \%ppid_of,
        pid                 => $$,
        ssh_client_var_name => "SSH_CLIENT",
        error               => undef,
        %options
    };

    bless $self, $class;
}

###########################################
sub ssh_client_ip_find {
###########################################
    my($self) = @_;

    my $pid = $self->{pid};

    while( exists $self->{ppid_of}->{ $pid } ) {

        $pid = $self->{ppid_of}->{ $pid };

        last if $pid == 0;

        my $env = $self->{proc_info}->env( $pid );

        if(! defined $env) {
            $self->error( $self->{proc_info}->error() );
            return undef;
        }

        if( exists $env->{ $self->{ssh_client_var_name} } ) {
            my($ip, $pid, $port) = split /\s+/,
                               $env->{ $self->{ssh_client_var_name} };

            if( wantarray ) {
                return ($ip, $pid, $port);
            }

            return $ip;
        }
    }

    $self->error( "Can't find $self->{ssh_client_var_name} anywhere" );
    return undef;
}

###########################################
sub error {
###########################################
    my($self, $error) = @_;

    if(defined $error) {
        $self->{error} = $error;
    }

    return $self->{error};
}

1;

__END__