line |
stmt |
code |
1
|
|
# Copyright 2016-2020 SUSE LLC |
2
|
|
# SPDX-License-Identifier: GPL-2.0-or-later |
3
|
|
|
4
|
|
use Mojo::Base -strict, -signatures; |
5
|
11
|
use integer; |
|
11
|
|
|
11
|
|
6
|
11
|
|
|
11
|
|
|
11
|
|
7
|
|
use English -no_match_vars; |
8
|
11
|
use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); |
|
11
|
|
|
11
|
|
9
|
11
|
use Carp 'croak'; |
|
11
|
|
|
11
|
|
10
|
11
|
|
|
11
|
|
|
11
|
|
11
|
|
our $VERSION; |
12
|
|
|
13
|
|
my $self = ref($class) ne '' && $class->isa('consoles::serial_screen') ? $class : bless {class => $class}, $class; |
14
|
8
|
$self->{fd_read} = $fd_read; |
|
8
|
|
|
8
|
|
|
8
|
|
|
8
|
|
15
|
8
|
$self->{fd_write} = $fd_write // $fd_read; |
16
|
8
|
$self->{carry_buffer} = ''; |
17
|
8
|
|
18
|
8
|
return $self; |
19
|
|
} |
20
|
8
|
|
21
|
|
my $trying_to_use_keys = <<'FIN.'; |
22
|
|
Virtio terminal and svirt serial terminal do not support send_key. Use |
23
|
|
type_string (possibly with an ANSI/XTERM escape sequence), or switch to a |
24
|
|
console which sends key presses, not terminal codes. |
25
|
|
FIN. |
26
|
|
|
27
|
|
=head2 send_key |
28
|
|
|
29
|
|
send_key(key => 'ret'); |
30
|
|
|
31
|
|
This is mostly redundant for the time being, use C<type_string> instead. Many |
32
|
|
testapi functions use C<send_key('ret')> however so that particular case has |
33
|
|
been implemented. In the future this could be extended to provide more key |
34
|
|
name to terminal code mappings. |
35
|
|
|
36
|
|
=cut |
37
|
|
croak $trying_to_use_keys unless $nargs->{key} eq 'ret'; |
38
|
|
$nargs->{text} = "\n"; |
39
|
2
|
$self->type_string($nargs); |
|
2
|
|
|
2
|
|
|
2
|
|
40
|
2
|
} |
41
|
1
|
|
42
|
1
|
|
43
|
|
|
44
|
|
=head2 type_string |
45
|
1
|
|
|
0
|
|
|
0
|
|
|
0
|
|
|
0
|
|
46
|
|
type_string($self, $message, terminate_with => ''); |
47
|
1
|
|
|
0
|
|
|
0
|
|
|
0
|
|
|
0
|
|
48
|
|
Writes C<$message> to the socket which the guest's terminal is listening on. |
49
|
|
Unlike VNC based consoles we just send the bytes making up C<$message>, not a |
50
|
|
series of keystrokes. This is much faster, but means that special key |
51
|
|
combinations like Ctrl-Alt-Del or SysRq[1] may not be possible. However most |
52
|
|
terminals do support many escape sequences for scrolling and performing |
53
|
|
various actions other than entering text. See C0, C1, ANSI, VT100 and XTERM |
54
|
|
escape codes. |
55
|
|
|
56
|
|
The optional terminate_with argument can be set to EOT (End Of Transmission), |
57
|
|
ETX (End Of Text). Sending EOT should have the same effect as pressing Ctrl-D |
58
|
|
and ETX is the same as pressing Ctrl-C on a terminal. |
59
|
|
|
60
|
|
[1] It appears sending 0x0f will press the SysRq key down on hvc based |
61
|
|
consoles. |
62
|
|
|
63
|
|
=cut |
64
|
|
my $fd = $self->{fd_write}; |
65
|
|
|
66
|
|
bmwqemu::log_call(%$nargs, $nargs->{secret} ? (-masked => $nargs->{text}) : ()); |
67
|
|
|
68
|
|
my $text = $nargs->{text}; |
69
|
13
|
my $term; |
|
13
|
|
|
13
|
|
|
13
|
|
70
|
13
|
for ($nargs->{terminate_with} || '') { |
71
|
|
if (/^ETX$/) { $term = "\cC"; } #^C, Ctrl-c, End Of Text |
72
|
13
|
elsif (/^EOT$/) { $term = "\cD"; } #^D, Ctrl-d, End Of Transmission |
73
|
|
} |
74
|
13
|
|
75
|
13
|
$text .= $term if defined $term; |
76
|
13
|
my $written = syswrite $fd, $text; |
77
|
13
|
croak "Error writing to virtio/svirt serial terminal: $ERRNO" unless defined $written; |
|
1
|
|
78
|
1
|
croak "Was not able to write entire message to virtio/svirt serial terminal. Only $written of $nargs->{text}" if $written < length($text); |
79
|
|
} |
80
|
|
|
81
|
13
|
|
82
|
13
|
no integer; |
83
|
13
|
return thetime() - $start; |
84
|
13
|
} |
85
|
|
|
86
|
|
no integer; |
87
|
3023
|
return $timeout - elapsed($start); |
|
3023
|
|
|
3023
|
|
88
|
|
} |
89
|
2994
|
|
|
2994
|
|
|
2994
|
|
90
|
11
|
# If $pattern is an array of regexes combine them into a single one. |
|
11
|
|
|
11
|
|
91
|
2994
|
# If $pattern is a single string, wrap it in an array. |
92
|
|
# Otherwise leave as is. |
93
|
|
if (ref $pattern eq 'ARRAY' && !$no_regex) { |
94
|
1481
|
my $re = join "|", map { "($_)" } @$pattern; |
|
1481
|
|
|
1481
|
|
|
1481
|
|
95
|
11
|
return qr{$re}; |
|
11
|
|
|
11
|
|
96
|
1481
|
} |
97
|
|
|
98
|
|
return $no_regex && ref $pattern ne 'ARRAY' ? [$pattern] : $pattern; |
99
|
|
} |
100
|
|
|
101
|
|
=head2 do_read |
102
|
17
|
|
|
17
|
|
|
17
|
|
|
17
|
|
103
|
17
|
my $num_read = do_read($buffer [, max_size => 2048][,timeout => undef]); |
104
|
1
|
|
|
2
|
|
105
|
1
|
Attempts to read up to max_size bytes from C<<$self->{fd_read}>> into a |
106
|
|
buffer. The method returns as soon as some data is available, even if the |
107
|
|
given size has not been reached. Returns the number of bytes read or undef on |
108
|
16
|
timeout. Note that 0 is a valid return code. If a failure occurs the method |
109
|
|
will croak. |
110
|
|
|
111
|
|
An undefined timeout will cause to wait indefinitely. A timeout of 0 means to |
112
|
|
just read once. |
113
|
|
|
114
|
|
=cut |
115
|
|
my $buffer = ''; |
116
|
|
$args{timeout} //= undef; # wait till data is available |
117
|
|
$args{max_size} //= 2048; |
118
|
|
my $fd = $self->{fd_read}; |
119
|
|
|
120
|
|
my $rin = ''; |
121
|
|
vec($rin, fileno($fd), 1) = 1; |
122
|
|
my $nfound = select(my $rout = $rin, undef, my $eout = $rin, $args{timeout}); |
123
|
|
croak "Failed to select socket for reading: $ERRNO" if $nfound < 0; |
124
|
|
return undef if $nfound == 0; |
125
|
1476
|
|
|
1476
|
|
|
1476
|
|
|
1476
|
|
126
|
1476
|
my $read; |
127
|
1476
|
while (!defined($read)) { |
128
|
1476
|
$read = sysread($fd, $buffer, $args{max_size}); |
129
|
1476
|
croak "Failed to read from virtio/svirt serial console char device: $ERRNO" if !defined($read) && !($ERRNO{EAGAIN} || $ERRNO{EWOULDBLOCK}); |
130
|
|
} |
131
|
1476
|
$_[1] = $buffer; |
132
|
1476
|
return $read; |
133
|
1476
|
} |
134
|
1476
|
|
135
|
1476
|
=head2 read_until |
136
|
|
|
137
|
1475
|
read_until($self, $pattern, $timeout, [ |
138
|
1475
|
buffer_size => 4096, record_output => 0, exclude_match => 0, |
139
|
1475
|
no_regex => 0 |
140
|
1475
|
]); |
141
|
|
|
142
|
1475
|
Monitor the virtio/svirt serial console socket C<$file_descriptor> for a |
143
|
1475
|
character sequence which matches C<$pattern>. Bytes are read from the socket |
144
|
|
in up to C<$buffer_size/2> chunks and each chunk is added to a ring buffer |
145
|
|
which is C<$buffer_size> long. The regular expression is tested against the |
146
|
|
ring buffer after each read operation. Note, the reason we are using a ring |
147
|
|
buffer is to avoid matches failing because the matching text is split between |
148
|
|
two reads. |
149
|
|
|
150
|
|
If C<$record_output> is set then all data from the socket is stored in a |
151
|
|
separate string and returned. Otherwise just the contents of the ring buffer |
152
|
|
will be returned. |
153
|
|
|
154
|
|
Setting C<$exclude_match> removes the matched string from the returned string. |
155
|
|
|
156
|
|
Data which was read after a matching set of characters is saved to a carry |
157
|
|
buffer and used in the next call to read_until (unless the console is reset). |
158
|
|
If the match fails the whole ring buffer is carried over to the next call. |
159
|
|
|
160
|
|
Setting C<$no_regex> will cause it to do a plain string search using |
161
|
|
C<index()>. |
162
|
|
|
163
|
|
Returns a map reference like |
164
|
|
C<{ matched => 1, string => 'text from the terminal' }> |
165
|
|
on success and |
166
|
|
C<{ matched => 0, string => 'text from the terminal' }> |
167
|
|
on failure. |
168
|
|
|
169
|
|
=cut |
170
|
|
my $fd = $self->{fd_read}; |
171
|
|
my $buflen = $nargs{buffer_size} || 4096; |
172
|
|
my $overflow = $nargs{record_output} ? '' : undef; |
173
|
|
my $sttime = thetime(); |
174
|
|
my ($rbuf, $buf) = ($self->{carry_buffer}, ''); |
175
|
|
my $loops = 0; |
176
|
|
my ($prematch, $match); |
177
|
|
|
178
|
|
my $re = normalise_pattern($pattern, $nargs{no_regex}); |
179
|
|
|
180
|
|
$nargs{pattern} = $re; |
181
|
17
|
$nargs{timeout} = $timeout; |
|
17
|
|
|
17
|
|
|
17
|
|
|
17
|
|
|
17
|
|
182
|
17
|
bmwqemu::log_call(%nargs); |
183
|
17
|
|
184
|
17
|
READ: while (1) { |
185
|
17
|
$loops++; |
186
|
17
|
|
187
|
17
|
# Search ring buffer for a match and exit if we find it |
188
|
17
|
if ($nargs{no_regex}) { |
189
|
|
for my $p (@$re) { |
190
|
17
|
my $i = index($rbuf, $p); |
191
|
|
if ($i >= 0) { |
192
|
17
|
$match = substr $rbuf, $i, length($p); |
193
|
17
|
$prematch = substr $rbuf, 0, $i; |
194
|
17
|
$self->{carry_buffer} = substr $rbuf, $i + length($p); |
195
|
|
last READ; |
196
|
17
|
} |
197
|
1498
|
} |
198
|
|
} |
199
|
|
elsif ($rbuf =~ m/$re/) { |
200
|
1498
|
# See match variable perf issues: http://bit.ly/2dbGrzo |
201
|
931
|
$prematch = substr $rbuf, 0, $LAST_MATCH_START[0]; |
202
|
931
|
$match = substr $rbuf, $LAST_MATCH_START[0], $LAST_MATCH_END[0] - $LAST_MATCH_START[0]; |
203
|
931
|
$self->{carry_buffer} = substr $rbuf, $LAST_MATCH_END[0]; |
204
|
4
|
last READ; |
205
|
4
|
} |
206
|
4
|
|
207
|
4
|
if (elapsed($sttime) >= $timeout) { |
208
|
|
$self->{carry_buffer} = $rbuf; |
209
|
|
return {matched => 0, string => ($overflow || '') . $rbuf}; |
210
|
|
} |
211
|
|
|
212
|
|
my $read = $self->do_read($buf, max_size => $buflen / 2, timeout => remaining($sttime, $timeout)); |
213
|
11
|
next READ unless (defined($read)); |
214
|
11
|
|
215
|
11
|
# If there is not enough free space in the ring buffer; remove an amount |
216
|
11
|
# equal to the bytes just read minus the free space in $rbuf from the |
217
|
|
# beginning. If we are recording all output, add the removed bytes to |
218
|
|
# $overflow. |
219
|
1483
|
if (length($rbuf) + $read > $buflen) { |
220
|
2
|
my $remove_len = $read - ($buflen - length($rbuf)); |
221
|
2
|
$overflow .= substr $rbuf, 0, $remove_len if defined $overflow; |
222
|
|
$rbuf = substr $rbuf, $remove_len; |
223
|
|
} |
224
|
1481
|
$rbuf .= $buf; |
225
|
1481
|
} |
226
|
|
|
227
|
|
my $elapsed = elapsed($sttime); |
228
|
|
bmwqemu::fctinfo("Matched output from SUT in $loops loops & $elapsed seconds: $match"); |
229
|
|
|
230
|
|
$overflow ||= ''; |
231
|
1480
|
return $overflow . $prematch if $nargs{exclude_match}; |
232
|
1461
|
return {matched => 1, string => $overflow . $prematch . $match}; |
233
|
1461
|
} |
234
|
1461
|
|
235
|
|
=head2 peak |
236
|
1480
|
|
237
|
|
Read and return pending data without consuming it. This is useful if you are |
238
|
|
about to destroy the serial_screen instance, but want to keep any pending |
239
|
15
|
data. However this does not wait for any data in particular so this races with |
240
|
15
|
the backend and data transport. Therefore it should only be used when there is |
241
|
|
no information available about what data is expected to be available. |
242
|
15
|
|
243
|
15
|
=cut |
244
|
15
|
my $buflen = $nargs{buffer_size} || 4096; |
245
|
|
my $total_read = 0; |
246
|
|
my $buf = ''; |
247
|
|
my $read; |
248
|
|
|
249
|
|
bmwqemu::log_call(%nargs); |
250
|
|
LOOP: { |
251
|
|
$read = sysread($self->{fd_read}, $buf, $buflen); |
252
|
|
last LOOP unless defined $read; |
253
|
|
|
254
|
|
$self->{carry_buffer} .= $buf; |
255
|
|
$total_read += $read; |
256
|
7
|
|
|
7
|
|
|
7
|
|
|
7
|
|
257
|
7
|
next LOOP if $read > 0 && $total_read < $buflen; |
258
|
7
|
} |
259
|
7
|
|
260
|
7
|
bmwqemu::fctinfo('Peaked ' . ($total_read + length($self->{carry_buffer})) . ' bytes'); |
261
|
|
return $self->{carry_buffer}; |
262
|
7
|
} |
263
|
|
|
264
|
7
|
|
|
7
|
|
265
|
7
|
|
266
|
|
1; |