File Coverage

blib/lib/Hypersonic/Socket.pm

Criterion	Covered	Total	%
statement	41	49	83.6
branch	5	18	27.7
condition	1	2	50.0
subroutine	10	11	90.9
pod	2	4	50.0
total	59	84	70.2

package Hypersonic::Socket;

use strict;
use warnings;
use 5.010;

our $VERSION = '0.17';

use XS::JIT;
use XS::JIT::Builder;
use Hypersonic::JIT::Util;

# Platform detection
sub platform {
    return 'darwin'   if $^O eq 'darwin';
    return 'linux'    if $^O eq 'linux';
    return 'freebsd'  if $^O eq 'freebsd';
    return 'openbsd'  if $^O eq 'openbsd';
    return 'netbsd'   if $^O eq 'netbsd';
    return 'mswin32'  if $^O eq 'MSWin32';
    return 'cygwin'   if $^O eq 'cygwin';
    die "Unsupported platform: $^O";
}

# Event backend detection (delegates to Hypersonic::Event)
sub event_backend {
    require Hypersonic::Event;
    return Hypersonic::Event->best_backend();
}

my $COMPILED = 0;
my $MODULE_ID = 0;

# Unified compile interface
sub compile {
    my ($class, %opts) = @_;
    return $class->compile_socket_ops(%opts);
}

