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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
patches to this version of Expect.
-------------------------------------------------------------
From: Eric Anderson <ea-79HwFubIn1@cello.hpl.hp.com>
diff -c -r libexpect-perl-1.15-orig/Expect.pm libexpect-perl-1.15/Expect.pm
*** libexpect-perl-1.15-orig/Expect.pm Wed Apr 27 09:13:08 2005
--- libexpect-perl-1.15/Expect.pm Wed Apr 27 09:14:45 2005
***************
*** 1256,1262 ****
# .01 sec granularity should work. If we miss something it will
# probably get flushed later, maybe in an expect call.
while (select($rmask,undef,undef,.01)) {
! sysread($self,${*$self}{exp_Pty_Buffer},1024);
# Is this necessary to keep? Probably.. #
# if you need to expect it later.
${*$self}{exp_Accum}.= ${*$self}{exp_Pty_Buffer};
--- 1256,1263 ----
# .01 sec granularity should work. If we miss something it will
# probably get flushed later, maybe in an expect call.
while (select($rmask,undef,undef,.01)) {
! my $amt = sysread($self,${*$self}{exp_Pty_Buffer},1024);
! last unless defined $amt && $amt > 0; # subprocess went away
# Is this necessary to keep? Probably.. #
# if you need to expect it later.
${*$self}{exp_Accum}.= ${*$self}{exp_Pty_Buffer};
-------------------------------------------------------------
From: Andrew Suffield <asuffield@debian.org>
--- Expect.pm~ 2002-09-03 10:55:49.000000000 +0100
+++ Expect.pm 2002-09-03 12:36:59.000000000 +0100
@@ -178,6 +178,7 @@
# All the functions are written for reading from a tty, so if the naming
# scheme looks odd, that's why.
my ($class) = shift;
+ $class = ref($class) if ref($class); # so we can be called as $exp->exp_init()
my($self) = shift;
bless $self, $class;
croak "exp_init not passed a file object, stopped"
-------------------------------------------------------------
From: Andrew Suffield <asuffield@debian.org>
aps100@cyclone:~$ cat foo.pl
use strict;
use warnings;
use Expect;
my $exp =3D spawn Expect "cat";
exit 0;
aps100@cyclone:~$ perl foo.pl
aps100@cyclone:~$ echo $?
1
What is happening is that the DESTROY sub for Expect calls soft_close
or hard_close, which in turn will call waitpid. waitpid places the
exit code of the child that was reaped into $?. When exit has been
called, $? contains the value the process will ultimately exit with.
The practical result is that allowing any Expect objects to persist
and only be garbage-collected at the end of the script, will cause the
exit code of the script to be randomly altered.
The solution is to modify sub DESTROY so that it preserves $?.
--- Expect.pm.old 2002-09-14 12:10:13.000000000 +0100
+++ Expect.pm 2002-09-14 12:10:45.000000000 +0100
@@ -1575,10 +1575,12 @@
# clean up child processes
sub DESTROY {
my $self = shift;
+ my $exit = $?;
if (${*$self}{exp_Do_Soft_Close}) {
$self->soft_close();
}
$self->hard_close();
+ $? = $exit;
}
1;
-------------------------------------------------------------
From: Andrew Suffield <asuffield@debian.org>
soft_close and hard_close will loop waiting for the slave process to
terminate. In order to keep the loop nice (prevent it consuming all
available processing power) they contain "sleep 1" statements.
Unfortunately, due to the slow speed at which signals are handled, the
first loop will inevitably miss and so the process sleeps for a second
- much longer than was necessary.
The simplest solution is to use select and 0.01 seconds, which should
be a more reasonable delay (it's still a very long time in processing
terms - any non-zero delay is actually enough, with normal scheduling
algorithms).
--- Expect.pm.old 2002-09-15 22:57:44.000000000 +0100
+++ Expect.pm 2002-09-15 22:58:15.000000000 +0100
@@ -1356,7 +1356,7 @@
${*$self}{exp_Exit} =3D $?;
return ${*$self}{exp_Exit};
}
- sleep 1; # Keep loop nice.
+ select undef, undef, undef, 0.01;
}
# Send it a term if it isn't dead.
if (${*$self}{exp_Debug}) {
@@ -1377,7 +1377,7 @@
${*$self}{exp_Exit} =3D $?;
return $?;
}
- sleep 1;
+ select undef, undef, undef, 0.01;
}
# Since this is a 'soft' close, sending it a -9 would be inappropriate.
return undef;
@@ -1411,7 +1411,7 @@
${*$self}{exp_Exit} =3D $?;
return ${*$self}{exp_Exit};
}
- sleep 1; # Keep loop nice.
+ select undef, undef, undef, 0.01;
}
# Send it a term if it isn't dead.
if (${*$self}{exp_Debug}) {
@@ -1432,7 +1432,7 @@
${*$self}{exp_Exit} =3D $?;
return ${*$self}{exp_Exit};
}
- sleep 1;
+ select undef, undef, undef, 0.01;
}
kill KILL =3D> ${*$self}{exp_Pid};
# wait 5 more seconds for it to die.
@@ -1449,7 +1449,7 @@
${*$self}{exp_Exit} =3D $?;
return ${*$self}{exp_Exit};
}
- sleep 1;
+ select undef, undef, undef, 0.01;
}
warn "Pid ${*$self}{exp_Pid} of ${*$self}{exp_Pty_Handle} is HUNG.\r\n";
${*$self}{exp_Pid} =3D undef;
|
