git.maemo.org Git - dh-make-perl/blob - dev/arm/libnet-ssleay-perl/libnet-ssleay-perl-1.35/debian/libnet-ssleay-perl/usr/lib/perl5/auto/Net/SSLeay/open_tcp_connection.al

   1 # NOTE: Derived from blib/lib/Net/SSLeay.pm.
   2 # Changes made here will be lost when autosplit is run again.
   3 # See AutoSplit.pm.
   4 package Net::SSLeay;
   5
   6 #line 1802 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/open_tcp_connection.al)"
   7 sub open_tcp_connection {
   8     my ($dest_serv, $port) = @_;
   9     my ($errs);
  10
  11     $port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
  12     my $dest_serv_ip = gethostbyname($dest_serv);
  13     unless (defined($dest_serv_ip)) {
  14         $errs = "$0 $$: open_tcp_connection: destination host not found:"
  15             . " `$dest_serv' (port $port) ($!)\n";
  16         warn $errs if $trace;
  17         return wantarray ? (0, $errs) : 0;
  18     }
  19     my $sin = sockaddr_in($port, $dest_serv_ip);
  20
  21     warn "Opening connection to $dest_serv:$port (" .
  22         inet_ntoa($dest_serv_ip) . ")" if $trace>2;
  23
  24     my $proto = getprotobyname('tcp');
  25     if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
  26         warn "next connect" if $trace>3;
  27         if (CORE::connect (SSLCAT_S, $sin)) {
  28             my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
  29             warn "connected to $dest_serv, $port" if $trace>3;
  30             return wantarray ? (1, undef) : 1; # Success
  31         }
  32     }
  33     $errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
  34     warn $errs if $trace;
  35     close SSLCAT_S;
  36     return wantarray ? (0, $errs) : 0; # Fail
  37 }
  38
  39 # end of Net::SSLeay::open_tcp_connection
  40 1;