view release on metacpan or  search on metacpan

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

        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;