Gestion d'un processus avec timeout

Gestion d'un processus avec timeout - Perl - Programmation

Marsh Posté le 30-05-2008 à 11:43:15    

Bonjour,

 

J'ai un problème en Perl que je n'arrive pas à résoudre.

 

J'ai besoin de lancer une commande (en fait mon script perl gère un lot et lance la commande en séquence sur chaque élément du lot), et de l'arrêter si elle prend trop de temps.

 

J'ai creusé plusieurs méthodes, donc la plus "propre" semble être l'utilisation de alarm et die, mais ça ne marche pas dans mon cas.

 

Voici le code de "test" de la méthode, modifiée pour mon usage, à partir du code qu'on peut trouver un peu partout sur le net :

 
Code :
  1. #!/usr/bin/perl -w
  4. $gcom = "<ma commande>";
  5. $time = 5;
  7. sub execCom {
  9. $com = $_[0];
  11. eval {
  12.  local $SIG{ALRM} = sub { die "$com est parti en boucle\n" };
  13.  alarm $time;
  14.  system($com);
  15.  alarm 0;
  16. };
  18. if ($@) {
  19.  die "#3xyz# : $@\n";
  20.  # délai dépassé : time out
  21. } else {
  22.  # délai non dépassé
  23.  print "#8xyz# : Délai non dépassé\n";
  24. }
  26. }
  28. system ("touch 1.t" );
  29. &execCom("$gcom" );
  30. system ("touch 2.t" );
  31. &execCom("$gcom" );
  32. system ("touch 3.t" );
  33. &execCom("$gcom" );
  34. system ("touch 4.t" );
  35. &execCom("$gcom" );
  36. system ("touch fin.t" );
  37. system ("ll -rt *.t" );
 

Au final, seule la première commande est exécutée (les lignes 28 et 29). Elle dépasse le timeout, mais n'est pas arrêtée... Les lignes suivantes (30 et +) ne sont jamais exécutées.

 

Quelqu'un pourrait m'expliquer ?

 

J'ai aussi regardé du côté de "ulimit" en bash/sh et "limit cputime" en csh/tcsh, mais je me trouve face à un comportement étrange, et surtout, des impossibilité de changer les valeurs... De plus comme c'est dépendant du shell, j'ai moins confiance.

 

Merci de m'aider :)


Message édité par Predicator le 30-05-2008 à 11:45:10
Reply

Marsh Posté le 30-05-2008 à 11:43:15   

Reply

Marsh Posté le 30-05-2008 à 14:16:11    

Bon, à défaut de réponse et vu que c'est assez pressé, j'ai utilisé une autre méthode. Pas propre il est vrai, mais fonctionnelle (je n'ai pas trouvé de faille, même je ne doute pas qu'il y en ait une).
 
Donc l'idée est qu'un script A gère le lot, et appelle un script perl B, via la commande system.
 
Voici le contenu du script B (avec commentaire de debuggage non retirés) :
 

Code :
  1. #!/usr/bin/perl -w
  3. $gcom = $ARGV[0];
  4. $time = $ARGV[1];
  6. $pid = fork();
  8. if (not defined $pid) {
  9. print "Plus de ressources...\n";
  10. exit(1);
  11. }
  13. if ($pid == 0) {
  14. # fils, on lance le programme
  15. exec($gcom);
  16. } else {
  17. #print "$pid\n";
  18. $cpt = 0;
  19. while($cpt < $time) {
  21.  # On teste l'existence du pid
  23.  open COM, ("ps -p $pid|grep $pid|" );
  24.  @lines = <COM>;
  25.  close COM;
  27.  print "@lines\n";
  29.  if ($lines[0] =~ m/$pid/) {
  30.   print "$pid is running\n";
  31.   if ($lines[0] =~ m/defunct/) {
  32.    print "Attente du fils que le père meurt\n";
  33.    exit(0);
  34.   } else {
  35.    print "$cpt : Attente d'une seconde\n";
  36.    sleep(1);
  37.   }
  38.  } else {
  39.   exit(0);
  40.  }
  41.  $cpt++;
  42. }
  44. open COM, ("ps -p $pid|grep $pid|" );
  45. @lines = <COM>;
  46. close COM;
  48. if ($lines[0] =~ m/$pid/) {
  49.  print "Sortie de boucle, $pid is running\n";
  50.  print "$pid must be killed... Cya in Hell my friend !\n";
  51.  kill 9, $pid;
  52. }
  54. }


 
Je vais utiliser ce script dès cet après-midi, mais je reste ouvert à toute évolution, donc ne vous privez pas :)

Reply

Marsh Posté le 30-05-2008 à 15:41:30    

L'autre jour j'ai eu le même problème, je sais pas pourquoi, je m'en sortais pas avec l'alarm, ça bloquait souvent pour une raison que je n'ai pas réussi à déterminer. donc au final j'ai fait une méthode ou je lance un autre processus pour tuer l'autre.
 

Code :
  1. sub _find_started_process
  2. {
  3.     my $spawner = shift;
  4.     my $child = `ps -elf | awk '\$5 == $spawner { print \$4 }`;
  5.     chomp $child;
  6.     print STDERR "Real subprocess is $child\n" if ($child);
  7.     return $child;
  8. }
  10. sub _start_killer
  11. {
  12.     my ($pid, $gracetime) = @_;
  14.     my $killer = fork;
  16.     return $killer if $killer;
  18.     POSIX::setsid;
  19.     chdir '/';
  20.     #fork && exit;
  22.     print STDERR "Killer $$ started for PID $pid with gracetime $gracetime\n";
  23.     sleep $gracetime;
  24.     if (kill(0, $pid)) {
  25.         do {
  26.             print STDERR "Killing $pid\n";
  27.         } while (kill(9, $pid) != 1);
  28.     }
  30.     exit;
  31. }
  35. sub _run
  36. {
  37.     my $cmd = shift;
  39.     my $data = undef;
  40.     my $pid = undef;
  41.     my $killerpid = undef;
  43.     eval {
  44.         my $timeout = 20;
  45.         ($pid = open(INPUT, '-|', $cmd)) or die("cannot start : $!" );
  46.         print STDERR "Running $cmd with PID $pid\n";
  47.         my $started = _find_started_process($pid);
  48.         if ($started) {
  49.             $killerpid = _start_killer($started, $timeout);
  50.         }
  51.         $data = do { local($/); <INPUT> };
  52.         close(INPUT);
  53.     };
  54.     my $error = @_;
  56.     if ($killerpid && kill(0, $killerpid)) {
  57.         do {
  58.             print STDERR "Killing killer $killerpid\n";
  59.         } while (kill(9, $killerpid) != 1);
  61.         waitpid($killerpid, 0);
  62.     }
  64.     # _start_killer($killerpid, 0);
  66.     if ($error) {
  67.         die "Couldn't not run '$cmd' : $error";
  68.     }
  70.     return $data;
  71. }

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed