initial watcher version from Vlad
This commit is contained in:
Petr Nyc
385
bin/watcher.pl
Executable file
385
bin/watcher.pl
Executable file
@@ -0,0 +1,385 @@
|
||||
#!/usr/bin/env perl
|
||||
#
|
||||
# AI handout:
|
||||
# - Run this controller, then enter one watched tmux target per line.
|
||||
# - Get the correct target from the tmux pane with tmux command mode:
|
||||
# :display-message -p '#{socket_path} #{pane_id}'
|
||||
# - Target input format is:
|
||||
# /tmp/tmux-.../socket %pane
|
||||
# - The watcher confirms Codex prompts that contain:
|
||||
# Would you like to run the following command?
|
||||
# or:
|
||||
# Would you like to make the following edits?
|
||||
# plus:
|
||||
# 1. Yes, proceed (y)
|
||||
# - The watcher sends only Enter. It does not send "y".
|
||||
# - Ctrl-C in controller mode closes watcher pipes started by that controller.
|
||||
# - Logging goes to stderr by default. Set WATCHER_LOG=/path to also append a
|
||||
# log file.
|
||||
use strict;
|
||||
use warnings;
|
||||
use Fcntl qw(O_RDWR O_NONBLOCK);
|
||||
use IO::Select;
|
||||
use POSIX qw(strftime mkfifo);
|
||||
|
||||
my $SCRIPT = '/home/vmarek/watcher.pl';
|
||||
my $LINES = 20;
|
||||
my $COOLDOWN = $ENV{WATCHER_COOLDOWN} || 60;
|
||||
my $LOG_FILE = $ENV{WATCHER_LOG} || '';
|
||||
my @PROMPTS = (
|
||||
'Would you like to run the following command?',
|
||||
'Would you like to make the following edits?',
|
||||
);
|
||||
my $YES = '1. Yes, proceed (y)';
|
||||
|
||||
if (@ARGV && $ARGV[0] eq '--watcher') {
|
||||
shift @ARGV;
|
||||
watcher(@ARGV);
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if (@ARGV && ($ARGV[0] eq '-h' || $ARGV[0] eq '--help')) {
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
controller();
|
||||
exit 0;
|
||||
|
||||
sub controller {
|
||||
my %active;
|
||||
my $stopping = 0;
|
||||
my $event_path = "/tmp/watcher-events-$$";
|
||||
my $select = IO::Select->new();
|
||||
$select->add(\*STDIN);
|
||||
|
||||
mkfifo($event_path, 0600) or die "mkfifo $event_path failed: $!\n";
|
||||
sysopen(my $event_fh, $event_path, O_RDWR | O_NONBLOCK)
|
||||
or die "open $event_path failed: $!\n";
|
||||
$select->add($event_fh);
|
||||
|
||||
local $SIG{INT} = sub { $stopping = 'INT' };
|
||||
local $SIG{TERM} = sub { $stopping = 'TERM' };
|
||||
|
||||
print_help();
|
||||
log_msg("ready; enter targets as: /tmp/tmux-.../socket %pane");
|
||||
|
||||
while (1) {
|
||||
if ($stopping) {
|
||||
stop_active_pipes(\%active, "caught SIG$stopping");
|
||||
unlink $event_path;
|
||||
return;
|
||||
}
|
||||
|
||||
for my $fh ($select->can_read(1)) {
|
||||
if ($stopping) {
|
||||
stop_active_pipes(\%active, "caught SIG$stopping");
|
||||
unlink $event_path;
|
||||
return;
|
||||
}
|
||||
|
||||
if ($fh == $event_fh) {
|
||||
my $event = <$event_fh>;
|
||||
next if !defined $event;
|
||||
chomp $event;
|
||||
handle_event(\%active, $event);
|
||||
next;
|
||||
}
|
||||
|
||||
my $line = <$fh>;
|
||||
if (!defined $line) {
|
||||
log_msg("stdin closed; leaving existing tmux pipes running");
|
||||
unlink $event_path;
|
||||
return;
|
||||
}
|
||||
|
||||
chomp $line;
|
||||
$line =~ s/^\s+//;
|
||||
$line =~ s/\s+$//;
|
||||
next if $line eq '' || $line =~ /^#/;
|
||||
|
||||
my ($sock, $pane) = parse_target($line);
|
||||
if (!$sock) {
|
||||
log_msg("ignored invalid target: $line");
|
||||
next;
|
||||
}
|
||||
|
||||
my $key = "$sock $pane";
|
||||
if ($active{$key}) {
|
||||
log_msg("already watching $key");
|
||||
next;
|
||||
}
|
||||
|
||||
if (!target_exists($sock, $pane)) {
|
||||
log_msg("target does not exist: $key");
|
||||
next;
|
||||
}
|
||||
|
||||
if (start_pipe($sock, $pane, $event_path)) {
|
||||
$active{$key} = time;
|
||||
log_msg("watching $key");
|
||||
} else {
|
||||
log_msg("failed to start pipe for $key");
|
||||
}
|
||||
}
|
||||
|
||||
for my $key (keys %active) {
|
||||
my ($sock, $pane) = split / /, $key, 2;
|
||||
if (!target_exists($sock, $pane)) {
|
||||
delete $active{$key};
|
||||
log_msg("stopped tracking missing target $key");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub handle_event {
|
||||
my ($active, $event) = @_;
|
||||
|
||||
if ($event =~ /^EXIT\t([^\t]+)\t(%\d+)\t(.*)$/) {
|
||||
my ($sock, $pane, $reason) = ($1, $2, $3);
|
||||
my $key = "$sock $pane";
|
||||
if (delete $active->{$key}) {
|
||||
log_msg("watched pane ended: $key ($reason)");
|
||||
} else {
|
||||
log_msg("watcher exited for untracked target: $key ($reason)");
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
log_msg("ignored watcher event: $event");
|
||||
}
|
||||
|
||||
sub print_help {
|
||||
print STDERR <<"EOF";
|
||||
watcher.pl
|
||||
|
||||
Enter one target per line:
|
||||
/tmp/tmux-.../socket %pane
|
||||
|
||||
To get the correct target from the tmux pane you want watched, run this in tmux command mode:
|
||||
:display-message -p '#{socket_path} #{pane_id}'
|
||||
|
||||
Stop with Ctrl-C. The controller will close watcher pipes it started.
|
||||
|
||||
EOF
|
||||
}
|
||||
|
||||
sub stop_active_pipes {
|
||||
my ($active, $why) = @_;
|
||||
log_msg("$why; stopping " . scalar(keys %$active) . " active watcher pipe(s)");
|
||||
|
||||
for my $key (sort keys %$active) {
|
||||
my ($sock, $pane) = split / /, $key, 2;
|
||||
if (stop_pipe($sock, $pane)) {
|
||||
log_msg("stopped watcher pipe for $key");
|
||||
} else {
|
||||
log_msg("failed to stop watcher pipe for $key");
|
||||
}
|
||||
delete $active->{$key};
|
||||
}
|
||||
}
|
||||
|
||||
sub watcher {
|
||||
my ($sock, $pane, $event_path) = @_;
|
||||
die "usage: $SCRIPT --watcher SOCKET %pane\n"
|
||||
unless defined $sock && defined $pane;
|
||||
|
||||
binmode STDIN;
|
||||
|
||||
my $last_confirm = 0;
|
||||
my $last_signature = '';
|
||||
my $recent = '';
|
||||
my $exit_reason = 'pipe closed';
|
||||
|
||||
maybe_confirm($sock, $pane, \$last_confirm, \$last_signature, 'initial');
|
||||
|
||||
while (1) {
|
||||
my $bytes = read(STDIN, my $chunk, 4096);
|
||||
if (!defined($bytes)) {
|
||||
$exit_reason = "read error: $!";
|
||||
last;
|
||||
}
|
||||
last if $bytes == 0;
|
||||
|
||||
$recent .= clean_text($chunk);
|
||||
$recent = substr($recent, -8192) if length($recent) > 8192;
|
||||
|
||||
next if !has_any_prompt($recent);
|
||||
next if index($recent, $YES) < 0;
|
||||
|
||||
maybe_confirm($sock, $pane, \$last_confirm, \$last_signature, 'stream');
|
||||
}
|
||||
|
||||
notify_controller($event_path, "EXIT\t$sock\t$pane\t$exit_reason")
|
||||
if defined $event_path && $event_path ne '';
|
||||
}
|
||||
|
||||
sub maybe_confirm {
|
||||
my ($sock, $pane, $last_confirm_ref, $last_signature_ref, $source) = @_;
|
||||
my $now = time;
|
||||
|
||||
my ($ok, $screen) = rendered_last_lines($sock, $pane, $LINES);
|
||||
exit 0 if !$ok;
|
||||
|
||||
return if !has_any_prompt($screen);
|
||||
return if index($screen, $YES) < 0;
|
||||
|
||||
my $signature = prompt_signature($screen);
|
||||
if ($signature eq $$last_signature_ref && $now - $$last_confirm_ref < $COOLDOWN) {
|
||||
return;
|
||||
}
|
||||
|
||||
if (run_quiet('tmux', '-S', $sock, 'send-keys', '-t', $pane, 'Enter')) {
|
||||
$$last_confirm_ref = $now;
|
||||
$$last_signature_ref = $signature;
|
||||
log_msg("sent Enter to confirm $sock $pane from $source");
|
||||
} else {
|
||||
log_msg("failed to confirm $sock $pane; stopping watcher");
|
||||
exit 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub rendered_last_lines {
|
||||
my ($sock, $pane, $lines) = @_;
|
||||
my @cmd = (
|
||||
'tmux', '-S', $sock,
|
||||
'capture-pane', '-p',
|
||||
'-t', $pane,
|
||||
'-S', '-' . ($lines * 3),
|
||||
);
|
||||
|
||||
my ($ok, $out) = run_capture(@cmd);
|
||||
return (0, '') if !$ok;
|
||||
|
||||
my @lines = split /\n/, clean_text($out);
|
||||
@lines = @lines > $lines ? @lines[-$lines .. -1] : @lines;
|
||||
return (1, join("\n", @lines));
|
||||
}
|
||||
|
||||
sub start_pipe {
|
||||
my ($sock, $pane, $event_path) = @_;
|
||||
my $cmd = shell_quote($^X) . ' ' .
|
||||
shell_quote($SCRIPT) . ' --watcher ' .
|
||||
shell_quote($sock) . ' ' .
|
||||
shell_quote($pane) . ' ' .
|
||||
shell_quote($event_path);
|
||||
|
||||
return run_quiet(
|
||||
'tmux', '-S', $sock,
|
||||
'pipe-pane', '-t', $pane,
|
||||
'-o', $cmd,
|
||||
);
|
||||
}
|
||||
|
||||
sub notify_controller {
|
||||
my ($event_path, $event) = @_;
|
||||
return if !defined $event_path || $event_path eq '';
|
||||
|
||||
if (open my $fh, '>', $event_path) {
|
||||
print $fh "$event\n";
|
||||
close $fh;
|
||||
}
|
||||
}
|
||||
|
||||
sub stop_pipe {
|
||||
my ($sock, $pane) = @_;
|
||||
return run_quiet(
|
||||
'tmux', '-S', $sock,
|
||||
'pipe-pane', '-t', $pane,
|
||||
);
|
||||
}
|
||||
|
||||
sub target_exists {
|
||||
my ($sock, $pane) = @_;
|
||||
return run_quiet(
|
||||
'tmux', '-S', $sock,
|
||||
'display-message', '-p',
|
||||
'-t', $pane,
|
||||
'#{pane_id}',
|
||||
);
|
||||
}
|
||||
|
||||
sub parse_target {
|
||||
my ($line) = @_;
|
||||
return ($1, $2) if $line =~ /^(\S+)\s+(%\d+)$/;
|
||||
return;
|
||||
}
|
||||
|
||||
sub clean_text {
|
||||
my ($text) = @_;
|
||||
$text =~ s/\e\][^\a]*(?:\a|\e\\)//g; # OSC
|
||||
$text =~ s/\e\[[0-?]*[ -\/]*[@-~]//g; # CSI
|
||||
$text =~ s/\e[ -\/]*[@-~]//g; # Other ESC sequences
|
||||
$text =~ tr/\r/\n/;
|
||||
$text =~ s/[\x00-\x08\x0b\x0c\x0e-\x1f\x7f]//g;
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub has_any_prompt {
|
||||
my ($text) = @_;
|
||||
for my $prompt (@PROMPTS) {
|
||||
return 1 if index($text, $prompt) >= 0;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub prompt_signature {
|
||||
my ($text) = @_;
|
||||
$text = clean_text($text);
|
||||
$text =~ s/\s+/ /g;
|
||||
$text =~ s/^\s+//;
|
||||
$text =~ s/\s+$//;
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub run_capture {
|
||||
my (@cmd) = @_;
|
||||
my $pid = open(my $fh, '-|');
|
||||
die "fork failed: $!\n" unless defined $pid;
|
||||
|
||||
if ($pid == 0) {
|
||||
open STDERR, '>', '/dev/null' or exit 127;
|
||||
exec @cmd;
|
||||
exit 127;
|
||||
}
|
||||
|
||||
local $/;
|
||||
my $out = <$fh>;
|
||||
my $ok = close $fh;
|
||||
return ($ok ? 1 : 0, defined($out) ? $out : '');
|
||||
}
|
||||
|
||||
sub run_quiet {
|
||||
my (@cmd) = @_;
|
||||
my $pid = fork();
|
||||
return 0 unless defined $pid;
|
||||
|
||||
if ($pid == 0) {
|
||||
open STDOUT, '>', '/dev/null' or exit 127;
|
||||
open STDERR, '>', '/dev/null' or exit 127;
|
||||
exec @cmd;
|
||||
exit 127;
|
||||
}
|
||||
|
||||
waitpid($pid, 0);
|
||||
return $? == 0;
|
||||
}
|
||||
|
||||
sub shell_quote {
|
||||
my ($s) = @_;
|
||||
$s =~ s/'/'"'"'/g;
|
||||
return "'$s'";
|
||||
}
|
||||
|
||||
sub log_msg {
|
||||
my ($msg) = @_;
|
||||
my $ts = strftime('%Y-%m-%dT%H:%M:%SZ', gmtime());
|
||||
my $line = "$ts watcher.pl: $msg\n";
|
||||
print STDERR $line;
|
||||
|
||||
if ($LOG_FILE ne '' && open my $fh, '>>', $LOG_FILE) {
|
||||
print $fh $line;
|
||||
close $fh;
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user