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 :

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 ?

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

 
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 ?

Non!!

 
typiquement, pour avoir le code retour:

#!/usr/bin/perl
 
my $cmd = "sleep 20";
my $pid = fork();
die "Can't fork() : $!\n" unless defined $pid;
 
if ($pid) {
  if (waitpid($pid, 0) != -1) {
    my ($rc, $sig, $core) = ($? >> 8, $? & 127, $? & 128);
    if ($core) {
      print "$pid dumped core\n";
    } elsif ($sig == 9) {
      print "$pid was murdered!\n";
    } else {
      print "$pid returned $rc";
      print ($sig?" after receiving signal $sig":"\n" );
    }
  } else {
    print "$pid... um... disappeared...\n";
  }
} else {
  my $rc = exec($cmd);
  exit $rc;
}

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

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 )

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+,

 
 
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+,

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  

 
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.
 

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:
 

#!/usr/bin/perl
use strict;
use warnings;
 
my $command = "ls -alR";
my ($pid, $pid2);
my $rc = 0;
defined($pid = fork()) or die "unable to fork: $!\n";
if ($pid == 0) {
  sleep 5;
} else {
  defined($pid2 = fork()) or die "unable to fork: $!\n";
  if ($pid2 == 0) {
    $rc = exec($command);
  } else {
    waitpid($pid,0); # donc délai de 5 secondes avant réveil
    $rc = exec("ps -p".$pid2." 2>&1 >/dev/null" );
    if ($rc == 0) {
      # toujours en train d'executer le ls -alR après 5 secondes
      kill('TERM', $pid2);
    }
    waitpid($pid2,0);
    $rc = 0;
  }
}
exit $rc;

 
A+,

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)

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).
 

#!/usr/bin/perl
use strict;
use warnings;
use autodie; 
 
my $tmp = "$$.tmp";    # ouverture du fichier temporaire d'échange
open(my $fh, '+>', $tmp);
 
my $old_fh = select($fh);  # on y positionne un flag a 0
$| = 1;
print 0;
select($old_fh);
 
my $pid = fork();
 
if ( $pid == 0 ) {
  sleep(5); # pour l'exemple, en fait ce serait ton exec($cmd); ici
 
  $old_fh = select($fh);  # on positionne le flag a 1 en fin de process child
  $| = 1;
  seek($fh, 0, 0);
  print 1;
  select($old_fh);
  exit 0;
} else {
  my $data;
  while(1) {
    seek($fh, 0, 0);  # on teste le flag
    read($fh, $data, 1);
    print "$data\n"; # pour l'exemple
    if ($data == 1) {
      waitpid($pid, 0);
      last;
    }
    # if délai max dépassé... faire quelque chose par exemple kill('HUP', $pid);, puis waitpid($pid, 0); puis last;
 
    sleep 1;  #intervalle pour tester dans la boucle si le process child est fini, a toi de voir la granularité souhaitée
  }
  close($fh);
  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
}

 
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+,

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 )
 

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.
 

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+,

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

 
(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 ?

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à)

#!/usr/bin/perl
use warnings;                # because 
use strict;                    # because... because
use POSIX ":sys_wait_h";    # use for the kill functions 'TERM','KILL', etc
 
 
#use sigtrap 'handler' => \&reload, 'HUP';
use sigtrap 'handler' => \&cleanAndExit, 'INT', 'ABRT', 'QUIT', 'TERM';
 
my $std_out_file = "/tmp/out.txt";
my $std_err_file = "/tmp/err.txt";
 
my $rc;
my $command = "sleep 10";
 
#if run time < min_time : message
#if run time > max_time : message (let process run)
#if run time > kill time : kill the process+message
my($min_time,$max_time,$kill_time) = (12,15,18); 
 
my $i=0;
 
my $pid = fork();
 
if ($pid == 0) { #child : launch the process
    my $cmd = $command." >$std_out_file 2>$std_err_file";
    exec($cmd);
}
elsif($pid>0) { #parent : monitoring
    my $max_alarm_sent    = 0;
    while(1) {
        my $child = waitpid($pid, WNOHANG); 
        
        if ($? == -1 and $child==0) {#job is still running
            printLog("Process still running after $i seconds" );
            if($i>$max_time and $max_alarm_sent==0) {
                printLog("MAX_TIME : running after i seconds" );
                $max_alarm_sent=1;
            }
            if($i>=$kill_time) {
                printLog("KILL_TIME : process is too long. kill it" );
                kill -9,$pid;
                exit 1;
            }
        }
        elsif ($? & 127) { # job was killed externally
            my $signal = $? & 127;
            my $core = ($? & 128) ? 'with' : 'without';
            printLog("Process died with signal $signal, $core coredump" );
            
            if($i<$min_time) {
                printLog("MIN_TIME : job is too short. min is $min_time" );
            }
 
            exit 1;
        }
        elsif($child==$pid) {# job is finished
            $rc = $?;
            $rc = $rc >> 8;
            
            printLog("Job done. rc=$rc" );
            
            if($i<$min_time) {
                printLog("MIN_TIME : job is too short. min is $min_time" );
            }
            
            exit 0;
        }
        sleep 1;
        $i++;
    }
}
else {
    printLog("Error : unable to fork." );
}
 
# this method will be called if the followng signals are given to your pid
# kill -INT  |  kill -ABRT  |  kill -QUIT  |  kill -TERM
sub cleanAndExit() {
    printLog("Caught a kill signal, cleaning up and exiting" );
    
    my $out_pid    = defined($pid)    ? $pid : $$;
    kill -9 , $out_pid if($out_pid!=$$);
 
    exit(1);
}

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