See HTTP::Daemon which subclasses IO::Socket::INET globs to hang its state off.

I think I do not need subclassing. I need to override CORE::connect. But module IO::Socket::WhatEver, which used inside myconnect() can't use passed socket, it creates its own. But how can I combine this new socket with passed socket?

The advantage of subclassing might be that you can keep the effects of overriding local to where you actually need it.  Overriding the system builtin with

BEGIN  {
    *CORE::GLOBAL::connect = sub (*$) {  
        ...
    }
}
[download]

would (as the ::GLOBAL hints at) be global — which might or might not be what you really want...

I'm not really sure I understand your basic design: why would an existing socket be passed to your myconnect(), which cannot really be used, and thus needs to be replaced or "merged" with another one? Why not create a proper one in the first place? What is the relation of the existing socket with the new custom one, i.e. what functionality or data would it share? Could you elaborate on your usage context?

The code below handles both client and server sockets.

This breaks down if someone subclasses IO::Socket::INET, but it would require some serious mucking to support that.

use Socket           qw( );
use IO::Socket::INET qw( );

my @config = (
    ProxyAddr    => 'localhost',
    ProxyPort    => 1080,
    SocksVersion => 5,
    SocksDebug   => 1,
);

*CORE::GLOBAL::connect = sub(*$) {
    my ($socket, $name) = @_;

    if (eval { $socket->isa('IO::Socket::Socks') }) {
        return CORE::connect($socket, $name);
    }

    my ($port, $host) = sockaddr_in($name);
    $host = inet_ntoa($host);

    $_[0] = IO::Socket::Socks->new(
        @config,
        ConnectAddr => $host,
        ConnectPort => $port,
    );

    return $_[0] && 1;
};

{
    my $old_inet_new = \&IO::Socket::INET::new;

    my $new_inet_new = sub {
        my $class = shift;
        if ($class->isa('IO::Socket::Socks')) {
            return $class->$old_inet_new(@_);
        } else {
            my %args = @_;

            my $addr = delete($args{PeerHost});
            $addr = delete($args{PeerAddr}) if exists($args{PeerAddr})
+;

            my $port = delete($args{PeerPort});

            ($addr, $port) = IO::Socket::INET::sock_info($addr, $port,
+ undef)
                or die;

            $args{ConnectAddr} = $addr if defined($addr);
            $args{ConnectPort} = $port if defined($port);

            return IO::Socket::Socks->new(@config, %args);
        }
    };

    no warnings 'redefine';
    *IO::Socket::INET::new = $new_inet_net;
}
[download]

Untested.

Found a bug. PeerHost, PeerAddr, PeerPort need to be converted to ConnectAddr, ConnectPort. Fixed it.

Thanks, very interesting hack

I'm not sure I'm understanding you correctly, but it somehow sounds like you want to subclass IO::Socket or IO::Socket::INET, and override selected methods with your own implementations (?)   Calls to other methods would then be forwarded to the superclass...

#!/usr/bin/perl -w
use strict;

package IO::Socket::WhatEver;
use IO::Socket::INET;
use base "IO::Socket::INET";

sub connect {
    print "doing my own stuff in connect()...\n";
    my $sock = shift;
    return $sock->SUPER::connect(@_);
}

package main;

my $mysock = IO::Socket::WhatEver->new(
                 PeerAddr => 'perlmonks.org',
                 PeerPort => 'http(80)',
                 Proto    => 'tcp',
             );
# ...
[download]

$ ./883113.pl
doing my own stuff in connect()...
[download]

Instead of calling $sock->SUPER::connect(...) in the overridden method (which eventually calls the connect() builtin), you can of course also call your own low-level connect() implementation... provided it does something which is compatible with what the regular builtin would do.

No. I want to override builtin connect() function (CORE::connect).

No, no you don't :) CORE::GLOBAL::close - how to override properly

As for your update, I think the problem is caused by the following snippet in IO::Socket::INET (line 232):

       if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
#            ${*$sock}{'io_socket_timeout'} = $timeout;
            return $sock;
        }
[download]

Here, the return value of $sock->connect(...) is your overridden glob/socket (which is correctly connected), but IO::Socket::INET is returning the original glob, which never has been connected (due to your overriding mechanism). This $sock is then propagated back as the return value of ->new(), so that you're calling ->syswrite on an unconnected socket.

Here's a short demo, replacing IO::Socket::Socks with a dummy module "IO::Socket::Foo" (which mimicks IO::Socket::Socks in that it also subclasses IO::Socket::INET), so it can be run standalone without a socks5 server:

