Acme-Claude-Shell
view release on metacpan or search on metacpan
lib/Acme/Claude/Shell/Query.pm view on Meta::CPAN
$response_text .= $msg->text // '';
}
elsif ($msg->isa('Claude::Agent::Message::ToolUse')) {
# Spinner already stopped by hook before STDIN read
}
elsif ($msg->isa('Claude::Agent::Message::ToolResult')) {
# Show result
my $content = $msg->content // '';
if ($msg->is_error) {
# Check if this was a user denial (dry-run, cancel, etc.)
# In that case, don't show error and stop processing
if ($content =~ /^(Dry-run:|User cancelled)/) {
last; # Stop the conversation here
}
status('error', $content) if $self->colorful;
} else {
print $content, "\n" if $content;
}
# Don't restart spinner - avoids conflicts with Term::ProgressSpinner
# when STDIN was used for hook confirmation
}
lib/Acme/Claude/Shell/Query.pm view on Meta::CPAN
2. Use the execute_command tool to run them
3. Summarize the results
PERL FALLBACK: When a task cannot be done with standard shell commands,
or when a shell command isn't available on the system, use Perl one-liners instead.
Perl is always available. Examples:
- Instead of: jq '.key' file.json
Use: perl -MJSON -0777 -ne 'print decode_json($_)->{key}' file.json
- Instead of: sed -i 's/old/new/g' file
Use: perl -pi -e 's/old/new/g' file
- For complex text processing, JSON/YAML parsing, or when shell tools are missing,
prefer Perl one-liners as they are portable and powerful.
Be helpful but safe - warn about destructive operations.
Always explain what you're about to do before using tools.
PROMPT
}
=head1 AUTHOR
LNATION, C<< <email at lnation.org> >>
lib/Acme/Claude/Shell/Session.pm view on Meta::CPAN
$input =~ s/^\s+|\s+$//g;
next unless length $input;
# Built-in commands
last if $input =~ /^(exit|quit)$/i;
if ($input =~ /^history$/i) {
my $selected = $self->_show_history;
if (defined $selected && length $selected) {
# User selected a command to re-run - process it
$term->addhistory($selected);
_append_to_history($selected);
await $self->_process_input($selected);
}
next;
}
if ($input =~ /^clear$/i) {
system('clear');
next;
}
if ($input =~ /^help$/i) {
$self->_show_help;
next;
}
# Add to readline history and persist to file
$term->addhistory($input);
_append_to_history($input);
# Process with Claude
await $self->_process_input($input);
}
status('info', "Goodbye!") if $self->colorful;
return 1;
}
async sub _process_input {
my ($self, $input) = @_;
# Query cursor position via /dev/tty before starting spinner
# This avoids Term::ProgressSpinner's STDIN query which fails after Term::ReadLine
my $cursor_row = _get_cursor_row();
# Store spinner in session so hooks can stop it before reading STDIN
# Pick a random fun spinner each time
$self->_spinner(start_spinner("Thinking...", $self->loop,
_random_spinner(),
lib/Acme/Claude/Shell/Session.pm view on Meta::CPAN
elsif ($msg->isa('Claude::Agent::Message::ToolUse')) {
# Print newline after reasoning text before tool approval menu
print "\n" if $printed_response;
$printed_response = 0; # Reset for next assistant message
}
elsif ($msg->isa('Claude::Agent::Message::ToolResult')) {
# Show result
my $content = $msg->content // '';
if ($msg->is_error) {
# Check if this was a user denial (dry-run, cancel, etc.)
# In that case, don't show error and stop processing
if ($content =~ /^(Dry-run:|User cancelled)/) {
last; # Stop the conversation here
}
status('error', $content) if $self->colorful;
} else {
print $content, "\n" if $content;
}
# Don't restart spinner - avoids conflicts with Term::ProgressSpinner
# when STDIN was used for hook confirmation
}
lib/Acme/Claude/Shell/Session.pm view on Meta::CPAN
If the user says "now do X to those files", use the results from the
previous command to know which files they mean.
PERL FALLBACK: When a task cannot be done with standard shell commands,
or when a shell command isn't available on the system, use Perl one-liners instead.
Perl is always available. Examples:
- Instead of: jq '.key' file.json
Use: perl -MJSON -0777 -ne 'print decode_json($_)->{key}' file.json
- Instead of: sed -i 's/old/new/g' file
Use: perl -pi -e 's/old/new/g' file
- For complex text processing, JSON/YAML parsing, or when shell tools are missing,
prefer Perl one-liners as they are portable and powerful.
Be helpful but safe:
- Warn about destructive operations (rm, dd, etc.)
- Prefer safe alternatives when possible
- Explain what each command does
Always explain what you're about to do before using tools.
PROMPT
}
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
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)
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
# 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);
},
),
];
}
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
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) = @_;
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
$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));
},
);
$loop->add($process);
return $future;
}
# Helper to format tool results in MCP format
sub _mcp_result {
my ($text, $is_error) = @_;
return {
content => [{ type => 'text', text => $text }],
is_error => $is_error ? 1 : 0,
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
reason => 'Filesystem formatting' },
{ pattern => qr/\bdd\b.*\bof=/,
reason => 'Direct disk write' },
{ pattern => qr/>\s*\/dev\//,
reason => 'Writing to device file' },
{ pattern => qr/\bchmod\s+(-R\s+)?777\b/,
reason => 'World-writable permissions' },
{ pattern => qr/\bchown\s+-R\b.*\//,
reason => 'Recursive ownership change' },
{ pattern => qr/\bkill\s+-9\b/,
reason => 'Forceful process termination' },
{ pattern => qr/\b(reboot|shutdown|halt|poweroff)\b/,
reason => 'System shutdown/reboot' },
{ pattern => qr/\bformat\b/,
reason => 'Disk formatting' },
{ pattern => qr/:\s*\(\s*\)\s*\{\s*:\s*\|\s*:\s*&\s*\}\s*;/,
reason => 'Fork bomb detected' },
{ pattern => qr/\bwget\b.*\|\s*(ba)?sh/i,
reason => 'Piping remote script to shell' },
{ pattern => qr/\bcurl\b.*\|\s*(ba)?sh/i,
reason => 'Piping remote script to shell' },
lib/Acme/Claude/Shell/Tools.pm view on Meta::CPAN
if (open my $fh, '<', '/proc/meminfo') {
while (<$fh>) {
push @info, $_ if /^(MemTotal|MemFree|MemAvailable|Buffers|Cached):/;
}
close $fh;
}
}
push @info, "";
}
if ($info_type eq 'all' || $info_type eq 'processes') {
push @info, "=== Current Process ===";
push @info, "PID: $$";
push @info, "User: " . (getpwuid($<) // $<);
push @info, "";
}
$future->done(_mcp_result(join("\n", @info)));
return $future;
}
t/03-dangerous-patterns.t view on Meta::CPAN
reason => 'Filesystem formatting' },
{ pattern => qr/\bdd\b.*\bof=/,
reason => 'Direct disk write' },
{ pattern => qr/>\s*\/dev\//,
reason => 'Writing to device file' },
{ pattern => qr/\bchmod\s+(-R\s+)?777\b/,
reason => 'World-writable permissions' },
{ pattern => qr/\bchown\s+-R\b.*\//,
reason => 'Recursive ownership change' },
{ pattern => qr/\bkill\s+-9\b/,
reason => 'Forceful process termination' },
{ pattern => qr/\b(reboot|shutdown|halt|poweroff)\b/,
reason => 'System shutdown/reboot' },
{ pattern => qr/\bformat\b/,
reason => 'Disk formatting' },
{ pattern => qr/:\s*\(\s*\)\s*\{\s*:\s*\|\s*:\s*&\s*\}\s*;/,
reason => 'Fork bomb detected' },
{ pattern => qr/\bwget\b.*\|\s*(ba)?sh/i,
reason => 'Piping remote script to shell' },
{ pattern => qr/\bcurl\b.*\|\s*(ba)?sh/i,
reason => 'Piping remote script to shell' },
t/03-dangerous-patterns.t view on Meta::CPAN
subtest 'Ownership changes' => sub {
ok(check_dangerous('chown -R root /'), 'chown -R detected');
ok(check_dangerous('chown -R user:user /home/user'), 'chown -R home detected');
ok(!check_dangerous('chown user file.txt'), 'chown single file may be ok');
};
subtest 'Process killing' => sub {
ok(check_dangerous('kill -9 1234'), 'kill -9 detected');
ok(!check_dangerous('kill 1234'), 'kill without -9 may be ok');
ok(!check_dangerous('killall process'), 'killall may be ok');
};
subtest 'System commands' => sub {
ok(check_dangerous('reboot'), 'reboot detected');
ok(check_dangerous('shutdown now'), 'shutdown detected');
ok(check_dangerous('halt'), 'halt detected');
ok(check_dangerous('poweroff'), 'poweroff detected');
};
subtest 'Fork bomb' => sub {
( run in 0.947 second using v1.01-cache-2.11-cpan-140bd7fdf52 )