[perl] process defunct avec fork et exec

process defunct avec fork et exec [perl] - Perl - Programmation

Marsh Posté le 12-09-2013 à 15:42:10    

Hello

 

J'ai un soucis avec un script perl que j'essaie de faire, qui fait un fork de lui-même, pour calculer son temps d'execution (en gros)

 

Le code :

Code :
  1. #!/usr/bin/perl
  2. $cmd = "sleep 20 ";
  3. my $pid;
  4. defined($pid = fork()) or die "unable to fork: $!\n";
  5. if ($pid == 0) { #parent
  6.   exec($cmd);
  7.   die ;
  8. }
  9. else { #child
  10. $time=0;
  11. while(1) {
  12.  $rc = system("ps -p".$pid." 2>&1 >/dev/null" );
  13.  if($rc==0){
  14.   print "pid $pid still running after $time seconds\n";
  15.  }
  16.  else{
  17.   print "pid $pid running after $time seconds\n";
  18.   exit;
  19.  }
  20.  $time+=5;
  21.  sleep 5;
  22. }
  23. }
 

quand je lance, tout va bien jusqu'à 20 secondes, puis le process sleep passe en defunct, et le process parent attend dans le vide.

 

pour l'instant, c'est sur du linux, mais il faudrait que ca marche également sous windows... si possible

 

Idéalement, quand le script parent "sleep 20" se finit, j'aimerais obtenir son return code...

 

Une idée ?

 

:jap:


Message édité par nabbo le 12-09-2013 à 15:48:22
Reply

Marsh Posté le 12-09-2013 à 15:42:10   

Reply

Marsh Posté le 13-09-2013 à 15:44:25    

Bon. j'ai obtenu quelque chose de pas très propre... mais qui marche à peu près :
 

Code :
  1. my $pid;
  2. defined($pid = fork()) or die "unable to fork: $!\n";
  3. if ($pid == 0) { #parent : launch the process
  4. $cmd = "sleep 20";
  5. $rc = system($cmd);
  6. $rc = $rc >>= 8;
  7. if ($rc > 127) {$rc -= 256;}
  8. print "rc=$rc\n";
  9. exit;
  10. }
  11. else { #child : monitoring
  12. $time=0;
  13. $sleepTime = 1;
  14. while(1) {
  15.  $out = `ps -p$pid | grep $pid | grep -v defunct`;
  16.  if($out!="" ) {
  17.   print "pid $pid still running after $time seconds\n";
  18.  }
  19.  else {
  20.   print "pid $pid not running after $time seconds\n";
  21.   exit;
  22.  }
  23.  $time+=$sleepTime;
  24.  sleep $sleepTime;
  25. }
  26. }


 
Le problème est que le process appelé part quand même en defunct, mais j'ai modifié l'utilisation du ps pour l'ignorer. S'il part en defunct, alors je considère qu'il n'est plus là, et mon script sort. Quand mon script sort, le process "defunct" lui-même est arrêté.
 
C'est pas très propre, mais ca marche.
 
Est ce qu'il y a moyen de faire plus propre ?

Reply

Marsh Posté le 13-09-2013 à 16:20:09    

Citation :

if ($pid == 0) { #parent
  exec($cmd);
  die ;
}
else { #child
...
}


Non!!

Citation :

if ($pid == 0) { #child
  exec($cmd);
  die ;
}
else { #parent
waitpid($pid,0);    
...
}


 
typiquement, pour avoir le code retour:

Code :
  1. #!/usr/bin/perl
  2.  
  3. my $cmd = "sleep 20";
  4. my $pid = fork();
  5. die "Can't fork() : $!\n" unless defined $pid;
  6.  
  7. if ($pid) {
  8.  if (waitpid($pid, 0) != -1) {
  9.    my ($rc, $sig, $core) = ($? >> 8, $? & 127, $? & 128);
  10.    if ($core) {
  11.      print "$pid dumped core\n";
  12.    } elsif ($sig == 9) {
  13.      print "$pid was murdered!\n";
  14.    } else {
  15.      print "$pid returned $rc";
  16.      print ($sig?" after receiving signal $sig":"\n" );
  17.    }
  18.  } else {
  19.    print "$pid... um... disappeared...\n";
  20.  }
  21. } else {
  22.  my $rc = exec($cmd);
  23.  exit $rc;
  24. }


 
