Tuer la demande LWP actuelle avec CTRL + C

Question

J'ai un script basé sur Term::ReadLine et LWP::UserAgent

La logique est la suivante,

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;
}

Sur run il fera une demande LWP. Maintenant, si j'appuie sur CTRL + C non seulement le LWP est terminé, mais l'ensemble du script de perl est également terminé.

Je voulais seulement tuer la demande de LWP. Des idées ?

Je peux ajouter un gestionnaire de SIGINT, mais je ne sais pas ce qu'il doit faire.

Answer 1

Convertir le signal en une exception.

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

En règle générale, il faut alors envelopper le code dans une balise eval BLOCK mais LWP::UserAgent attrape ces exceptions et renvoie une réponse d'erreur.

Par exemple,

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;

Sortie si aucun SIGINT n'est reçu :

Successful
200
200 OK

Sortie si SIGINT reçu :

Unsuccessful
500
500 SIGINT

Answer 2

Une façon d'arrêter du code est de l'exécuter dans un processus enfant et kill cet enfant dans le gestionnaire de signaux du parent lorsque SIGINT est reçu par le parent. Le parent continue de fonctionner puisque le signal est traité.

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
}

Une bonne partie du code est destinée aux impressions de diagnostic. Quelques commentaires suivent

Le site kill ne fait qu'envoyer un signal. Il ne garantit en aucun cas que le processus se termine. Vérifiez cela avec kill $pid, 0 qui retourne vrai si le processus n'a pas a été récolté (même si c'est un zombie). Sur mon système TERM es 15 et même si cela est très courant, vérifiez.

Le signal peut survenir à un moment où l'enfant ne court pas. Le gestionnaire vérifie d'abord si le $pid est là et si ce n'est pas le cas, elle meurt/se retire, en respectant SIGINT . Modifiez comme il convient.

Après le fork le parent passe devant if ($pid == 0) et renvoie le $pid tout de suite.

Vous pouvez installer $SIG{TERM} dans l'enfant où il peut se nettoyer s'il a besoin de sortir de manière ordonnée.

Le site SIGINT sera épuisé par l'enfant également, donc "Got $_[0] ..." est imprimé deux fois. Si c'est un problème, ajoutez un gestionnaire à l'enfant pour ignorer le signal, $SIG{INT} = 'IGNORE'; . Avec cela en place et en appuyant sur Ctrl-C lorsque l'enfant est en cours d'exécution, la sortie est la suivante

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

Le statut de l'enfant une fois qu'il est sorti peut être vérifié via $? voir system y en perlvar .

Documentation : fourchette (et exec , système ), %SIG en perlvar , waitpid des parties de perlipc , tuer .

Si le travail effectué dans l'enfant devait communiquer avec le parent, alors il y aurait plus à faire. Cependant, l'extrait de code ajouté à la question indique que ce n'est pas le cas.

Answer 3

Vous devez fournir un callback dans votre appel à $ua->request . Délivrer die dans ce callback mettra fin au transfert.

Il vous suffit alors de définir une variable d'indicateur dans votre gestionnaire de signal Ctrl-C, et die dans votre callback si ce drapeau est activé.

J'écrirai un peu de code quand je serai de retour à un PC, et quand vous aurez montré ce qu'est votre run le sous-programme.

---

Voici un code qui semble correct, mais je ne peux pas le tester pour le moment.

Attention run est un identifiant direct pour n'importe quelle sous-routine, en particulier celle qui lance un transfert de réseau et imprime le résultat.

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`
}

Notez que la réduction :read_size_hint fera en sorte que le callback soit appelé plus fréquemment avec de plus petits morceaux de données. Cela améliorera la réponse à Ctrl-C mais réduisent l'efficacité du transfert