File Coverage

lib/Linux/Slackware/SystemTests.pm
Criterion Covered Total %
statement 44 84 52.3
branch 5 40 12.5
condition 10 32 31.2
subroutine 9 13 69.2
pod 4 6 66.6
total 72 175 41.1


line stmt bran cond sub pod time code
1             package Linux::Slackware::SystemTests;
2              
3             # ABSTRACT: Helper class for Slacware Linux system test harness.
4              
5             # Encapsulates data and methods intended to be used by:
6             # * the systests/*.t scripts
7             # * the bin/slackware-systemtests test harness
8              
9 1     1   51430 use strict;
  1         1  
  1         21  
10 1     1   4 use warnings;
  1         1  
  1         18  
11 1     1   534 use JSON;
  1         7855  
  1         3  
12 1     1   515 use File::Valet;
  1         8111  
  1         62  
13 1     1   6 use Time::HiRes;
  1         1  
  1         6  
14 1     1   61 use vars qw(@EXPORT @EXPORT_OK @ISA $VERSION);
  1         1  
  1         65  
15              
16             BEGIN {
17 1     1   3 require Exporter;
18 1         6 @ISA = qw(Exporter);
19 1         1 $VERSION = '1.00';
20 1         745 @EXPORT = @EXPORT_OK = qw(); # zzapp -- do we want to export anything?
21             }
22              
23             sub new {
24 1     1 1 15 my ($class, %opt_hr) = @_;
25 1         23 my $self = {
26             opt_hr => \%opt_hr, # Anything the caller passes in gets stashed here so $self->opt() can be used to look it up later.
27             ok => 'OK',
28             n_err => 0,
29             n_warn => 0,
30             n_fail => 0,
31             n_pass => 0,
32             err => '',
33             err_ar => [],
34             me => 'Linux::Slackware::SystemTests',
35             js_or => JSON->new->ascii->allow_nonref->space_after()
36             };
37 1         1 bless ($self, $class);
38              
39 1         1 foreach my $k0 (keys %{$self->{opt_hr}}) {
  1         6  
40 2         7 my $k1 = join('_', split(/-/, $k0));
41 2 100       5 next if ($k0 eq $k1);
42 1         3 $self->{opt_hr}->{$k1} = $self->{opt_hr}->{$k0};
43 1         1 delete $self->{opt_hr}->{$k0};
44             }
45              
46             # I was told File::ShareDir was The Answer, but that breaks when running out of the development directory, so reverting to the ugly hack:
47 1 50       9 my $st_dir = $1 if ($INC{'Linux/Slackware/SystemTests.pm'} =~ /(.+?)\.pm$/);
48 1   33     4 $self->{share_dir} = $self->opt('share_dir') // $st_dir;
49 1 50       3 die "need to specify non-undef share_dir because INC of self is not parseable" unless(defined($self->{share_dir})); # zzapp ick .. how to better word that?
50              
51 1   33     2 $self->{temp_dir} = $self->opt('temp_dir') // File::Valet::find_temp();
52 1 50       108 die "need to specify non-undef temp_dir because File::Valet::find_temp cannot find one" unless(defined($self->{temp_dir})); # zzapp ick .. how to better word that?
53              
54 1   33     3 $self->{tests_dir} = $self->opt('tests_dir') // "$self->{share_dir}/system_tests";
55 1   33     3 $self->{data_dir} = $self->opt('data_dir') // "$self->{share_dir}/system_test_data";
56 1   33     4 $self->{bin_dir} = $self->opt('bin_dir') // "$self->{share_dir}/bin";
57 1   33     3 $self->{sys_hr} = $self->opt('self_id') // $self->invoke_self_id();
58              
59 1         2 return $self;
60             }
61              
62             sub invoke_self_id {
63 0     0 0 0 my ($self) = @_;
64 0         0 my $filename = $self->opt('self_id_cache_pathname','/tmp/self_id.dat');
65              
66 0         0 my $id_txt;
67              
68 0 0 0     0 if (-e $filename && (stat($filename))[9] > time() - 8 * 3600) {
69 0         0 $id_txt = rd_f($filename);
70 0 0       0 die "unable to read self-id cache file $filename ($File::Valet::ERROR)\n" unless (defined($id_txt));
71             } else {
72 0         0 unlink($filename);
73 0 0       0 die "Expired self-id cache file $filename exists and cannot be removed, which is likely a permissions issue. Please remove, rename or chmod it and try again.\n" if (-e $filename);
74 0         0 my $self_id_bin = "$self->{bin_dir}/self-id";
75 0 0       0 die "self-id executable is missing from $self_id_bin" unless (-e $self_id_bin);
76 0 0       0 die "self-id executable is not executable at $self_id_bin" unless (-x $self_id_bin);
77 0         0 $id_txt = `$self_id_bin`; # zzapp -- yeah yeah, really should use IPC::Open3 or somesuch here
78 0         0 wr_f($filename, $id_txt); # zzapp -- check for errors
79             }
80              
81             # zzapp -- check $id_txt for well-formedness, validate eval()'s output, rethrow any caught exceptions.
82 0         0 return eval($id_txt);
83             }
84              
85             sub log {
86 0     0 1 0 my ($self, $mode, @errs) = @_;
87 0 0 0     0 return if ($mode eq 'DEBUG' && !$self->opt('debug',0));
88 0 0       0 my $err_js = $self->{js_or}->encode(\@errs) if ($self->opt('show_log',0));
89 0         0 my $tm = Time::HiRes::time();
90 0         0 my $lt = localtime();
91 0 0       0 print STDERR "$tm $lt $$\t$mode\t$err_js\n" if ($self->opt('show_log',0));
92 0 0       0 ap_f($self->opt('log_filename','/tmp/st.log'), $self->{js_or}->encode([$mode, $tm, $lt, $$, \@errs])) if ($self->opt('log',1));
93 0 0       0 $self->{n_err}++ if ($mode eq 'ERROR');
94 0 0       0 $self->{n_warn}++ if ($mode eq 'WARNING');
95 0 0       0 $self->{n_fail}++ if ($mode eq 'FAIL');
96 0 0       0 $self->{n_pass}++ if ($mode eq 'PASS');
97 0         0 return;
98             }
99              
100             sub init_work_file {
101 0     0 1 0 my ($self, $filename) = @_;
102 0         0 my $subject_file = "$self->{data_dir}/$filename";
103 0         0 my $target_file = "$self->{temp_dir}/$filename";
104 0 0       0 return ('ERROR', "no such file $subject_file") unless (-e $subject_file);
105 0         0 unlink($target_file);
106 0 0       0 return ('ERROR', "failed to remove left over turd file $target_file") if (-e $target_file);
107 0         0 my $ok = wr_f($target_file, rd_f($subject_file));
108 0 0       0 return ('ERROR', "failed to copy $subject_file to $target_file ($File::Valet::ERROR)") unless ($ok);
109 0         0 return ('OK', $target_file);
110             }
111              
112             sub all_is_well {
113 0     0 0 0 my ($self) = @_;
114 0         0 $self->{ok} = 'OK';
115 0         0 $self->{err} = '';
116 0         0 $self->{err_ar} = [];
117 0         0 return;
118             }
119              
120             sub opt {
121 6     6 1 9 my ($self, $name, $default_value, $alt_hr) = @_;
122 6   50     19 $alt_hr //= {};
123 6   66     56 return $self->{opt_hr}->{$name} // $alt_hr->{$name} // $default_value;
      33        
124             }
125              
126             1;
127              
128             =head1 NAME
129              
130             Linux::Slackware::SystemTests - System tests for Slackware Linux
131              
132             =head1 SYNOPSIS
133              
134             # If you just want to -run- system tests, invoke the slackware-systemtests
135             # test harness and stop reading this document:
136              
137             $ slackware-systemtests
138              
139             # If you are -writing- system tests, use an instance to get useful tools:
140              
141             use Linux::Slackware::SystemTests;
142             my $st = Linux::Slackware::SystemTests->new();
143              
144             # Copy a data file from wherever they are installed to a temp directory so
145             # it can be modified:
146              
147             my ($ok, $file_pathname) = $st->init_work_file("001_sed.1.txt");
148              
149             # $st->{sys_hr} provides useful details about the system being tested, so
150             # you can change the test depending on what version of Slackware is being
151             # tested, or 32-vs-64-bit, etc:
152              
153             if ($st->{sys_hr}->{version} eq "14.2") {
154             # run test for just the Slackware 14.2 release
155             }
156             if ($st->{sys_hr}->{bits} eq "64") {
157             # run test specific to 64-bit Slackware
158             }
159              
160             # If you need to JSONify something, there's already a JSON object
161             # instantiated with sane and robust operating parameters:
162              
163             ok `/bin/uname -a` =~ /CPU \@ ([\d\.]+)GHz (\w+)/, "processor is ".$st->{js_or}->encode([$1, $2]);
164              
165             # If you need to know where the test data files are installed, $st knows:
166              
167             my $data_pathname = "$st->{data_dir}/some_test_file.txt";
168              
169             # If you want to log structured data to a file, that can be done too:
170             $st->log("WARNING", "Something not quite right with environment", \%ENV);
171              
172             # Alternatively, if your test needs none of these things, you don't have to
173             # use this module at all! Any test that produces TAP output should jfw.
174              
175             =head1 DESCRIPTION
176              
177             L are are short programs which exercise components of your
178             computer system and make sure they are running correctly.
179              
180             This package implements tests for L systems,
181             and a test harness for running them and generating reports.
182              
183             This module provides maybe-useful functionality for making those tests easier to write, and for helping to write test
184             harnesses.
185              
186             The eventual goal is to accumulate enough tests that when Slackware updates, you can just re-run the system tests and
187             know that everything works okay. Some sort of continuous integration automation might also happen, eventually.
188              
189             Another goal is to make it easy to write new system tests, to keep the barrier of entry low. There is a lot to test
190             in a full Slackware install, so please write tests and share them with the author :-)
191              
192             =head1 USING THE MODULE
193              
194             The Linux::Slackware::SystemTests module provides some data and methods which may or may not be useful to you.
195              
196             If you do not find them useful, don't use the module! :-) System tests do not require the module. It's just there
197             to make your life easier, if you need it.
198              
199             =head2 METHODS
200              
201             =head3 my $st = Linux::Slackware::SystemTests-Enew(%options)
202              
203             Instantiates a new Linux::Slackware::SystemTests object. Lacking options, sane defaults are assumed.
204              
205             Supported options are:
206              
207             =over 4
208              
209             =item temp_dir => (path string)
210              
211             Set this to override C<$st-E{temp_dir}>, which changes the behavior of the C and C methods.
212              
213             When this option is not provided, an appropriate temporary directory will be found via C.
214              
215             Some sane values to pass here might be "/tmp" or "/dev/shm".
216              
217             =item debug => (0 or 1)
218              
219             When true (1), invoking C<$st-Elog> with a mode of "DEBUG" will be silently ignored.
220              
221             When false (0), "DEBUG" mode logging messages will be written to the log file.
222              
223             Defaults to false (0).
224              
225             =item log_filename => (pathname string)
226              
227             Sets the pathname of the structured data log file written to by C<$st-Elog>. Defaults to "/tmp/st.log".
228              
229             =item show_log => (0 or 1)
230              
231             When true (1), invoking C<$st-Elog> will cause a human-friendly representation of the log record to be written to C.
232              
233             When false (0), no log records will be displayed.
234              
235             Defaults to false (0).
236              
237             =item log => (0 or 1)
238              
239             When true (1), invoking C<$st-Elog> will cause log messages to be written to the logile.
240              
241             When false (0), no log records will be written to file, but might still be written to C if C is set.
242              
243             Defaults to true (1).
244              
245             =item share_dir => (path string)
246              
247             Set this to override C<$st-E{share_dir}>, the base directory from which C, C, C are derived. Mostly useful for mocking purposes.
248              
249             =item data_dir => (path string)
250              
251             Set this to override C<$st-E{data_dir}>, where the test data files are stored. Mostly useful for mocking purposes.
252              
253             =item tests_dir => (path string)
254              
255             Set this to override C<$st-E{tests_dir}>, where the system test executables are stored. Mostly useful for mocking purposes.
256              
257             =item bin_dir => (path string)
258              
259             Set this to override C<$st-E{bin_dir}>, where the module's private executables are stored. Mostly useful for mocking purposes.
260              
261             =item self_id => (hash reference)
262              
263             Set this to override C<$st-E{sys_hr}>. Mostly useful for mocking purposes.
264              
265             When this option is not provided, a C script will be run which figures out various details about the local system.
266              
267             =back
268              
269             =head3 $st-Elog(MODE, DESCRIPTION[, structured data ...])
270              
271             Writes a JSON record to a structured data log file, and optionally to STDOUT as well.
272              
273             =over 4
274              
275             =item MODE
276              
277             Should be one of "DEBUG", "ERROR", "WARNING", "FAIL", or "PASS".
278              
279             =item DESCRIPTION
280              
281             Should be an B string (without any variables interpolated into it). Using an invariant makes possible a full enumeration of log record types, which is important for log collation.
282              
283             =item structured data
284              
285             Can be any number of arbitrarily complex data elements. Elements not able to be represented by the C module will instead be represented as C. This includes code refs, glob refs and regex refs.
286              
287             Each JSON record is newline-terminated, and contains the following fields:
288              
289             [MODE, EPOCH_TIME, LOCAL_TIME, PID, DESCRIPTION, structured data ...]
290              
291             The C, C and C fields will be the JSON representations of the C<$st-Elog> parameters.
292              
293             The C field will be a floating point representation of the epoch time at which the log record was created.
294              
295             The C field will be a human-readable representation of C in the local timezone.
296              
297             The C field will be the process identifier of the process which created the log record.
298              
299             For instance, the following C call:
300              
301             $st->log("WARNING", "skipped some tests", {name => "ichi", why => "ploo"}, {name => "ni", why => "glom"}, [1, 2, 3, {foo => "bar"}])
302              
303             .. would append something like the following JSON to the logfile:
304              
305             ["WARNING", 1470253241.25485, "Wed Aug 3 12:40:41 2016", 1472, "skipped some tests", {"name": "ichi", "why": "ploo"}, {"name": "ichi", "why": "glom"}, [1, 2, 3, {"foo": "bar"}]]
306              
307             Furthermore, if the C parameter was set when C<$st> was instantiated, the following would be printed to STDOUT:
308              
309             1470253241.25485 Wed Aug 3 12:40:41 2016 1472\tWARNING\t["skipped some tests", {"name": "ichi", "why": "ploo"}, {"name": "ichi", "why": "glom"}, [1, 2, 3, {"foo": "bar"}]]
310              
311             =back
312              
313             =head3 ($ok, $pathname) = $st->init_work_file("314_some_test_file.txt")
314              
315             When the module is installed, it is usually stored as read-only data in some obscure corner of the filesystem. This is inconvenient when a test requires a data file which is writable.
316              
317             Rather than forcing each test author to come up with a way to find the data and copy it to a temporary directory (which might not exist on the system), C is provided to do the work for them.
318              
319             C will find the data file, find a temporary directory, delete any old files left over from a previous run, copy the file and return ('OK', $pathname) where $pathname is the full pathname of the copied file.
320              
321             If it encounters any errors at any point in the process, it will return ('ERROR', $description) where $description describes what failed and (maybe) why.
322              
323             If a copy of the file is not required, and a test only needs the full pathname of a data file for reading, use C<$st-E{data_dir}> instead, like so:
324              
325             my $full_pathname = "$st->{data_dir}/314_some_test_file.txt";
326              
327             =head3 $st->opt(OPTION_NAME[, DEFAULT_VALUE[, ALTERNATIVE_HASHREF]])
328              
329             $st->opt("log")
330             $st->opt("log", 0)
331             $st->opt("log", 0, $alt_hr)
332              
333             Fetches an option field from the object's instantiation parameters.
334              
335             C will look in C<$st-E{opt_hr}-E{OPTION_NAME}> first. If not present there,
336             it will look in C<$alt_hr-E{OPTION_NAME}> if an C<$alt_hr> parameter was provided.
337              
338             If no option by that name is found anywhere, C will return C (0 in the above examples), or C if no default is provided.
339              
340             =head2 WRITING SYSTEM TESTS
341              
342             System tests can be very simple or as complicated as necessary. They may be written in
343             any language, although /bin/sh and perl are encouraged.
344              
345             The only hard requirement is that they generate their output in L
346             Protocol|http://testanything.org/>, which is pretty easy. TAP libraries are available
347             for most languages.
348              
349             Tests should be executable files located in C with a C<.t> filename suffix. All such files will be executed by running the C script.
350              
351             =head3 WRITING SYSTEM TESTS IN PERL
352              
353             Writing tests in perl is easy. Just copy C to a new file (like C<123_my_test.t>) and edit the new file to add your test logic. There are some goodies in C (like object instantiation) which are commented out. Uncomment them if you need them.
354              
355             C uses L, but feel free to use any of the other TAP-compliant test modules, such as L or L.
356              
357             If you have never written tests for perl before, read the L documentation and look at the other C<.t> files in the C directory to get a notion.
358              
359             The skinny of it is, C provides functions like C and C, to which you pass the results of your tests of system correctness, and it represents those results in TAP format. For instance:
360              
361             ok `lsmod 2>\&1` =~ /ipv6/, "IPv6 module is loaded"
362              
363             .. which displays C or C depending on the results of the expression.
364              
365             Also feel free to hop onto the C<#perl> IRC channel on C to ask for help. The good folks there are very enthusiastic about good tests. Just don't take mst's brisk manner personally. He means well.
366              
367             =head3 WRITING SYSTEM TESTS IN BASH
368              
369             Work in progress. More here later.
370              
371             I'm still figuring this out. There is a TAP implementation for bash L which might be appropriate, but I'm still assessing it.
372              
373             If that doesn't work out, I'll teach C to accept C<*.sh.t> tests which signal pass/fail with an exit code, and drop the TAP requirement. The priority is to get more tests written, and barriers will be lowered to make that happen.
374              
375             =head3 WRITING SYSTEM TESTS IN OTHER LANGUAGES
376              
377             Work in progress. More here later.
378              
379             L claims TAP libraries are available for C, C++, Python, PHP, Perl, Java, JavaScript, "and others", which means whatever programming language you like to use, you can likely use it to write system tests.
380              
381             The only stipulation is that the code should jfw using software that ships with stock Slackware. Since C and C are part of Slackware, C and C++ are fine, but Oracle's JVM does not. That means unless your test works with C, Java is off the table.
382              
383             =head2 RUNNING SYSTEM TESTS
384              
385             At the moment, the test harness is extremely simple. More features will come. The main priority is getting more tests written.
386              
387             For the moment, invoking C without parameters will cause it to run all of the C<*.t> executables in C, display their pathnames, and display only those tests which fail.
388              
389             Invoking C with arguments will treat those arguments as regex patterns which will be applied to the names of the C<*.t> executables in C, and only those which match will be executed.
390              
391             Thus if C contains tests C<123_ichi.t>, C<234_ni.t> and C<345_san.t>, running C will cause only C<345_san.t> to run, while running C will cause only C<123_ichi.t> and C<234_ni.t> to run.
392              
393             Alternatively, to run specific system tests, invoke them directly:
394              
395             $ lib/Linux/Slackware/SystemTests/system_tests/001_sed.t
396              
397             Near future plans include a C<--retry> option which only runs tests which failed in the previous invocation and some sort of html report output.
398              
399             Far future plans include continuous integration automation, so that new releases of Slackware can be installed to a VM and tested, and test results made available as a web page.
400              
401             =head1 SEE ALSO
402              
403             The L which does not work under Slackware and has more of a kernel focus.
404              
405             =head1 CONTACTS AND RESOURCES
406              
407             Github page L is the official project site. Submit bug reports and pull requests there (or just email TTK).
408              
409             Channel C<##slackware> on irc.freenode.net, for Slackware-related questions
410              
411             Channel C<#perl> on irc.freenode.net, for Perl-related questions
412              
413             =head1 AUTHORS
414              
415             Contribute some system tests and get yourself added to this list!
416              
417             TTK Ciar, C
418              
419             =head1 COPYRIGHT AND LICENSE
420              
421             Copyright (C) 2016, TTK Ciar and others.
422              
423             This program is free software, you can redistribute it and/or modify it under
424             the terms of Perl itself.
425              
426             =cut