view release on metacpan or  search on metacpan

lib/Claude/Agent/MCP/SDKRunner.pm  view on Meta::CPAN

# Single state object - reset atomically at start of run()
my $state = Claude::Agent::MCP::SDKRunner::State->new;

# Accessors for backward compatibility with existing code
sub _socket        { return $state->{socket}; }
sub _socket_stream { return $state->{socket_stream}; }
sub _request_id    { return $state->{request_id}; }
sub _jsonl         { return $state->{jsonl}; }
sub _loop          { return $state->{loop}; }
sub _response_buffer { return $state->{response_buffer}; }
sub _got_response  { return $state->{got_response}; }

sub run {
    # Reset all state atomically - no gap between declaration and initialization
    $state->reset_state();

    binmode(STDIN,  ':raw');
    binmode(STDOUT, ':raw');
    binmode(STDERR, ':encoding(UTF-8)');

    # Parse arguments
    my ($socket_path, $server_name, $version, $tools_json) = @ARGV;

    unless ($socket_path && $server_name && $tools_json) {
        die "Usage: SDKRunner <socket_path> <server_name> <version> <tools_json>\n";
    }

    # Validate socket path - must be absolute and within a known temp directory
    # This prevents attackers from pointing to attacker-controlled sockets outside
    # the expected secure locations.
    die "Invalid socket path: must be absolute\n" unless $socket_path =~ m{^/};

    # Validate socket is in a known temporary directory pattern
    # Security: Accept common temp directory patterns and user home directories
    # where File::Temp would create sockets
    my $valid_socket_path = 0;
    my @allowed_prefixes = (
        '/tmp/',
        '/var/tmp/',
        '/private/tmp/',          # macOS
        '/var/folders/',          # macOS sandbox temp
        '/run/user/',             # systemd user runtime
    );
    # Also allow user home directory temp locations
    if ($ENV{HOME} && $ENV{HOME} =~ m{^/}) {
        push @allowed_prefixes, "$ENV{HOME}/tmp/";
        push @allowed_prefixes, "$ENV{HOME}/.tmp/";
    }
    # Allow TMPDIR if set (File::Temp respects this)
    # *** SECURITY WARNING ***
    # TMPDIR is user-controllable and NOT validated for trust.
    # KNOWN RISK: An attacker who can set TMPDIR before process startup
    # could influence which socket paths are allowed, potentially enabling
    # connections to attacker-controlled sockets.
    #
    # FOR HIGH-SECURITY DEPLOYMENTS: Set CLAUDE_AGENT_IGNORE_TMPDIR=1
    #
    # Additional mitigations:
    #   1. Set CLAUDE_AGENT_IGNORE_TMPDIR=1 to ignore TMPDIR entirely (RECOMMENDED)
    #   2. Validate socket ownership with stat() before connecting
    #   3. Use only fixed prefixes by not setting TMPDIR
    #   4. Run in a restricted environment where TMPDIR cannot be manipulated
    #   5. Set TMPDIR to a trusted directory (e.g., /tmp) before process startup
    # Only allow TMPDIR when explicitly enabled via CLAUDE_AGENT_ALLOW_TMPDIR=1
    # This is opt-in for stricter security - TMPDIR could be attacker-controlled
    # SECURITY WARNING: NEVER set CLAUDE_AGENT_ALLOW_TMPDIR=1 in untrusted environments
    # or when an attacker could control environment variables before process startup.
    # An attacker could set both CLAUDE_AGENT_ALLOW_TMPDIR=1 and a malicious TMPDIR
    # to redirect socket connections to attacker-controlled locations.
    if ($ENV{TMPDIR} && $ENV{TMPDIR} =~ m{^/} && $ENV{CLAUDE_AGENT_ALLOW_TMPDIR}) {
        # SECURITY: Log warning when TMPDIR override is used
        warn "[SECURITY WARNING] TMPDIR-based socket path allowed via CLAUDE_AGENT_ALLOW_TMPDIR. "
            . "This is insecure if an attacker can control environment variables.\n"
            unless $ENV{CLAUDE_AGENT_QUIET_SECURITY_WARNINGS};
        push @allowed_prefixes, $ENV{TMPDIR};
        push @allowed_prefixes, "$ENV{TMPDIR}/" unless $ENV{TMPDIR} =~ m{/$};
    }

    require Cwd;
    my $resolved_path = Cwd::abs_path($socket_path);
    die "Invalid socket path: cannot resolve\n" unless defined $resolved_path;
    for my $prefix (@allowed_prefixes) {
        my $resolved_prefix = Cwd::abs_path($prefix);
        next unless defined $resolved_prefix;
        if (index($resolved_path, $resolved_prefix) == 0) {
            $valid_socket_path = 1;
            last;
        }
    }
    die "Invalid socket path: must be within a temporary directory (/tmp, /var/tmp, TMPDIR, etc.)\n"
        unless $valid_socket_path;

    # Validate server_name - alphanumeric with hyphens/underscores only
    die "Invalid server name: must be alphanumeric with hyphens/underscores\n"
        unless $server_name =~ /^[a-zA-Z0-9_-]{1,100}$/;

    # Validate version if provided - semver-like format
    die "Invalid version format\n"
        if defined($version) && length($version) && $version !~ /^[a-zA-Z0-9._-]{1,50}$/;

    # Limit tools_json size to prevent memory exhaustion (1MB limit)
    die "tools_json too large (max 1MB)\n" if length($tools_json) > 1_000_000;

    my ($tools) = $state->{jsonl}->decode($tools_json);

    # Validate decoded structure: must be an array of tool definitions
    die "Invalid tools_json: expected array\n" unless ref $tools eq 'ARRAY';
    for my $tool (@$tools) {
        die "Invalid tool definition: expected hash with 'name' key\n"
            unless ref $tool eq 'HASH' && defined $tool->{name};
    }

    # Build tool lookup
    my %tool_by_name = map { $_->{name} => $_ } @$tools;

    # Validate socket ownership before connecting (defense-in-depth)
    # This helps detect if an attacker has replaced the socket with one they control
    {
        my @stat_info = stat($socket_path);
        if (@stat_info) {
            my $socket_uid = $stat_info[4];
            if ($socket_uid != $<) {
                die "Security error: socket '$socket_path' is owned by uid $socket_uid, expected uid $< (current user)\n";
            }
        }
        # If stat fails, the socket may not exist yet - let the connect() call handle it
    }

    # Connect to parent socket
    $state->{socket} = IO::Socket::UNIX->new(
        Type => SOCK_STREAM,
        Peer => $socket_path,
    ) or die "Cannot connect to socket $socket_path: $!\n";

    $state->{socket}->autoflush(1);

    $log->debug(sprintf("SDKRunner: Initializing with socket: %s", $socket_path));
    $log->debug("SDKRunner: Connected to parent socket");

    # Create IO::Async event loop
    $state->{loop} = IO::Async::Loop->new;

    # Track running state
    my $running = 1;

    # Shutdown helper
    my $shutdown = sub {
        return unless $running;
        $running = 0;
        $state->{loop}->stop;
    };

    # Handle signals for graceful shutdown
    local $SIG{TERM} = $shutdown;
    local $SIG{PIPE} = $shutdown;

    # Create async stream for STDIN (from Claude CLI)
    my $stdin_stream = IO::Async::Stream->new(
        read_handle => \*STDIN,
        on_read => sub {
            my ($stream, $buffref) = @_;

            while ($$buffref =~ s/^([^\n]+)\n//) {
                my $line = $1;
                next unless length $line;

                $log->trace(sprintf("SDKRunner: Received: %s", $line));

                my @requests;
                my $parse_error;
                try {
                    @requests = $state->{jsonl}->decode($line);
                } catch {
                    $parse_error = $_;
                };
                if ($parse_error) {
                    $log->warning(sprintf("SDKRunner: Failed to parse JSON: %s", $parse_error));
                    next;
                }