Acme-Claude-Shell
view release on metacpan or search on metacpan
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
package Acme::Claude::Shell::Tools;
use 5.020;
use strict;
use warnings;
use Exporter 'import';
our @EXPORT_OK = qw(shell_tools);
use Claude::Agent qw(tool);
use Claude::Agent::CLI qw(menu status ask_yn prompt start_spinner stop_spinner);
use IO::Async::Process;
use Future;
use Cwd qw(abs_path getcwd);
use File::Spec;
use Term::ANSIColor qw(colored);
=head1 NAME
Acme::Claude::Shell::Tools - SDK MCP tool definitions for Acme::Claude::Shell
=head1 SYNOPSIS
use Acme::Claude::Shell::Tools qw(shell_tools);
my $tools = shell_tools($session);
=head1 DESCRIPTION
Defines the SDK MCP tools that Claude can use to interact with the shell.
Each tool returns a Future for async execution.
=head2 Tools
=over 4
=item * B<execute_command> - Run shell commands (with user confirmation)
Executes arbitrary shell commands. The user is prompted to approve, edit,
dry-run, or cancel each command before execution. Dangerous commands
(rm -rf, sudo, mkfs, etc.) trigger additional warnings.
=item * B<read_file> - Read file contents (safe, no confirmation)
Read file contents directly without shell commands. Supports C<lines>
parameter to read first N lines, and C<tail> parameter to read last N lines.
=item * B<list_directory> - List directory contents (safe, no confirmation)
List directory contents with optional glob C<pattern> filtering,
C<long_format> for detailed output, and C<show_hidden> for dotfiles.
=item * B<search_files> - Search for files by pattern (safe, no confirmation)
Search recursively by filename C<pattern> (glob) or file C<content> (grep).
Supports C<max_depth> limit. Results capped at 100 matches.
=item * B<get_system_info> - Get system information (safe, no confirmation)
Returns OS, disk, memory, and process information. Use C<info_type> to
filter: 'all', 'os', 'disk', 'memory', or 'processes'.
=item * B<get_working_directory> - Get current working directory (safe)
Returns the current working directory path.
=back
=head2 Command Approval
The C<execute_command> tool handles user approval directly (not via hooks)
to ensure synchronous confirmation before execution. Users can:
=over 4
=item * B<[a]> Approve and run the command
=item * B<[d]> Dry-run (preview only, don't execute)
=item * B<[e]> Edit the command before running
=item * B<[x]> Cancel
=back
=head2 Dangerous Command Detection
The following patterns trigger additional safety warnings:
=over 4
=item * C<rm -rf>, C<rm --recursive>, C<rm --force>
=item * C<sudo> commands
=item * C<mkfs>, C<dd of=>, device writes
=item * C<chmod 777>, C<chown -R>
=item * C<kill -9>, C<reboot>, C<shutdown>, C<halt>, C<poweroff>
=item * Fork bombs, remote script piping (curl/wget | sh)
=back
=cut
sub shell_tools {
my ($session) = @_;
return [
# execute_command tool - ALL shell operations go through this
# so the PreToolUse hook can confirm each command
tool(
'execute_command',
'Execute a shell command and return its output. Use this for ALL shell operations including listing files, reading files, etc. The user will be prompted to approve each command.',
{
type => 'object',
properties => {
command => {
type => 'string',
description => 'The shell command to execute (e.g., "ls -la", "cat file.txt", "find . -name *.pl")',
},
working_dir => {
type => 'string',
description => 'Directory to run command in (optional, defaults to current directory)',
},
},
required => ['command'],
},
sub {
my ($params, $loop) = @_;
return _execute_command($session, $params, $loop);
},
),
# get_working_directory tool - safe, no confirmation needed
tool(
'get_working_directory',
'Get the current working directory. This is safe and does not require user confirmation.',
{
type => 'object',
properties => {},
},
sub {
my ($params, $loop) = @_;
my $future = $loop->new_future;
$future->done(_mcp_result(getcwd()));
return $future;
},
),
# read_file tool - safe read operation, no confirmation needed
tool(
'read_file',
'Read the contents of a file. Safe operation - does not require user confirmation. Use this instead of execute_command for reading files.',
{
type => 'object',
properties => {
path => {
type => 'string',
description => 'Path to the file to read',
},
lines => {
type => 'integer',
description => 'Number of lines to read from the beginning (optional)',
},
tail => {
type => 'integer',
description => 'Number of lines to read from the end (optional)',
},
},
required => ['path'],
},
sub {
my ($params, $loop) = @_;
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
# search_files tool - safe search operation, no confirmation needed
tool(
'search_files',
'Search for files by name pattern or content. Safe operation - does not require user confirmation.',
{
type => 'object',
properties => {
pattern => {
type => 'string',
description => 'File name pattern to search for (e.g., "*.pm", "config*")',
},
content => {
type => 'string',
description => 'Text pattern to search for within files (grep)',
},
path => {
type => 'string',
description => 'Directory to search in (defaults to current directory)',
},
max_depth => {
type => 'integer',
description => 'Maximum directory depth to search',
},
},
},
sub {
my ($params, $loop) = @_;
return _search_files_safe($session, $params, $loop);
},
),
# get_system_info tool - safe system information, no confirmation needed
tool(
'get_system_info',
'Get system information including OS, disk space, and memory. Safe operation - does not require user confirmation.',
{
type => 'object',
properties => {
info_type => {
type => 'string',
description => 'Type of info: "all", "os", "disk", "memory", "processes" (defaults to "all")',
enum => ['all', 'os', 'disk', 'memory', 'processes'],
},
},
},
sub {
my ($params, $loop) = @_;
return _get_system_info($session, $params, $loop);
},
),
];
}
sub _execute_command {
my ($session, $params, $loop) = @_;
my $command = $params->{command};
my $dir = $params->{working_dir} // $session->working_dir;
my $colorful = $session->colorful;
# Stop spinner before prompting for approval
if ($session->can('_spinner') && $session->_spinner) {
stop_spinner($session->_spinner);
$session->_spinner(undef);
}
# Prompt for approval before executing
my ($approved, $new_command) = _confirm_command($session, $command);
unless ($approved) {
my $future = $loop->new_future;
$future->done(_mcp_result("User cancelled command", 1));
return $future;
}
# Use potentially edited command
$command = $new_command if defined $new_command;
# Start execution spinner
if ($colorful) {
$session->_spinner(start_spinner("Executing...", $loop));
}
# Record in history
push @{$session->_history}, {
time => _timestamp(),
command => $command,
status => 'running',
};
my $future = $loop->new_future;
my $stdout = '';
my $stderr = '';
my $process = IO::Async::Process->new(
command => [ '/bin/sh', '-c', $command ],
($dir && -d $dir ? (setup => [ chdir => $dir ]) : ()),
stdout => {
into => \$stdout,
},
stderr => {
into => \$stderr,
},
on_finish => sub {
my ($self, $exitcode) = @_;
my $exit_status = $exitcode >> 8;
if ($exit_status != 0) {
$session->_history->[-1]{status} = "exit $exit_status";
my $output = $stderr || $stdout || "Command failed with exit code $exit_status";
$future->done(_mcp_result($output));
} else {
$session->_history->[-1]{status} = 'success';
$future->done(_mcp_result($stdout // ''));
}
},
on_exception => sub {
my ($self, $exception, $errno, $exitcode) = @_;
$session->_history->[-1]{status} = 'error';
$future->done(_mcp_result("Error: $exception", 1));
},
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
}
# Confirm command with user before executing
# Returns ($approved, $new_command) - $new_command is set if user edited it
sub _confirm_command {
my ($session, $command) = @_;
my $colorful = $session->colorful;
# Check for dangerous patterns
my $danger = _check_dangerous($command);
print "\n";
if ($danger && $session->safe_mode) {
if ($colorful) {
status('warning', "Potentially dangerous command detected!");
print colored(['yellow'], " Reason: $danger->{reason}\n");
} else {
print "WARNING: Potentially dangerous command!\n";
print " Reason: $danger->{reason}\n";
}
print "\n";
}
# Show the command
if ($colorful) {
status('info', "Command: $command");
} else {
print "Command: $command\n";
}
# Show action menu
my $choice = menu("Action", [
{ key => 'a', label => 'Approve and run' },
{ key => 'd', label => 'Dry-run (preview only)' },
{ key => 'e', label => 'Edit command' },
{ key => 'x', label => 'Cancel' },
]) // 'x';
if ($choice eq 'x') {
if ($colorful) {
status('warning', "Command cancelled");
} else {
print "Cancelled.\n";
}
return (0, undef);
}
elsif ($choice eq 'd') {
if ($colorful) {
status('info', "[DRY-RUN] Would execute:");
print colored(['cyan'], " $command\n\n");
} else {
print "[DRY-RUN] Would execute: $command\n";
}
return (0, undef);
}
elsif ($choice eq 'e') {
my $new_cmd;
if ($colorful) {
$new_cmd = prompt("Edit command:", $command);
} else {
print "Edit command [$command]: ";
$new_cmd = <STDIN>;
chomp $new_cmd if defined $new_cmd;
$new_cmd = $command unless length($new_cmd // '');
}
if ($colorful) {
status('info', "Modified command:");
print colored(['bold', 'white'], " $new_cmd\n\n");
} else {
print "Modified: $new_cmd\n";
}
# For dangerous commands after editing, still require confirmation
if (_check_dangerous($new_cmd) && $session->safe_mode) {
my $confirmed;
if ($colorful) {
$confirmed = ask_yn("Are you SURE you want to run this command?", 'n');
} else {
print "Are you SURE? (y/N): ";
my $ans = <STDIN>;
chomp $ans if defined $ans;
$confirmed = ($ans // '') =~ /^y/i;
}
return (0, undef) unless $confirmed;
}
return (1, $new_cmd);
}
# 'a' - Approve
# For dangerous commands, require extra confirmation
if ($danger && $session->safe_mode) {
my $confirmed;
if ($colorful) {
$confirmed = ask_yn("Are you SURE you want to run this dangerous command?", 'n');
} else {
print "Are you SURE? (y/N): ";
my $ans = <STDIN>;
chomp $ans if defined $ans;
$confirmed = ($ans // '') =~ /^y/i;
}
unless ($confirmed) {
if ($colorful) {
status('warning', "Command cancelled");
} else {
print "Cancelled.\n";
}
return (0, undef);
}
}
return (1, undef);
}
sub _list_files {
my ($session, $params, $loop) = @_;
( run in 1.252 second using v1.01-cache-2.11-cpan-6aa56a78535 )