| blib/lib/Csistck.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 80 | 93 | 86.0 |
| branch | 11 | 22 | 50.0 |
| condition | 3 | 15 | 20.0 |
| subroutine | 20 | 21 | 95.2 |
| pod | 3 | 4 | 75.0 |
| total | 117 | 155 | 75.4 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Csistck; | ||||||
| 2 | |||||||
| 3 | 17 | 17 | 356525 | use 5.010; | |||
| 17 | 138 | ||||||
| 4 | 17 | 17 | 100 | use strict; | |||
| 17 | 34 | ||||||
| 17 | 503 | ||||||
| 5 | 17 | 17 | 100 | use warnings; | |||
| 17 | 44 | ||||||
| 17 | 996 | ||||||
| 6 | |||||||
| 7 | our $VERSION = '0.09_11'; | ||||||
| 8 | |||||||
| 9 | # We export function in the main namespace | ||||||
| 10 | 17 | 17 | 98 | use base 'Exporter'; | |||
| 17 | 29 | ||||||
| 17 | 2142 | ||||||
| 11 | our @EXPORT = qw( | ||||||
| 12 | host | ||||||
| 13 | role | ||||||
| 14 | check | ||||||
| 15 | option | ||||||
| 16 | |||||||
| 17 | file | ||||||
| 18 | noop | ||||||
| 19 | pkg | ||||||
| 20 | script | ||||||
| 21 | template | ||||||
| 22 | ); | ||||||
| 23 | |||||||
| 24 | # Imports for base | ||||||
| 25 | 17 | 17 | 7011 | use Csistck::Config qw/option/; | |||
| 17 | 34 | ||||||
| 17 | 1316 | ||||||
| 26 | 17 | 17 | 7082 | use Csistck::Test::NOOP qw/noop/; | |||
| 17 | 45 | ||||||
| 17 | 1138 | ||||||
| 27 | 17 | 17 | 6708 | use Csistck::Test::File qw/file/; | |||
| 17 | 51 | ||||||
| 17 | 1402 | ||||||
| 28 | 17 | 17 | 7949 | use Csistck::Test::Pkg qw/pkg/; | |||
| 17 | 42 | ||||||
| 17 | 7853 | ||||||
| 29 | 17 | 17 | 7477 | use Csistck::Test::Script qw/script/; | |||
| 17 | 40 | ||||||
| 17 | 1015 | ||||||
| 30 | 17 | 17 | 7092 | use Csistck::Test::Template qw/template/; | |||
| 17 | 38 | ||||||
| 17 | 1008 | ||||||
| 31 | |||||||
| 32 | 17 | 17 | 5859 | use Csistck::Role; | |||
| 17 | 32 | ||||||
| 17 | 486 | ||||||
| 33 | 17 | 17 | 6228 | use Csistck::Term; | |||
| 17 | 41 | ||||||
| 17 | 800 | ||||||
| 34 | |||||||
| 35 | 17 | 17 | 96 | use Sys::Hostname::Long qw//; | |||
| 17 | 27 | ||||||
| 17 | 275 | ||||||
| 36 | 17 | 17 | 10219 | use Data::Dumper; | |||
| 17 | 94826 | ||||||
| 17 | 1294 | ||||||
| 37 | 17 | 17 | 147 | use Scalar::Util qw/blessed reftype/; | |||
| 17 | 28 | ||||||
| 17 | 885 | ||||||
| 38 | 17 | 17 | 93 | use List::Util qw/sum/; | |||
| 17 | 31 | ||||||
| 17 | 13401 | ||||||
| 39 | |||||||
| 40 | # Package wide | ||||||
| 41 | my $Hosts = {}; | ||||||
| 42 | my $Roles = {}; | ||||||
| 43 | |||||||
| 44 | |||||||
| 45 | =head1 NAME | ||||||
| 46 | |||||||
| 47 | Csistck - Perl system consistency check framework | ||||||
| 48 | |||||||
| 49 | =head1 SYNOPSIS | ||||||
| 50 | |||||||
| 51 | use Csistck; | ||||||
| 52 | |||||||
| 53 | for my $host (qw/a b/) { | ||||||
| 54 | host $host => role('test'); | ||||||
| 55 | } | ||||||
| 56 | |||||||
| 57 | host 'c' => role('test'); | ||||||
| 58 | |||||||
| 59 | role 'test' => | ||||||
| 60 | template(".files/test.tt", "/tmp/test", { text => "Some text here" }), | ||||||
| 61 | permission("/tmp/test*", mode => '0777', uid => 100, gid => 100); | ||||||
| 62 | |||||||
| 63 | check; | ||||||
| 64 | |||||||
| 65 | The script can then be called directly, using command line arguements below | ||||||
| 66 | |||||||
| 67 | =head1 DESCRIPTION | ||||||
| 68 | |||||||
| 69 | Csistck is a small Perl framework for writing scripts to maintain system | ||||||
| 70 | configuration and consistency. The focus of csistck is to stay lightweight, | ||||||
| 71 | simple, and flexible. | ||||||
| 72 | |||||||
| 73 | =head1 EXTENDING ROLES | ||||||
| 74 | |||||||
| 75 | Roles can be defined using the C |
||||||
| 76 | method is to extend a new object from L |
||||||
| 77 | |||||||
| 78 | use Csistck; | ||||||
| 79 | use base 'Csistck::Role'; | ||||||
| 80 | |||||||
| 81 | sub defaults { | ||||||
| 82 | my $self = shift; | ||||||
| 83 | $self->{config} = '/etc/example.conf'; | ||||||
| 84 | } | ||||||
| 85 | |||||||
| 86 | sub tests { | ||||||
| 87 | my $self = shift; | ||||||
| 88 | $self->add(pkg({ | ||||||
| 89 | dpkg => 'test-server', | ||||||
| 90 | pkg_info => 'net-test' | ||||||
| 91 | }), | ||||||
| 92 | template('files/example.conf', $self->{config}, { example => $self }); | ||||||
| 93 | } | ||||||
| 94 | |||||||
| 95 | 1; | ||||||
| 96 | |||||||
| 97 | See L |
||||||
| 98 | |||||||
| 99 | |||||||
| 100 | =head1 METHODS | ||||||
| 101 | |||||||
| 102 | |||||||
| 103 | =head2 host($host, $checks) | ||||||
| 104 | |||||||
| 105 | Add tests to host C<$host> test array. Tests are Csistck::Test blessed references, code | ||||||
| 106 | references, or arrays of either. To process host tests, use C |
||||||
| 107 | |||||||
| 108 | =cut | ||||||
| 109 | |||||||
| 110 | sub host { | ||||||
| 111 | 3 | 3 | 1 | 537 | my $hostname = shift; | ||
| 112 | |||||||
| 113 | # Add domain if option is set? | ||||||
| 114 | 3 | 12 | my $domain_name = Csistck::Config::option('domain_name'); | ||||
| 115 | 3 | 50 | 8 | $hostname = join '.', $hostname, $domain_name | |||
| 116 | if (defined $domain_name); | ||||||
| 117 | |||||||
| 118 | 3 | 13 | while (my $require = shift) { | ||||
| 119 | 3 | 4 | push(@{$Hosts->{$hostname}}, $require); | ||||
| 3 | 13 | ||||||
| 120 | } | ||||||
| 121 | |||||||
| 122 | 3 | 8 | return $Hosts->{$hostname}; | ||||
| 123 | } | ||||||
| 124 | |||||||
| 125 | =head2 role($role, $checks) | ||||||
| 126 | |||||||
| 127 | Define a weak role. Constructed similar to a host check, however roles are not | ||||||
| 128 | called directly, rather they are used to define groups of common tests that can | ||||||
| 129 | be used by multiple hosts. | ||||||
| 130 | |||||||
| 131 | See L |
||||||
| 132 | allows for passing role configuration. | ||||||
| 133 | |||||||
| 134 | =cut | ||||||
| 135 | |||||||
| 136 | sub role { | ||||||
| 137 | 1 | 1 | 1 | 2 | my $role = shift; | ||
| 138 | |||||||
| 139 | # If tests specified, add now | ||||||
| 140 | 1 | 11 | while (my $require = shift) { | ||||
| 141 | 1 | 2 | push(@{$Roles->{$role}}, $require); | ||||
| 1 | 6 | ||||||
| 142 | } | ||||||
| 143 | |||||||
| 144 | return sub { | ||||||
| 145 | # Run required role or die | ||||||
| 146 | die ("What's this, \"${role}\"? That role is bupkis.") | ||||||
| 147 | 0 | 0 | 0 | 0 | unless (defined $Roles->{$role}); | ||
| 148 | |||||||
| 149 | 0 | 0 | process($Roles->{$role}); | ||||
| 150 | } | ||||||
| 151 | 1 | 9 | } | ||||
| 152 | |||||||
| 153 | =head2 check($target) | ||||||
| 154 | |||||||
| 155 | Runs processing on C<$target>. If C<$target> is C |
||||||
| 156 | system's full hostname. If C<$target> is a string, use that string for a | ||||||
| 157 | hostname lookup. If C<$target> is a C |
||||||
| 158 | arrayref, then process that object directly. This is useful for writing scripts | ||||||
| 159 | where hostname is not important. | ||||||
| 160 | |||||||
| 161 | =cut | ||||||
| 162 | |||||||
| 163 | sub check { | ||||||
| 164 | 5 | 33 | 5 | 1 | 308 | my $target = shift // Sys::Hostname::Long::hostname_long(); | |
| 165 | |||||||
| 166 | # Process cli arguments for mode/etc, usage | ||||||
| 167 | 5 | 16 | Csistck::Oper::set_mode_by_cli(); | ||||
| 168 | 5 | 50 | 11 | return if (Csistck::Oper::usage()); | |||
| 169 | |||||||
| 170 | # If target is a string, process as hostname reference. Otherwise, assume a | ||||||
| 171 | # test object was passed | ||||||
| 172 | 5 | 100 | 22 | if (!defined(reftype($target))) { | |||
| 173 | die ("What's this, \"${target}\"? That host is bupkis.") | ||||||
| 174 | 2 | 100 | 19 | unless (defined $Hosts->{$target}); | |||
| 175 | 1 | 4 | return process($Hosts->{$target}); | ||||
| 176 | } | ||||||
| 177 | else { | ||||||
| 178 | 3 | 7 | return process($target); | ||||
| 179 | } | ||||||
| 180 | } | ||||||
| 181 | |||||||
| 182 | # For recursive testing based on type | ||||||
| 183 | sub process { | ||||||
| 184 | 7 | 7 | 0 | 5 | my $obj = shift; | ||
| 185 | |||||||
| 186 | # Iterate through array and recursively call process, call code refs, | ||||||
| 187 | # and run tests | ||||||
| 188 | |||||||
| 189 | 7 | 12 | given (ref $obj) { | ||||
| 190 | 7 | 11 | when ('ARRAY') { | ||||
| 191 | 2 | 3 | return map(process($_), @{$obj}); | ||||
| 2 | 11 | ||||||
| 192 | } | ||||||
| 193 | 5 | 6 | when ('CODE') { | ||||
| 194 | 0 | 0 | return &{$obj}; | ||||
| 0 | 0 | ||||||
| 195 | } | ||||||
| 196 | 5 | 6 | default { | ||||
| 197 | 5 | 50 | 33 | 44 | if (blessed($obj) and $obj->isa('Csistck::Test')) { | ||
| 0 | 0 | ||||||
| 198 | # Check is mandatory, if auto repair is set, repair, otherwise prompt | ||||||
| 199 | 5 | 16 | my $check = $obj->execute('check'); | ||||
| 200 | 5 | 100 | 13 | return if ($check->passed); | |||
| 201 | |||||||
| 202 | 1 | 50 | 4 | if (Csistck::Oper::repair()) { | |||
| 203 | 1 | 3 | my $repair = $obj->execute('repair'); | ||||
| 204 | 1 | 50 | 33 | 7 | if ($repair->passed and $obj->on_repair) { | ||
| 205 | 0 | 0 | &{$obj->on_repair}; | ||||
| 0 | 0 | ||||||
| 206 | } | ||||||
| 207 | 1 | 9 | return $repair; | ||||
| 208 | } | ||||||
| 209 | else { | ||||||
| 210 | 0 | my $repair = Csistck::Term::prompt($obj); | |||||
| 211 | 0 | 0 | 0 | if ($repair->passed and $obj->on_repair) { | |||
| 212 | 0 | &{$obj->on_repair}; | |||||
| 0 | |||||||
| 213 | } | ||||||
| 214 | 0 | return $repair; | |||||
| 215 | } | ||||||
| 216 | } | ||||||
| 217 | elsif (blessed($obj) and $obj->isa('Csistck::Role')) { | ||||||
| 218 | 0 | return process($obj->get_tests); | |||||
| 219 | } | ||||||
| 220 | else { | ||||||
| 221 | 0 | die(sprintf("Unkown object reference: ref=<%s>", ref $obj)); | |||||
| 222 | } | ||||||
| 223 | } | ||||||
| 224 | } | ||||||
| 225 | } | ||||||
| 226 | |||||||
| 227 | 1; | ||||||
| 228 | __END__ |