# Generate and compile JIT socket functions using Builder
sub compile_socket_ops {
    my ($class, %opts) = @_;

    return 1 if $COMPILED;

    my $cache_dir = $opts{cache_dir} // '_hypersonic_cache/socket';
    my $module_name = 'Hypersonic::Socket::Ops_' . $MODULE_ID++;

    my $builder = XS::JIT::Builder->new;

    # Common includes via centralized utility
    Hypersonic::JIT::Util->add_standard_includes($builder,
        qw(stdio unistd fcntl socket));

    $builder->line('#define RECV_BUF_SIZE 65536')
      ->blank
      ->line('static char recv_buf[RECV_BUF_SIZE];')
      ->blank;

    # Windows: WSAStartup must run before any socket call. We don't
    # have a BOOT hook in the JIT module, so guard with a static flag
    # and call it from create_listen_socket (the first entrypoint
    # users hit). socket() requires Winsock to be initialized; otherwise
    # it returns INVALID_SOCKET with WSANOTINITIALISED.
    $builder->raw(<<'C');
#ifdef _WIN32
static int hs_wsa_initialized = 0;
static void hs_wsa_init(void) {
    if (!hs_wsa_initialized) {
        WSADATA wsa;
        if (WSAStartup(MAKEWORD(2, 2), &wsa) != 0) {
            return;  /* leave flag unset; create_listen_socket will croak */
        }
        hs_wsa_initialized = 1;
    }
}
#else
static inline void hs_wsa_init(void) {}
#endif
C

    # Generate create_listen_socket
    $builder->xs_function('jit_create_listen_socket')
      ->xs_preamble
      ->line('IV port;')
      ->line('int fd;')
      ->line('int opt;')
      ->line('struct sockaddr_in addr;')
      ->blank
      ->line('if (items != 1) croak("Usage: create_listen_socket(port)");')
      ->line('port = SvIV(ST(0));')
      ->blank
      ->line('hs_wsa_init();  /* no-op on POSIX */')
      ->line('fd = socket(AF_INET, SOCK_STREAM, 0);')
      ->if('fd < 0')
        # Surface the actual errno - returning silent -1 hides why the
        # child server died on platforms where bind/listen/socket fail
        # for non-obvious reasons (see OpenBSD smoke reports).
        ->line('croak("socket() failed: %s", strerror(errno));')
      ->endif
      ->blank
      ->line('opt = 1;')
      ->line('setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, (const char*)&opt, sizeof(opt));')
      ->line('#ifdef SO_REUSEPORT')
      ->line('setsockopt(fd, SOL_SOCKET, SO_REUSEPORT, (const char*)&opt, sizeof(opt));')
      ->line('#endif')
      ->blank
      ->line('hs_set_nonblocking(fd);')
      ->blank
      ->line('memset(&addr, 0, sizeof(addr));')
      ->line('addr.sin_family = AF_INET;')
      ->line('addr.sin_port = htons((uint16_t)port);')
      ->line('addr.sin_addr.s_addr = INADDR_ANY;')
      ->blank
      ->if('bind(fd, (struct sockaddr*)&addr, sizeof(addr)) < 0')
        ->line('int saved_errno = errno;')
        ->line('close(fd);')
        ->line('croak("bind(port=%d) failed: %s", (int)port, strerror(saved_errno));')
      ->endif
      ->blank
      ->if('listen(fd, SOMAXCONN) < 0')
        ->line('int saved_errno = errno;')
        ->line('close(fd);')
        ->line('croak("listen() failed: %s", strerror(saved_errno));')
      ->endif
      ->blank
      ->line('ST(0) = sv_2mortal(newSViv(fd));')
      ->xs_return('1')
      ->xs_end;

    # Event loop functions (create_event_loop, event_add, event_del, ev_poll)
    # have been moved to Hypersonic::Event::* backend modules

    # Generate http_accept
    $builder->xs_function('jit_http_accept')
      ->xs_preamble
      ->line('if (items != 1) croak("Usage: http_accept(listen_fd)");')
      ->line('IV listen_fd = SvIV(ST(0));')
      ->blank
      ->line('struct sockaddr_in client_addr;')
      ->line('socklen_t client_len = sizeof(client_addr);')
      ->blank
      ->line('int client_fd = accept((int)listen_fd, (struct sockaddr*)&client_addr, &client_len);')
      ->blank
      ->if('client_fd < 0')
        ->line('ST(0) = sv_2mortal(newSViv(-1));')
        ->line('XSRETURN(1);')
      ->endif
      ->blank
      ->comment('Portable non-blocking: hs_set_nonblocking expands to')
      ->comment('ioctlsocket(FIONBIO) on Win32 and fcntl(F_SETFL|O_NONBLOCK)')
      ->comment('on POSIX. Defined by Hypersonic::JIT::Util::add_standard_includes.')
      ->line('hs_set_nonblocking(client_fd);')
      ->blank
      ->line('ST(0) = sv_2mortal(newSViv(client_fd));')
      ->xs_return('1')
      ->xs_end;

    # Generate http_recv - zero-copy HTTP parsing
    $builder->xs_function('jit_http_recv')
      ->xs_preamble
      ->line('if (items != 1) croak("Usage: http_recv(fd)");')
      ->line('IV fd = SvIV(ST(0));')
      ->blank
      ->line('ssize_t len = recv((int)fd, recv_buf, RECV_BUF_SIZE - 1, 0);')
      ->blank
      ->if('len <= 0')
        ->line('ST(0) = &PL_sv_undef;')
        ->line('XSRETURN(1);')
      ->endif
      ->blank
      ->line('recv_buf[len] = \'\\0\';')
      ->blank
      ->comment('Quick parse - extract method, path, detect keep-alive')
      ->line('const char* p = recv_buf;')
      ->line('const char* end = recv_buf + len;')
      ->blank
      ->comment('Method')
      ->line('const char* method = p;')
      ->line('while (p < end && *p != \' \') p++;')
      ->line('int method_len = p - method;')
      ->if('p >= end')
        ->line('ST(0) = &PL_sv_undef;')
        ->line('XSRETURN(1);')
      ->endif
      ->line('p++;')
      ->blank
      ->comment('Path')
      ->line('const char* path = p;')
      ->line('while (p < end && *p != \' \' && *p != \'?\') p++;')
      ->line('int path_len = p - path;')
      ->if('p >= end')
        ->line('ST(0) = &PL_sv_undef;')
        ->line('XSRETURN(1);')
      ->endif
      ->blank
      ->comment('Skip to end of request line')
      ->line('while (p < end && *p != \'\\n\') p++;')
      ->if('p >= end')
        ->line('ST(0) = &PL_sv_undef;')
        ->line('XSRETURN(1);')
      ->endif
      ->line('p++;')
      ->blank
      ->comment('Check for Connection: close')
      ->line('int keep_alive = 1;')
      ->line('while (p < end) {')
      ->line('    if (*p == \'\\r\' || *p == \'\\n\') break;')
      ->line('    if (end - p > 17 && strncasecmp(p, "Connection: close", 17) == 0) {')
      ->line('        keep_alive = 0;')
      ->line('    }')
      ->line('    while (p < end && *p != \'\\n\') p++;')
      ->line('    if (p < end) p++;')
      ->line('}')
      ->blank
      ->comment('Skip blank line')
      ->line('if (p < end && *p == \'\\r\') p++;')
      ->line('if (p < end && *p == \'\\n\') p++;')
      ->blank
      ->comment('Body')
      ->line('const char* body = p;')
      ->line('int body_len = end - p;')
      ->blank
      ->comment('Build request array: [method, path, body, keep_alive, fd]')
      ->line('AV* req = newAV();')
      ->line('av_push(req, newSVpvn(method, method_len));')
      ->line('av_push(req, newSVpvn(path, path_len));')
      ->line('av_push(req, newSVpvn(body, body_len));')
      ->line('av_push(req, newSViv(keep_alive));')
      ->line('av_push(req, newSViv(fd));')
      ->blank
      ->line('ST(0) = sv_2mortal(newRV_noinc((SV*)req));')
      ->xs_return('1')
      ->xs_end;

    # Generate http_send - writev for zero-copy
    $builder->xs_function('jit_http_send')
      ->xs_preamble
      ->line('if (items < 2 || items > 3) croak("Usage: http_send(fd, body, [content_type])");')
      ->line('IV fd = SvIV(ST(0));')
      ->blank
      ->line('STRLEN body_len;')
      ->line('const char* body = SvPV(ST(1), body_len);')
      ->blank
      ->line('const char* content_type = "text/plain";')
      ->if('items == 3 && SvOK(ST(2))')
        ->line('STRLEN ct_len;')
        ->line('content_type = SvPV(ST(2), ct_len);')
      ->endif
      ->blank
      ->line('static __thread char header[512];')
      ->line('int hdr_len = snprintf(header, sizeof(header),')
      ->line('    "HTTP/1.1 200 OK\\r\\n"')
      ->line('    "Content-Type: %s\\r\\n"')
      ->line('    "Content-Length: %zu\\r\\n"')
      ->line('    "Connection: keep-alive\\r\\n\\r\\n",')
      ->line('    content_type, body_len);')
      ->blank
      # writev() / struct iovec are POSIX-only (sys/uio.h). On Windows
      # we'd have to use WSASend with WSABUF[]; for simplicity (and
      # because Win32 perl smokers run mostly correctness, not perf,
      # tests) just emit two send() calls. Header is always <512 bytes
      # so the kernel-buffer copy is negligible.
      ->raw(<<'C')
#ifdef _WIN32
    ssize_t sent = send((int)fd, header, (size_t)hdr_len, 0);
    if (sent > 0 && body_len > 0) {
        ssize_t sent2 = send((int)fd, body, (size_t)body_len, 0);
        if (sent2 > 0) sent += sent2;
    }
#else
    struct iovec iov[2];
    iov[0].iov_base = header;
    iov[0].iov_len  = (size_t)hdr_len;
    iov[1].iov_base = (void*)body;
    iov[1].iov_len  = body_len;
    ssize_t sent = writev((int)fd, iov, 2);
#endif
C
      ->line('ST(0) = sv_2mortal(newSViv((IV)sent));')
      ->xs_return('1')
      ->xs_end;

    # Generate http_send_404
    $builder->xs_function('jit_http_send_404')
      ->xs_preamble
      ->line('if (items != 1) croak("Usage: http_send_404(fd)");')
      ->line('IV fd = SvIV(ST(0));')
      ->blank
      ->line('static const char resp[] =')
      ->line('    "HTTP/1.1 404 Not Found\\r\\n"')
      ->line('    "Content-Type: text/plain\\r\\n"')
      ->line('    "Content-Length: 9\\r\\n"')
      ->line('    "Connection: close\\r\\n\\r\\n"')
      ->line('    "Not Found";')
      ->blank
      ->line('ssize_t sent = send((int)fd, resp, sizeof(resp) - 1, 0);')
      ->line('ST(0) = sv_2mortal(newSViv((IV)sent));')
      ->xs_return('1')
      ->xs_end;

    # Generate close_fd
    $builder->xs_function('jit_close_fd')
      ->xs_preamble
      ->line('if (items != 1) croak("Usage: close_fd(fd)");')
      ->line('IV fd = SvIV(ST(0));')
      ->line('int result = close((int)fd);')
      ->line('ST(0) = sv_2mortal(newSViv(result));')
      ->xs_return('1')
      ->xs_end;

    # Compile via XS::JIT (socket-only functions - event loop is in backends)
    XS::JIT->compile(
        code      => $builder->code,
        name      => $module_name,
        cache_dir => $cache_dir,
        # Windows needs to link against Winsock for the JIT-compiled .so
        # to resolve socket()/recv()/send()/etc.
        ($^O eq 'MSWin32' ? (extra_ldflags => '-lws2_32') : ()),
        functions => {
            'Hypersonic::Socket::create_listen_socket' => { source => 'jit_create_listen_socket', is_xs_native => 1 },
            'Hypersonic::Socket::http_accept'          => { source => 'jit_http_accept', is_xs_native => 1 },
            'Hypersonic::Socket::http_recv'            => { source => 'jit_http_recv', is_xs_native => 1 },
            'Hypersonic::Socket::http_send'            => { source => 'jit_http_send', is_xs_native => 1 },
            'Hypersonic::Socket::http_send_404'        => { source => 'jit_http_send_404', is_xs_native => 1 },
            'Hypersonic::Socket::close_fd'             => { source => 'jit_close_fd', is_xs_native => 1 },
        },
    );

    $COMPILED = 1;
    return 1;
}

# Auto-compile on import
sub import {
    my $class = shift;
    my %opts = @_;
    $class->compile_socket_ops(%opts);
}

1;

__END__