et pour mesurer les temps d'exécution, il y a le module Benchmark.
 
A+,


Message édité par gilou le 13-09-2013 à 16:21:17

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 15-09-2013 à 20:28:23    

hello et merci pour la réponse
 
Le problème avec le waitpid (si j'ai bien compris) est que le parent attend que le fils ait fini pour prendre la suite. Or je ne veux pas qu'il attende que le fils ait fini, je veux faire une action au bout d'un certain temps, si le fils n'a pas fini.
 
Le module benchmark, je vais regarder. Mais je suis assez limité par les modules que je peux utiliser (sur windows, je vais être limité par une version de perl sans aucun module :( )

Reply

Marsh Posté le 16-09-2013 à 00:02:13    

Quand un processus fils a fini et que le processus père ne fait pas un wait ou waitpid dessus, il devient un processus zombie.
 
Tu ferais probablement mieux d'utiliser le module Proc::Background
 
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 16-09-2013 à 00:37:26    

Citation :

sur windows, je vais être limité par une version de perl sans aucun module

:heink:  
 
Sinon, il y a une technique avec un double fork:
Le père forke un premier fils, lequel fait un sleep 20 puis exit
Le père va faire un waitpid sur ce premier fils, ça fait un délai de 20s pour l’exécution du père
Mais avant ce waitpid, le père va faire un second fork pour un second fils qui va exécuter la commande puis exit
Quand le père au bout de 20s reçoit la fin du premier fils, il sort de son attente et vérifie l'état du second fils.
S'il n'a pas fini, il le tue avec un kill, puis fait un waitpid (qui va faire le cleanup du process fils, qu'il soit zombie ou vienne d'être tué par le kill)
C'est ici kill('TERM', ...) mais si le process fils est bloqué par une attente (I/O...) ce n'est pas délivré. cf la doc perlfork  
 
Bref, tu vois le principe (pas parfait, si le second fils meurt entre le moment ou on vérifie son état et celui ou on lance un kill), tu peux adapter à tes besoins.
Les problèmes avec tout ca:
- Pas de portabilité windows, il faudra faire du code tenant compte de la valeur de $^O
- pour vérifier l'état, et transposer le ps, il faudra peut t'inspirer de cet article ci mais comme à priori les pid retournés par fork sous windows n'ont pas de rapport avec ceux qui sont dans la tasklist, heu...
- je ne sais pas comment un process zombi se transpose pour windows, a toi de tester de qu'il se passe
 
 
 
A+,


Message édité par gilou le 16-09-2013 à 01:44:53

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 16-09-2013 à 14:00:27    

je comprends pas ce que fait le premier fils. au bout de 20 secondes, il est censé se passer quoi ?
Si ma commande est pas fini, le fils 1 a fini, et il attend dans le vide ?
 
Voici ce que j'ai, mais  

Code :
  1. #!/usr/bin/perl
  2. $command = "sleep 5";
  3. my $pid;
  4. defined($pid = fork()) or die "unable to fork: $!\n";
  5. if ($pid == 0) { #child1 :  sleep
  6. $sleepTime = 2;
  7. sleep $sleepTime;
  8. print "sleep $sleepTime fini\n";
  9. exit;
  10. }
  11. else { #parent : monitoring
  12. defined($pid2 = fork()) or die "unable to fork: $!\n";
  13. if ($pid2 == 0) { #child2 : launch the process
  14.  $rc = system($command);
  15.  print "rc=$rc\n";
  16.  exit;
  17. }
  18. else {
  19.  waitpid($pid,0);
  20. #arrivé ici, le sleep a fini
  21.  $rc = system("ps -p".$pid2." 2>&1 >/dev/null" );
  22.  if($rc==0){
  23.   print "pid $pid still running\n";
  24.  }
  25.  else{
  26.   print "pid $pid not running\n";
  27.   exit;
  28.  }
  29.  print "child1 $pid a fini\n";
  30.  waitpid($pid2,0);
  31.  print "child2 $pid2 a fini\n";
  32. }
  33. }


 
PS : je ne peux pas non plus avoir de modules sur les machines unix. La raison est que le script va être déployé sur beaucoup de machines, et que je ne pourrai pas toucher au perl qui est installé (sous unix) et sous windows, je vais être limité par un perl "castré" (perl.exe / perl516.dll et libstdc++ seulement)
Si je peux avoir un module genre benchmark ou background dans un fichier séparé que j'embarquerai avec mon script pourquoi pas, mais c'est tout.
 

Reply

Marsh Posté le 16-09-2013 à 18:45:55    

Bon, je suppose que ta commande n'est pas un sleep 5, sinon ce serait totalement idiot ce script.
Je vais supposer que c'est un ls -alR
Je voyais un truc dans ce genre ci:
 

Code :
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4.  
  5. my $command = "ls -alR";
  6. my ($pid, $pid2);
  7. my $rc = 0;
  8. defined($pid = fork()) or die "unable to fork: $!\n";
  9. if ($pid == 0) {
  10.  sleep 5;
  11. } else {
  12.  defined($pid2 = fork()) or die "unable to fork: $!\n";
  13.  if ($pid2 == 0) {
  14.    $rc = exec($command);
  15.  } else {
  16.    waitpid($pid,0); # donc délai de 5 secondes avant réveil
  17.    $rc = exec("ps -p".$pid2." 2>&1 >/dev/null" );
  18.    if ($rc == 0) {
  19.      # toujours en train d'executer le ls -alR après 5 secondes
  20.      kill('TERM', $pid2);
  21.    }
  22.    waitpid($pid2,0);
  23.    $rc = 0;
  24.  }
  25. }
  26. exit $rc;


 
A+,


Message édité par gilou le 16-09-2013 à 19:23:05

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 18-09-2013 à 15:37:25    

Hello
 
Je vois à peu près le cheminement, mais si la commande dure plus de 5 secondes ?
 
Mon problème est que dès que j'appelle waitpid, le programme se bloque en attendant la fin du pid, et si je mets pas de waitpid, j'ai de sprocess defunct.
 
Pour info, je cherche à "monitorer" des taches qui peuvent prendre de quelques secondes (genre `ls`) à plusieurs heures (que je "simule" ici, avec des sleep)
Je ne veux pas killer les taches (enfin le kill ne sera qu'une option) mais seulement lever une alerte si c'est trop long.
 
Ca suppose de regarder à intervalle régulier (par ex toutes les 5 secondes, mais ca sera autour de la minute à terme) où en est le script lancé par le system(), et lever une alerte si c'est trop long (le "trop long" est une variable que je gère par ailleurs)

Reply

Marsh Posté le 18-09-2013 à 23:36:01    

Citation :

Pour info, je cherche à "monitorer" des taches qui peuvent prendre de quelques secondes (genre `ls`) à plusieurs heures (que je "simule" ici, avec des sleep)
Je ne veux pas killer les taches (enfin le kill ne sera qu'une option) mais seulement lever une alerte si c'est trop long.


Bon, la seule manière un tant soit peu portable de faire les choses me semble être la suivante: communiquer a travers un fichier temporaire (si tu veux vivre dangereusement, tu peux essayer un pipe non bloquant, et un select a 4 arguments mais ça semble risqué sur du windows, au vu de la doc).
 

Code :
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use autodie;
  5.  
  6. my $tmp = "$$.tmp";    # ouverture du fichier temporaire d'échange
  7. open(my $fh, '+>', $tmp);
  8.  
  9. my $old_fh = select($fh);  # on y positionne un flag a 0
  10. $| = 1;
  11. select($old_fh);
  12.  
  13. my $pid = fork();
  14.  
  15. if ( $pid == 0 ) {
  16.  sleep(5); # pour l'exemple, en fait ce serait ton exec($cmd); ici
  17.  
  18.  $old_fh = select($fh);  # on positionne le flag a 1 en fin de process child
  19.  $| = 1;
  20.  seek($fh, 0, 0);
  21.  print 1;
  22.  select($old_fh);
  23.  exit 0;
  24. } else {
  25.  my $data;
  26.  while(1) {
  27.    seek($fh, 0, 0);  # on teste le flag
  28.    read($fh, $data, 1);
  29.    print "$data\n"; # pour l'exemple
  30.    if ($data == 1) {
  31.      waitpid($pid, 0);
  32.      last;
  33.    }
  34.    # if délai max dépassé... faire quelque chose par exemple kill('HUP', $pid);, puis waitpid($pid, 0); puis last;
  35.  
  36.    sleep 1;  #intervalle pour tester dans la boucle si le process child est fini, a toi de voir la granularité souhaitée
  37.  }
  38.  close($fh);
  39.  unlink $tmp;  # être sur que le child est bien mort a ce stade, afin qu'il n'essaye pas d'écrire dans le fichier en cours de suppression
  40. }


 
si tu étais limité a de l'Unix, être averti de la fin du process child en positionnant une routine $SIG{'CHLD'} fonctionne, mais ce n'est pas le cas avec Windows, au vu de mes tests.
Bref, ton pb, c'est que tu veux utiliser des fonctionalités Unixiennes sans utiliser les modules qui sont justement la pour ça (émuler les trucs proprement Unix sur d'autres plates formes).  
A+,


Message édité par gilou le 19-09-2013 à 12:09:40

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 18-09-2013 à 23:36:01   

Reply

Marsh Posté le 19-09-2013 à 21:35:18    

Hello
 
j'ai pas eu le temps de tester cette version.
 
En revanche, j'ai testé l'autre version sous windows... Ca ne marche pas du tout, et ca va être très compliqué à faire marcher (le fork donne des threads au lieu de donner des process, aucune commande build-in de windows ne permet de suivre ca; j'ai seulement trouvé pslist, mais impossible de le faire macher correctement)
 
Donc je pense que je vais partir sur une autre solution sous windows, ce qui me permet de ne plus penser à ca pour ma version unix, et donc d'utiliser des méthodes plus "conventionnelles". (mais je reste quand même dans l'impossibilité d'utiliser des modules qui ne sont pas dans le core de perl :( )
 

Reply

Marsh Posté le 20-09-2013 à 00:33:48    

Dans le monde unix, un child qui termine envoie un signal CHLD (qui interrompt un sleep du pere) et on peut associer lui un handler de signal qui va positionner une flag.
$SIG{'CHLD'}=\&reaper;   sub reaper { ... $flag = 1; ... }
flag qui peut être par checké par le pere pour savoir si c'est une fin de délai ou la fin du process child qui l'a sorti de son sleep.
Comme c'est pas supporté sous windows, il m'a fallu chercher un autre moyen.
 

Citation :

En revanche, j'ai testé l'autre version sous windows... Ca ne marche pas du tout, et ca va être très compliqué à faire marcher (le fork donne des threads au lieu de donner des process, aucune commande build-in de windows ne permet de suivre ca; j'ai seulement trouvé pslist, mais impossible de le faire macher correctement)

C'est pour cela que je t'ai donné une version portable quoique pas optimale, puisqu'elle nécessite de l'IO disque pour communiquer entre le fils et son père.
J'ai fait un essai avec des pipes ce soir car ça améliorerait grandement l'efficacité vu qu'on n'aurait plus d'IO disque mais juste un buffer en mémoire, mais pas de bol, pas moyen d'avoir un read non bloquant sur un pipe standard perl sous windows .
 
A+,


Message édité par gilou le 20-09-2013 à 09:05:43

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 26-09-2013 à 14:47:05    

Hello
 
J'ai pu avancer un peu sur le sujet (pas sur la version multiplateforme, je me concentre sur l'unix pour l'instant)
 

Code :
  1. $SIG{INT} = sub { printlog("Script is done\n" );exit; };
  2. my $parent_pid = $$;
  3. my $pid = fork();
  4. if ($pid == 0) { #child : launch the process
  5.      $rc = system($cmd);
  6.      $rc = $rc >>= 8;
  7.    
  8.      if ($rc > 127) {$rc -= 256;}
  9.      printlog("Job done. rc=$rc\n" );
  10.      kill INT => $parent_pid;
  11.      exit;
  12. }
  13. elsif($pid>0) { #parent : monitoring
  14.      $time               = 0;
  15.      $sleepTime          = 60;
  16.      while(1) {
  17.           eval {
  18.                $out = `ps -p$pid | grep $pid `;
  19.              
  20.                if($out!="" ) {
  21.                     printlog("pid $pid still running after $time minutes\n" );
  22.                }
  23.                else {
  24.                     printlog("pid $pid not running after $time minutes\n" );
  25.                }
  26.                    
  27.                exit;
  28.           }
  29.           };
  30.           if($@) {
  31.                  exit;
  32.              }
  33.          
  34.           $time+=($sleepTime/60);
  35.           sleep $sleepTime;
  36.      }
  37. }
  38. else {
  39.      printlog("Error : unable to fork." );
  40. }


 
(la fonction printlog ne fait que du print et log dans un fichier. peu importe)
 
Tout ceci fonctionne pas trop mal :)
 
Une autre question : si (en dehors du script) on kill le process (identifié par $cmd ici), le system() renvoie 0, comme si le process était fini correctement (alors qu'il a été killé)
 
Est ce qu'il y a un moyen de distinguer le process killé de la fin normale ?

Reply

Marsh Posté le 10-01-2014 à 15:38:59    

Hello

 

J'ai repris mon travail là dessus, et j'ai obtenu une version fonctionnelle : (j'ai simplifié mon code pour ne montrer que le squelette... il se peut que certaines variables soient mal définies... mais le concept est là)

 
Code :
  1. #!/usr/bin/perl
  2. use warnings;                # because
  3. use strict;                    # because... because
  4. use POSIX ":sys_wait_h";    # use for the kill functions 'TERM','KILL', etc
  5.  
  6.  
  7. #use sigtrap 'handler' => \&reload, 'HUP';
  8. use sigtrap 'handler' => \&cleanAndExit, 'INT', 'ABRT', 'QUIT', 'TERM';
  9.  
  10. my $std_out_file = "/tmp/out.txt";
  11. my $std_err_file = "/tmp/err.txt";
  12.  
  13. my $rc;
  14. my $command = "sleep 10";
  15.  
  16. #if run time < min_time : message
  17. #if run time > max_time : message (let process run)
  18. #if run time > kill time : kill the process+message
  19. my($min_time,$max_time,$kill_time) = (12,15,18);
  20.  
  21. my $i=0;
  22.  
  23. my $pid = fork();
  24.  
  25. if ($pid == 0) { #child : launch the process
  26.     my $cmd = $command." >$std_out_file 2>$std_err_file";
  27.     exec($cmd);
  28. }
  29. elsif($pid>0) { #parent : monitoring
  30.     my $max_alarm_sent    = 0;
  31.     while(1) {
  32.         my $child = waitpid($pid, WNOHANG);
  33.         
  34.         if ($? == -1 and $child==0) {#job is still running
  35.             printLog("Process still running after $i seconds" );
  36.             if($i>$max_time and $max_alarm_sent==0) {
  37.                 printLog("MAX_TIME : running after i seconds" );
  38.                 $max_alarm_sent=1;
  39.             }
  40.             if($i>=$kill_time) {
  41.                 printLog("KILL_TIME : process is too long. kill it" );
  42.                 kill -9,$pid;
  43.                 exit 1;
  44.             }
  45.         }
  46.         elsif ($? & 127) { # job was killed externally
  47.             my $signal = $? & 127;
  48.             my $core = ($? & 128) ? 'with' : 'without';
  49.             printLog("Process died with signal $signal, $core coredump" );
  50.             
  51.             if($i<$min_time) {
  52.                 printLog("MIN_TIME : job is too short. min is $min_time" );
  53.             }
  54.  
  55.             exit 1;
  56.         }
  57.         elsif($child==$pid) {# job is finished
  58.             $rc = $?;
  59.             $rc = $rc >> 8;
  60.             
  61.             printLog("Job done. rc=$rc" );
  62.             
  63.             if($i<$min_time) {
  64.                 printLog("MIN_TIME : job is too short. min is $min_time" );
  65.             }
  66.             
  67.             exit 0;
  68.         }
  69.         sleep 1;
  70.         $i++;
  71.     }
  72. }
  73. else {
  74.     printLog("Error : unable to fork." );
  75. }
  76.  
  77. # this method will be called if the followng signals are given to your pid
  78. # kill -INT  |  kill -ABRT  |  kill -QUIT  |  kill -TERM
  79. sub cleanAndExit() {
  80.    printLog("Caught a kill signal, cleaning up and exiting" );
  81.     
  82.     my $out_pid    = defined($pid)    ? $pid : $$;
  83.     kill -9 , $out_pid if($out_pid!=$$);
  84.  
  85.    exit(1);
  86. }
 

maintenant, je dois faire une version windows... je pense que je vais ouvrir un autre thread... :)


Message édité par nabbo le 10-01-2014 à 15:46:04
Reply

Sujets relatifs:

Leave a Replay

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