Thread Konsolenanwendung starten und Ausgabe auslesen (4 answers)
Opened by TheMic at 2011-07-06 11:04

topeg
 2011-07-07 02:43
#150204 #150204
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Wenn du einen Prozess forkst bekommst du zwei unabhängige Prozesse, die keinerlei Variablen miteinander teilen. Du kannst also nicht in einem Prozess in $output schreiben und hoffen, das das Ergebnis im anderen Prozess ankommt.
Außerdem wartet waitpid darauf, das ein Prozess sich selber beendet. Willst du es erzwingen musst du kill nutzen. Das würde in deinem Beispiel auch nicht unbedingt zu einem Ergebnis führen, da ein über qx gestarteter Kindprozess weiter laufen kann auch wenn der Elternprozess beendet wurde.

Hier ein paar Beispiele wie du das machen kannst:

Am einfachsten ist es mit CPAN:IPC::Run:
more (4.6kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

#!/usr/bin/perl
use strict;
use warnings;
use IPC::Run qw( run timeout );

my $timeout=5;
my $output='';
my @cmd=('perl', '-e', 'for(0..3){print qq(TEST $_\n); warn(qq(TTTT $_\n)); sleep(1); }');

eval{ run(\@cmd, \undef, \$output, '2>&1', timeout( $timeout )); };

if($@)
{
  warn("PROCESS KILLED!\n");
  $output='';
}

if($output)
{
  print "OUTPUT:\n";
  print $output;
}
else
{
  print "NO OUTPUT!\n";
}


Oder über open:
more (7.2kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

#!/usr/bin/perl
use strict;
use warnings;
use POSIX ":sys_wait_h";

my $timeout=5;
my $output='';

my $cmd=q!perl -e 'for(0..3){print qq(TEST $_\n); warn(qq(TTTT $_\n)); sleep(1); }'!;

my $pid=0;
eval{
  local $/=undef;
  local $SIG{ALRM}=sub{
      kill(9,$pid) if($pid && waitpid($pid, WNOHANG) == 0);
      die("TIMEOUT ($timeout)\n");
    };

  $pid=open(my $ph, '-|', $cmd) or die("ERROR START $cmd ($!)\n");
  alarm($timeout);
  $output=<$ph>;
  alarm(0);
  close($ph) or die("ERROR END $cmd ($!)\n");
};

if($@)
{
  warn("PROCESS KILLED!\n$@");
  $output='';
}

if($output)
{
  print "OUTPUT:\n";
  print $output;
}
else
{
  print "NO OUTPUT!\n";
}


oder über eine temporäre Datei:
more (14.3kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

#!/usr/bin/perl
use strict;
use warnings;
use File::Temp ':POSIX';
use POSIX ':sys_wait_h';

my $timeout = 5;
my @cmd=('perl', '-e', 'for(0..2){print qq(TEST $_\n); warn(qq(TTTT $_\n)); sleep(1); }');

my $tempfile = tmpnam();
my $output='';

die("ERROR create tempfile") unless($tempfile);

# split in two independent processes
my $pid = fork();

# fork failed!
die('Fork failed!') unless(defined($pid));

if($pid)
{
  # main process!

  my $time=time()+$timeout;
  # wait timeout seconds
  while($time > time())
  {
    # is process running?
    if(waitpid($pid, WNOHANG) == 0)
    {
      # wait 0.3 seconds
      select(undef,undef,undef,0.3);
      # or do something else
      # ...
    }
    else
    {
      # exit while loop
      last();
    }
  }

  # process running?
  if(waitpid($pid, WNOHANG)==0)
  {
    print "TIMEOUT KILL PROCESS\n";
    # force exit (softly)
    kill(9, $pid);
    $output='';
    unlink($tempfile);
  }
  else
  {
    # read written tempfile:
    if(open(my $fh, '<', $tempfile))
    {
      local $/=undef;
      $output=<$fh>;
      close($fh);
      if( !unlink($tempfile) )
      { warn("CAN'T REMOVE $tempfile ($!)\n"); }
    }
    else
    { warn("CAN'T OPEN $tempfile ($!)\n"); }
  }
}
else
{
  # forked process!

  # reopen STDOUT STDERR
  open(STDOUT, '>', $tempfile) or die("ERROR open $tempfile ($!)");
  open(STDERR, ">&STDOUT");

  # start programm with actual process id
  exec(@cmd);

  # error???
  die("EXEC Failed! ($!)");
}

if($output)
{
  print "OUTPUT:\n";
  print $output;
}
else
{
  print "NO OUTPUT!\n";
}



Man kann anstatt einer temporären Datei auch eine Pipe nutzen. Da ist es aber einfacher CPAN:IPC::Run zu nutzen. Das macht es intern so, ist aber System unabhängig programmiert (Windows macht Probleme bei Pipes).

EDIT:
Hier mit einer Pipe:
more (13.2kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

#!/usr/bin/perl
use strict;
use warnings;
use IO::Pipe;
use POSIX qw(:sys_wait_h);

my $timeout = 5;
my @cmd=('perl', '-e', '$|=1; for(0..2){print qq(TEST $_\n); warn(qq(TTTT $_\n)); sleep(1); }');

my $output='';

# create pipe
my $pipe = IO::Pipe->new();

# split in two independent processes
my $pid = fork();

# fork failed!
die('Fork failed!') unless(defined($pid));

if($pid)
{
  # main process!
  $pipe->reader();
  $pipe->blocking(0);

  my $time=time()+$timeout;

  # wait timeout seconds
  while($time > time())
  {
    # is process running?
    if(waitpid($pid, WNOHANG) == 0)
    {

      # read all aviable
      if(my @data=<$pipe>)
      { $output.=join('',@data); }

      # do something else
      print "WAIT\n";
      select(undef,undef,undef,0.3);
      # ...
    }
    else
    {
      # exit while loop
      last();
    }
  }

  # process running?
  if(waitpid($pid, WNOHANG)==0)
  {
    print "TIMEOUT KILL PROCESS\n";
    # force exit (softly)
    kill(9, $pid);
    $output='';
  }
}
else
{
  # forked process!

  $pipe->writer();
  $pipe->autoflush(1);

  # reopen STDOUT and STDERR
  open(STDOUT, ">&", $pipe);
  open(STDERR, ">&STDOUT");
  close($pipe);

  # start programm with actual process id
  exec(@cmd);

  # error???
  die("EXEC Failed! ($!)");
}

if($output)
{
  print "OUTPUT:\n";
  print $output;
}
else
{
  print "NO OUTPUT!\n";
}

Das Problem ist, das manche Programme darauf achten ob STDOUT ein Terminal ist. Wenn dem nicht so ist kann die Ausgabe verloren gehen, da sie gepuffert wird.
Mit einem virtuellem Terminal umgeht man das Problem.
Hier ein Beispiel mit CPAN:IO::Pty als virtuelles Terminal:
more (13.7kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

#!/usr/bin/perl
use strict;
use warnings;
use IO::Pty;
use IO::Select;
use POSIX qw(:sys_wait_h);
use Data::Dumper;

my $timeout = 5;
my @cmd=('perl', '-e', 'for(0..2){print qq(TEST $_\n); warn(qq(TTTT $_\n)); sleep(1); }');

my $output='';

# create virtal terminal
# imortant for applications with terminal detection!
my $pty = IO::Pty->new();

# split in two independent processes
my $pid = fork();

# fork failed!
die('Fork failed!') unless(defined($pid));

if($pid)
{
  # main process!

  my $select = IO::Select->new($pty);

  my $time=time()+$timeout;

  # wait timeout seconds
  while($time > time())
  {
    # is process running?
    if(waitpid($pid, WNOHANG) == 0)
    {
      # read if possible
      $output.=<$pty> if($select->can_read(1));

      # do something else
      print "WAIT\n";
      # ...
    }
    else
    {
      # exit while loop
      last();
    }
  }

  # process running?
  if(waitpid($pid, WNOHANG)==0)
  {
    print "TIMEOUT KILL PROCESS\n";
    # force exit (softly)
    kill(9, $pid);
    $output='';
  }
}
else
{
  # forked process!

  # virtual terminal client
  my $slave = $pty->slave();
  close $pty;
  $slave->clone_winsize_from(\*STDIN);
  $slave->set_raw();

  # reopen STDOUT and STDERR
  open(STDOUT, ">&", $slave);
  open(STDERR, ">&STDOUT");
  close($slave);

  # start programm with actual process id
  exec(@cmd);

  # error???
  die("EXEC Failed! ($!)");
}

if($output)
{
  print "OUTPUT:\n";
  print $output;
}
else
{
  print "NO OUTPUT!\n";
}

Last edited: 2011-07-07 05:50:26 +0200 (CEST)

View full thread Konsolenanwendung starten und Ausgabe auslesen