CODEWITHSUNDEEP
perllwp
daisy
daisy

Reputation: 23541

Kill current LWP request with CTRL + C

I have a script based on Term::ReadLine and LWP::UserAgent

The logic is like this,

while (defined ($_ = $term->readline('console> ')))
{
    next unless $_; chomp;

    if ($_ eq 'exit')
    {
        last;
    }
    &run ($_);
}

sub run {
    my $ua   = LWP::UserAgent->new;
    my $resp = $ua->get (...);

    say $resp->content;
}

In run it will do a LWP request. Now If I press CTRL + C, not only the LWP is terminated, the whole perl script is terminated as well.

I wanted to kill the LWP request only. Any ideas?

I can add a SIGINT handler, but I don't know what the handler should do

Upvotes: 2

Views: 399

Answers (3)

zdim
zdim

Reputation: 66899

One way to stop code is to run it in a child process and kill that child in the parent's signal handler when SIGINT is received by the parent. The parent keeps running since the signal is handled.

use warnings;
use strict;
use feature 'say';

$SIG{INT} = \&sigint_handler;    # or: $SIG{INT} = sub { ... };

say "Parent $$ start.";

my $pid = run_proc();
my $gone_pid = waitpid $pid, 0;  # check status, in $?

say "Parent exiting";

sub run_proc
{
    my $pid = fork // die "Can't fork: $!";
    if ($pid == 0) {                               # child process
        say "\tKid, sleep 5 (time for Ctrl-C)";    # run your job here
        sleep 5;                                
        say "\tKid exiting.";
        exit;
    }   
    return $pid;
}

sub sigint_handler { 
    if ($pid and kill 0, $pid) {
        say "Got $_[0], send 'kill TERM' to child process $pid.";
        my $no_signalled = kill 15, $pid;
     }
     else { die "Got $_[0]" }   # or use exit
}

A good deal of the code is for diagnostic prints. Some comments follow

The kill only sends a signal. It does not in any way ensure that the process terminates. Check this with kill $pid, 0, which returns true if the process has not been reaped (even if it's a zombie). On my system TERM is 15, and even though this is very common please check.

The signal could come at a time when the child is not running. The handler first checks whether the $pid is out there and if not it dies/exits, respecting SIGINT. Change as appropriate.

After the fork the parent drops past if ($pid == 0) and returns the $pid right away.

You can install $SIG{TERM} in the child, where it can clean up if it needs to exit orderly.

The SIGINT handler will run out of the child as well, so "Got $_[0] ..." is printed twice. If this is a concern add a handler to the child to ignore the signal, $SIG{INT} = 'IGNORE';. With this in place and with Ctrl-C hit while the child is running, the output is

Parent 9334 start.
        Kid, sleep 5 (time for Ctrl-C)
^CGot INT, send 'kill TERM' to child process 9335.
Parent exiting

The status of the child once it exited can be checked via $?, see system and in perlvar.

Documentation: fork (and exec, system), %SIG in perlvar, waitpid, parts of perlipc, kill.

If the job done in the child needed to communicate with the parent then there would be more to do. However, the code snippet added to the question indicates that this is not the case.

Upvotes: 1

ikegami
ikegami

Reputation: 386396

Convert the signal into an exception.

local $SIG{INT} = sub { die "SIGINT\n" };

Generally, one would then wrap the code in an eval BLOCK, but LWP::UserAgent catches these exceptions and returns an error response.

For example,

use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $response = do {
   local $SIG{INT} = sub { die "SIGINT\n" };
   $ua->get("http://localhost/zzz.crx")
};
say $response->is_success ? "Successful" : "Unsuccessful";
say $response->code;
say $response->status_line;

Output if no SIGINT received:

Successful
200
200 OK

Output if SIGINT received:

Unsuccessful
500
500 SIGINT

Upvotes: 2

Borodin
Borodin

Reputation: 126742

You need to provide a callback in your call to $ua->request. Issuing die in that callback will terminate the transfer.

You then just need to set a flag variable in your Ctrl-C signal handler, and die in your callback if that flag is set.

I'll write some code when I get back to a PC, and when you have shown what your run subroutine does.

Here's some code that looks right, but I can't test it at present

Beware that run is a dire identifier for any subroutine, especially one that starts a network transfer and prints the result

sub run {

    my ($url) = @_;

    my $die;
    local $SIG{INT} = sub { $die = 1 };

    my $ua = LWP::UserAgent->new;

    my $resp = $ua->get(
        $url,
        ':content_cb' => sub {
            die "Interrupted LWP transfer" if $die;
            my ($data, $resp, $proto) = @_;
            print $data;
        },
        ':read_size_hint' => 1024
    );

    print "\n";  # Emulate additional newline from `say`
}

Note that reducing :read_size_hint will cause the callback to be called more frequently with smaller chunks of data. That will improve the response to Ctrl-C but reduce the efficiency of the transfer

Upvotes: 0

Related Questions