File Coverage

consoles/serial_screen.pm
Criterion Covered Total %
statement 165 173 95.3
total 165 173 95.3


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;