Bug fixes

general.debugcontext: filter out cmdlist and arglist

Core/Applets: log applet start/stop and duration

Core/ProcessManager: fix potential race-condition with $context object

Core/Interpreter:

    * expand pronouns before command-substitution
    * attempt to find current channel's factoid instance for metadata
    * remove duplication of command history in command-substition
    * terminate pipe/substitution processing when protecting self

Core/Factoids: limit -url contents to 250kb

lib/PBot/Core/Applets.pm

@@ -17,6 +17,8 @@ use PBot::Imports;
 use IPC::Run qw/run timeout/;
 use Encode;
 
+use Time::HiRes qw/gettimeofday/;
+
 sub initialize {
     # nothing to do here
 }
@@ -24,9 +26,11 @@ sub initialize {
 sub execute_applet($self, $context) {
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
+        $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("execute_applet\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     $self->{pbot}->{process_manager}->execute_process($context, sub { $self->launch_applet(@_) });
@@ -91,7 +95,11 @@ sub launch_applet($self, $context) {
             @cmdline = map { encode('UTF-8', $_) } @cmdline;
         }
 
+        my $start = gettimeofday;
+        $self->{pbot}->{logger}->log("Starting applet run @cmdline\n");
         run \@cmdline, \$stdin, \$stdout, \$stderr, timeout($timeout);
+        my $duration = sprintf "%0.3f", gettimeofday - $start;
+        $self->{pbot}->{logger}->log("Finished applet run @cmdline; duration: $duration\n");
 
         my $exitval = $? >> 8;
 

lib/PBot/Core/Commands.pm

@@ -132,10 +132,11 @@ sub interpreter($self, $context) {
     # debug flag to trace $context location and contents
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
         $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("Commands::interpreter\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     # some convenient aliases

lib/PBot/Core/Commands/Factoids.pm

@@ -735,6 +735,10 @@ sub cmd_factadd($self, $context) {
             } else {
                 return "Failed to get URL: " . $response->status_line;
             }
+
+            if (length $text > 1024*250) {
+                return "Factoid content cannot be larger than 250Kb";
+            }
         } else {
             # check for optional "is" and discard
             if (lc $arglist[0] eq 'is') {

lib/PBot/Core/Commands/ProcessManager.pm

@@ -59,10 +59,10 @@ sub cmd_ps($self, $context) {
     my @entries;
 
     foreach my $process (@processes) {
-        my $entry = "$process->{pid}: $process->{commands}->[0]";
+        my $entry = "$process->{pid}: $process->{command}";
 
         if ($show_running_time or $show_all) {
-            my $duration = concise duration (gettimeofday - $process->{process_start});
+            my $duration = concise duration (gettimeofday - $process->{start});
             $entry .= " [$duration]";
         }
 
@@ -117,7 +117,7 @@ sub cmd_kill($self, $context) {
 
         foreach my $pid (sort keys %{$self->{pbot}->{process_manager}->{processes}}) {
             my $process = $self->{pbot}->{process_manager}->{processes}->{$pid};
-            next if defined $kill_time and $now - $process->{process_start} < $kill_time;
+            next if defined $kill_time and $now - $process->{start} < $kill_time;
             push @pids, $pid;
         }
     } else {

lib/PBot/Core/Factoids/Interpreter.pm

@@ -20,9 +20,11 @@ sub interpreter($self, $context) {
     # trace context and context's contents
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
+        $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("Factoids::interpreter\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     if (not length $context->{keyword}) {
@@ -279,9 +281,11 @@ sub handle_action($self, $context, $action) {
     # trace context and context's contents
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
+        $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("Factoids::handle_action [$action]\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     if (not length $action) {
@@ -453,7 +457,6 @@ sub handle_action($self, $context, $action) {
         return '';
     }
 
-
     return $action if $context->{special} eq 'code-factoid';
 
     if ($self->{pbot}->{factoids}->{data}->{storage}->get_data($channel, $keyword, 'type') eq 'applet') {

lib/PBot/Core/Interpreter.pm

@@ -269,9 +269,11 @@ sub interpret($self, $context) {
     # debug flag to trace $context location and contents
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
+        $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("Interpreter::interpret\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     # enforce recursion limit
@@ -365,6 +367,62 @@ sub interpret($self, $context) {
         }
     }
 
+    # find factoid channel for dont-replace-pronouns metadata
+    my ($fact_channel, $fact_trigger);
+    my @factoids = $self->{pbot}->{factoids}->{data}->find($context->{from}, $keyword, exact_trigger => 1);
+
+    if (@factoids == 1) {
+        # found the factoid's channel
+        ($fact_channel, $fact_trigger) = @{$factoids[0]};
+    } else {
+        # match the factoid in the current channel if it exists
+        foreach my $f (@factoids) {
+            $self->{pbot}->{logger}->log("[$f->[0]][$f->[1]] [$context->{from}]\n");
+            if ($f->[0] eq $context->{from}) {
+                ($fact_channel, $fact_trigger) = ($f->[0], $f->[1]);
+                last;
+            }
+        }
+
+        # and otherwise assume global if it doesn't exist (FIXME: what to do if there isn't a global one?)
+        if (not defined $fact_channel) {
+            ($fact_channel, $fact_trigger) = ('.*', $keyword);
+        }
+    }
+
+    if ($self->{pbot}->{commands}->get_meta($keyword, 'dont-replace-pronouns')
+            or $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-replace-pronouns'))
+    {
+        $context->{'dont-replace-pronouns'} = 1;
+    }
+
+    # replace pronouns like "i", "my", etc, with "nick", "nick's", etc
+    if (not $context->{'dont-replace-pronouns'}) {
+        # if command recipient is "me" then replace it with invoker's nick
+        # e.g., "!tell me about date" or "!give me date", etc
+        if (defined $context->{nickprefix} and lc $context->{nickprefix} eq 'me') {
+            $context->{nickprefix} = $context->{nick};
+        }
+
+        # strip trailing sentence-ending punctuators from $keyword
+        # TODO: why are we doing this? why here? why at all?
+        $keyword =~ s/(\w+)[?!.]+$/$1/;
+
+        # replace pronouns in $arguments.
+        # but only on the top-level command (not on subsequent recursions).
+        # all pronouns can be escaped to prevent replacement, e.g. "!give \me date"
+        if (length $arguments and $context->{interpret_depth} <= 1) {
+            $arguments =~ s/(?<![\w\/\-\\])i am\b/$context->{nick} is/gi;
+            $arguments =~ s/(?<![\w\/\-\\])me\b/$context->{nick}/gi;
+            $arguments =~ s/(?<![\w\/\-\\])my\b/$context->{nick}'s/gi;
+
+            # unescape any escaped pronouns
+            $arguments =~ s/\\i am\b/i am/gi;
+            $arguments =~ s/\\my\b/my/gi;
+            $arguments =~ s/\\me\b/me/gi;
+        }
+    }
+
     # parse out a substituted command
     if ($arguments =~ m/(?<!\\)&\s*\{/) {
         my ($command) = $self->extract_bracketed($arguments, '{', '}', '&', 1);
@@ -390,12 +448,6 @@ sub interpret($self, $context) {
             # replace contextual command
             $context->{command} = $command;
 
-            # reset contextual command history
-            $context->{commands} = [];
-
-            # add command to contextual command history
-            push @{$context->{commands}}, $command;
-
             # interpret the substituted command
             $context->{result} = $self->interpret($context);
 
@@ -433,56 +485,10 @@ sub interpret($self, $context) {
     # unescape any escaped pipes
     $arguments =~ s/\\\|\s*\{/| {/g;
 
-    # find factoid channel for dont-replace-pronouns metadata
-    my ($fact_channel, $fact_trigger);
-    my @factoids = $self->{pbot}->{factoids}->{data}->find($context->{from}, $keyword, exact_trigger => 1);
-
-    if (@factoids == 1) {
-        # found the factoid's channel
-        ($fact_channel, $fact_trigger) = @{$factoids[0]};
-    } else {
-        # more than one factoid found, normally we would prompt to disambiguate
-        # but in this case we'll just go ahead and assume global
-        ($fact_channel, $fact_trigger) = ('.*', $keyword);
-    }
-
-    if ($self->{pbot}->{commands}->get_meta($keyword, 'dont-replace-pronouns')
-            or $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-replace-pronouns'))
-    {
-        $context->{'dont-replace-pronouns'} = 1;
-    }
-
-    # replace pronouns like "i", "my", etc, with "nick", "nick's", etc
-    if (not $context->{'dont-replace-pronouns'}) {
-        # if command recipient is "me" then replace it with invoker's nick
-        # e.g., "!tell me about date" or "!give me date", etc
-        if (defined $context->{nickprefix} and lc $context->{nickprefix} eq 'me') {
-            $context->{nickprefix} = $context->{nick};
-        }
-
-        # strip trailing sentence-ending punctuators from $keyword
-        # TODO: why are we doing this? why here? why at all?
-        $keyword =~ s/(\w+)[?!.]+$/$1/;
-
-        # replace pronouns in $arguments.
-        # but only on the top-level command (not on subsequent recursions).
-        # all pronouns can be escaped to prevent replacement, e.g. "!give \me date"
-        if (length $arguments and $context->{interpret_depth} <= 1) {
-            $arguments =~ s/(?<![\w\/\-\\])i am\b/$context->{nick} is/gi;
-            $arguments =~ s/(?<![\w\/\-\\])me\b/$context->{nick}/gi;
-            $arguments =~ s/(?<![\w\/\-\\])my\b/$context->{nick}'s/gi;
-
-            # unescape any escaped pronouns
-            $arguments =~ s/\\i am\b/i am/gi;
-            $arguments =~ s/\\my\b/my/gi;
-            $arguments =~ s/\\me\b/me/gi;
-        }
-    }
-
     # the bot doesn't like performing bot commands on itself
     # unless dont-protect-self is true
     if (not $self->{pbot}->{commands}->get_meta($keyword, 'dont-protect-self')
-            and not $self->{pbot}->{factoids}->{data}->get_meta($context->{from}, $keyword, 'dont-protect-self'))
+            and not $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-protect-self'))
     {
         my $botnick = $self->{pbot}->{conn}->nick;
 
@@ -508,6 +514,9 @@ sub interpret($self, $context) {
             $delay = duration($delay);
             $self->{pbot}->{logger}->log("($delay delay) $message->{message}\n");
 
+            # end pipe/substitution processing
+            $context->{alldone} = 1;
+
             # no output to return
             return undef;
         }
@@ -575,9 +584,11 @@ sub handle_result($self, $context, $result = $context->{result}) {
     # debug flag to trace $context location and contents
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
+        $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("Interpreter::handle_result [$result]\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     # strip and store /command prefixes
@@ -835,9 +846,11 @@ sub output_result($self, $context) {
     # debug flag to trace $context location and contents
     if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
         use Data::Dumper;
-        $Data::Dumper::Sortkeys = 1;
+        $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] };
+        $Data::Dumper::Indent = 2;
         $self->{pbot}->{logger}->log("Interpreter::output_result\n");
         $self->{pbot}->{logger}->log(Dumper $context);
+        $Data::Dumper::Sortkeys = 1;
     }
 
     my $output = $context->{output};

lib/PBot/Core/ProcessManager.pm

@@ -26,36 +26,34 @@ sub initialize($self, %conf) {
 }
 
 sub add_process($self, $pid, $context) {
-    $context->{process_start} = gettimeofday;
+    my $data = {
+        start => scalar gettimeofday,
+        command => $context->{command},
+    };
 
-    $self->{processes}->{$pid} = $context;
+    $self->{processes}->{$pid} = $data;
 
-    $self->{pbot}->{logger}->log("Starting process $pid: $context->{commands}->[0]\n");
+    $self->{pbot}->{logger}->log("Starting process $pid: $data->{command}\n");
 }
 
 sub remove_process($self, $pid) {
     if (exists $self->{processes}->{$pid}) {
-        my $command = $self->{processes}->{$pid}->{commands}->[0];
+        my $command = $self->{processes}->{$pid}->{command};
 
-        my $duration = gettimeofday - $self->{processes}->{$pid}->{process_start};
+        my $duration = sprintf "%0.3f", gettimeofday - $self->{processes}->{$pid}->{start};
-        $duration = sprintf "%0.3f", $duration;
 
         $self->{pbot}->{logger}->log("Finished process $pid ($command): duration $duration seconds\n");
 
         delete $self->{processes}->{$pid};
     } else {
-        $self->{pbot}->{logger}->log("Finished process $pid\n");
+        $self->{pbot}->{logger}->log("External process finished $pid\n");
     }
 }
 
 sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref = undef) {
-    # ensure contextual command history list is available for add_process()
-    if (not exists $context->{commands}) {
-        $context->{commands} = [$context->{command}];
-    }
-
     # don't fork again if we're already a forked process
     if (defined $context->{pid} and $context->{pid} == 0) {
+        $self->{pbot}->{logger}->log("execute_process: Re-using PID $context->{pid} for new process\n");
         $subref->($context);
         return $context->{result};
     }
@@ -99,7 +97,7 @@ sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref =
 
         # execute the provided subroutine, results are stored in $context
         eval {
-            local $SIG{ALRM} = sub { die "Process `$context->{commands}->[0]` timed-out\n" };
+            local $SIG{ALRM} = sub { die "Process `$context->{command}` timed-out\n" };
             alarm ($timeout // 30);
             $subref->($context);
             alarm 0;

lib/PBot/VERSION.pm

@@ -25,8 +25,8 @@ use PBot::Imports;
 # These are set by the /misc/update_version script
 use constant {
     BUILD_NAME     => "PBot",
-    BUILD_REVISION => 4804,
+    BUILD_REVISION => 4805,
-    BUILD_DATE     => "2024-10-15",
+    BUILD_DATE     => "2024-10-22",
 };
 
 sub initialize {}