view release on metacpan or  search on metacpan

lib/Net/Clacks/Client.pm  view on Meta::CPAN

    my $udsloaded = 0;
    eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
        require IO::Socket::UNIX;
        $udsloaded = 1;
    };
    if(!$udsloaded) {
        croak("Specified a unix domain socket, but i couldn't load IO::Socket::UNIX!");
    }

    $self->{socketpath} = $socketpath;

    $self->init($username, $password, $clientname, $iscaching);

    return $self;
}

sub init($self, $username, $password, $clientname, $iscaching) {
    if(!defined($username) || $username eq '') {
        croak("Username not defined!");
    }
    if(!defined($password) || $password eq '') {
        croak("Password not defined!");
    }

    if(!defined($clientname || $clientname eq '')) {
        croak("Clientname not defined!");
    }
    $self->{clientname} = $clientname;

    $self->{authtoken} = encode_base64($username, '') . ':' . encode_base64($password, '');

    if(!defined($iscaching)) {
        $iscaching = 0;
    }
    $self->{iscaching} = $iscaching;

    if($self->{iscaching}) {
        $self->{cache} = {};
    }

    $self->{needreconnect} = 1;
    $self->{inlines} = [];
    $self->{firstconnect} = 1;

    # Maximum number of seconds any synchronous request (retrieve, flush, keylist,
    # clientlist) will wait for a server response before giving up. Without this
    # cap a hung or silently-dropped server connection turned into an indefinite
    # client-side hang. Callers can override this after construction.
    $self->{requesttimeout} = 30;

    # Maximum time to spend trying to drain the outbuffer when the server isn't
    # reading (kernel send buffer full -> syswrite returns EAGAIN repeatedly).
    # Tracked in doNetwork() via writefailtime; on expiry the connection is
    # marked for reconnect. This is the symmetric counterpart of the server's
    # stalledwritetimeout and is what stops the many "send loop" sites that
    # otherwise spin forever when the server is alive but not consuming.
    $self->{stalledwritetimeout} = 30;

    # TCP connect timeout. Without this, a TCP connect to an unreachable host
    # waits for the kernel SYN-retransmit timeout (~75 s on Linux) before
    # giving up. Defaulted generously so a transiently-busy server (full
    # listen backlog, scheduler delays under load) or a slow link doesn't
    # produce false-positive failures. Unix-domain sockets are not affected —
    # connect there fails or succeeds immediately.
    $self->{connecttimeout} = 60;

    # TLS handshake timeout. Implemented via deferred handshake + IO::Select
    # polling so we don't depend on SIGALRM, which is unsafe in applications
    # that already use signals or have their own event loop. Defaulted
    # generously to tolerate slow servers (RSA signing on a small CPU is not
    # instant) and high-RTT links.
    $self->{ssltimeout} = 60;

    $self->{memcached_compatibility} = 0;

    $self->{remembrancenames} = [
        'Ivy Bdubs',
        'Terry Pratchett',
        'Sven Guckes',
        'Sheila', # faithful four-legged family member of @NightStorm_KPC
    ];
    $self->{remembranceinterval} = 3600; # One hour
    $self->{nextremembrance} = time + $self->{remembranceinterval};

    $self->reconnect();

    return;
}

sub _safeCloseSocket($self, $socket) {
    return if(!defined($socket));
    eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
        if(ref($socket) =~ /^IO::Socket::SSL/) {
            $socket->close(SSL_no_shutdown => 1, SSL_fast_shutdown => 1);
        } else {
            $socket->close;
        }
    };
    return;
}

# Perform a TLS handshake with our own deadline, without using SIGALRM.
# Strategy: put the socket into non-blocking mode up front, defer the handshake
# at start_SSL (SSL_startHandshake => 0), then drive connect_SSL() ourselves and
# poll with IO::Select::can_read / can_write between attempts. This is safe in
# applications that already use signals or have their own event loop.
#
# Returns the wrapped socket on success, or undef on timeout / handshake error.
# On failure, the caller is responsible for closing the original $socket.
sub _sslHandshakeWithTimeout($self, $socket, $timeout) {
    $socket->blocking(0);
    my $wrapped = IO::Socket::SSL->start_SSL($socket,
                                             SSL_verify_mode => SSL_VERIFY_NONE,
                                             SSL_startHandshake => 0,
                                            );
    if(!$wrapped) {
        return;
    }

    my $deadline = time + $timeout;
    my $select = IO::Select->new($wrapped);