BEGIN {
    *CORE::GLOBAL::connect = sub(*$) {
        my ($socket, $name) = @_;

        return CORE::connect($socket, $name) if ref($socket) eq 'IO::S
+ocket::Foo';
        
        $_[0] = IO::Socket::Foo->new('perlmonks.org:80') or return und
+ef;
            
        return 1;
    }
}

package IO::Socket::Foo;
use IO::Socket::INET;
use base "IO::Socket::INET";

package main;

$SIG{PIPE} = sub { die "Broken pipe!\n" };

my $sock = IO::Socket::INET->new('perlmonks.org:80')
    or die $@;

print "\$sock is: $sock\n";

$sock->syswrite("GET / HTTP/1.0\r\n");
$sock->close();
[download]

When you replace the above mentioned snippet in IO::Socket::INET with

        if (my $mysock = $sock->connect(pack_sockaddr_in($rport, $radd
+r))) {
            print "DEBUG orig glob: $sock\n";
            print "DEBUG open glob: $mysock\n";
            bless $mysock, ref($sock);
            print "DEBUG reblessed: $mysock\n\n";
            return $mysock;
        }
[download]

everything works as expected, and you'll get

$ ./883113.pl
DEBUG orig glob: IO::Socket::Foo=GLOB(0x9929e8)
DEBUG open glob: IO::Socket::Foo=GLOB(0x9929e8)
DEBUG reblessed: IO::Socket::Foo=GLOB(0x9929e8)

DEBUG orig glob: IO::Socket::INET=GLOB(0x992688)
DEBUG open glob: IO::Socket::Foo=GLOB(0x9929e8)
DEBUG reblessed: IO::Socket::INET=GLOB(0x9929e8)

$sock is: IO::Socket::INET=GLOB(0x9929e8)
[download]

As you can see, the final socket is the same handle (GLOB(0x9929e8)) that you created/connected with *CORE::GLOBAL::connect.

However, when you return $sock in the above snippet - as done in the original code - you'd get:

$ ./883113.pl
DEBUG orig glob: IO::Socket::Foo=GLOB(0x9929e8)
DEBUG open glob: IO::Socket::Foo=GLOB(0x9929e8)
DEBUG reblessed: IO::Socket::Foo=GLOB(0x9929e8)

DEBUG orig glob: IO::Socket::INET=GLOB(0x992688)
DEBUG open glob: IO::Socket::Foo=GLOB(0x9929e8)   <---
DEBUG reblessed: IO::Socket::INET=GLOB(0x9929e8)      |
                                                      |
$sock is: IO::Socket::INET=GLOB(0x992688)  <--- != ---
Broken pipe!
[download]

because you're then trying to use the unconnected handle GLOB(0x992688).

Unfortunalely, this won't really help with your aim of socksifying arbitrary modules.. unless you mess with (and have control over) the IO::Socket::INET code.

Thanks for your research. It's clarified the situation.

Fictional module IO::Socket::WhatEver returns its own typeglob which can be used as IO::Socket::INET object or tcp socket

A IO::Socket::INET object is a socket handle.

print($socket ...);   # Use as socket/file handle
send($socket, ...);   # Use as socket/file handle

$socket->print(...);  # Use as object
$socket->send(...);   # Use as object
[download]

If that's the purpose of IO::Socket::WhatEver, then you don't need it. ( After reading more, I see that's not the purpose. ) If IO::Socket::WhatEver also does other things, you need to inherit from IO::Handle, perhaps via IO::Socket::INET. Keep in mind the variable around which the object is based is a glob, not a hash. ( Yup, that's what you'll have to do. )

sub new_from_socket
{
    my ($class, $sock, %arg) = @_;
    
    bless $sock, $class;
    
    $sock->autoflush(1);
    ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
    
    return scalar(%arg) ? $sock->configure(\%arg)
            : $sock;
}
[download]

use Socket;

BEGIN {
    *CORE::GLOBAL::connect = sub(*$) {
        my ($socket, $name) = @_;
    
        return CORE::connect($socket, $name) if (scalar(caller 2) eq '
+IO::Socket::Socks');
        
        my ($port, $host) = sockaddr_in($name);
        $host = inet_ntoa($host);
        
        my $ref = ref($socket);
        
        IO::Socket::Socks->new_from_socket(
            $socket,
            ProxyAddr => 'localhost',
            ProxyPort => 1080,
            SocksVersion => 5,
            ConnectAddr => $host,
            ConnectPort => $port,
            #SocksDebug => 1
        ) or return undef;
        
        bless $socket, $ref if $ref;
            
        return 1;
    }
}

use IO::Socket::Socks;
[download]