view release on metacpan or  search on metacpan

lib/IxNetwork/IxNetwork.pm  view on Meta::CPAN

}

sub _log {
    my $self = shift;
    my $msg = shift;

    if ($self->{_debug}) {
        my $now = localtime(time);
        if (length($msg) > 1024) {
            $msg = substr($msg, 0, 1024)."...\n";
        }
        print '['.$now.'] [IxNet] [debug] '.$msg;
    }
}

sub _detectTransport {
    my ($self, $hostname, $port) = @_;

    $self->_log("Detecting transport type...\n");
    my $_socket = undef;
    my $_transport = undef;
    my $usingDefaultPorts = undef;
    if (not defined $port) {
        $port = 8009;
        $usingDefaultPorts = 1;
    } else {
        $usingDefaultPorts = 0;
    }

    my $ret = eval {      
        my $inetAddress = undef;
        my $sockAddress = undef;
        if (validate::isIpv6($hostname) == 0) {
            # connect to IPv4 address (or a host name).
            my $protocol = getprotobyname('tcp');
            socket($_socket, Socket::AF_INET, Socket::SOCK_STREAM, $protocol);
            my $inetAddress = gethostbyname($hostname);
            my $sockAddress = Socket::sockaddr_in($port, $inetAddress);
            $_socket->blocking(0);
            CORE::connect($_socket, $sockAddress);
        } else {
            # connect to a IPv6 address.
            if (!$checkDependencies::ipv6LoadError) {
                require LWP::Protocol::INET6;
                $_socket = LWP::Protocol::INET6->new(
                        PeerAddr => $hostname,
                        PeerPort => $port,
                        Proto    => 'tcp',
                )
                or die("Unknown Ipv6 address $hostname\n");
            } else {
                die("Unable to load perl IPv6 module\n");
            }
        }

        my $sock = $_socket;
        my $rin = '';
        my $win = '';
        my $buffer = '';
        my $timeout = 15;
        my $iterations = 2;
        vec($rin, fileno($sock), 1) = 1;
        vec($win, fileno($sock), 1) = 1;
        my $ein= $rin | $win;
        my $socketOpen = select(my $rout = $rin, my $wout = $win, my $eout = $ein, 1);
        while ($iterations > 0 and !$socketOpen) {
            $socketOpen = select(my $rout = $rin, my $wout = $win, my $eout = $ein, 1);
            $iterations -= 1;
        }
        if (!$socketOpen) {
            die "Host is unreachable.\n";
        }
        $_socket->blocking(1);
            
        vec($rin, fileno($sock), 1) = 1;
        my $readOpen = select(my $rout = $rin, undef, undef, $timeout);
        if (!$readOpen) {
            vec($win, fileno($sock), 1) = 1;
            my $writeOpen = select(undef, my $wout = $win, undef, $timeout);
            if ($writeOpen) {
                $_transport = $self->{__ixNetworkSecure};
            }
        }
        my $char = undef;
        $_socket->blocking(0);
        while(not defined $_transport) {
            $_socket->read($char, 1);    

            if (length($char) == 0) {
                last;
            }
            $buffer .= $char;
            if (length $buffer == 4) {
                if (index($buffer, '<001') == 0) {
                    $_transport = $self->{__ixNetworkLegacy};
                    last;
                } elsif (index($buffer, 'HTTP') != 0) {
                    $_transport = $self->{__ixNetworkSecure};
                    last;
                }
            }
            if ((length $buffer > 50) && 
                (index($buffer, 'Server: IxNetwork API Server') != -1) ||
                (index($buffer, 'Server: Connection Manager') != -1)) {
                    $_transport = $self->{__ixNetworkLegacy};
                    last;
            }
        }
        1;
    };
    if (!$ret and $@) {
        if ($_socket) {
            $_socket->close();
            $_socket = undef;
        }
        if (!$usingDefaultPorts) {
            die "Unable to connect to ".$hostname.':'.$port.'. Error: '.$@."\n";
        }
    }
    if ($_socket) {
        $_socket->close();
    }
    if ($usingDefaultPorts and (not defined $_transport)) {
        $_transport = $self->{__ixNetworkSecure};
    }
    if (not defined $_transport) {
        if (!$usingDefaultPorts) {
            die "Unable to connect to ".$hostname.':'.$port.". Error: Host is unreachable.\n";