File Coverage

lib/Slaughter/Info/openbsd.pm
Criterion Covered Total %
statement 42 50 84.0
branch 10 14 71.4
condition 1 3 33.3
subroutine 4 4 100.0
pod 2 2 100.0
total 59 73 80.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             =head1 NAME
4            
5             Slaughter::Info::openbsd - Determine information about an OpenBSD host.
6            
7             =cut
8              
9             =head1 SYNOPSIS
10            
11             This module is the OpenBSD version of the Slaughter information-gathering
12             module.
13            
14             Modules beneath the C<Slaughter::Info> namespace are loaded when slaughter
15             is executed, they are used to populate a hash with information about
16             the current host.
17            
18             This module is loaded only on OpenBSD systems, and will determine such details
19             as the local hostname, the free RAM, any IP addresses, etc.
20            
21             The correct information-gathering module is loaded at run-time via the use of the C<$^O> variable, and if no system-specific module is available then the generic L<Slaughter::Info::generic> module is used as a fall-back.
22            
23             The information discovered can be dumped by running C<slaughter>
24            
25             =for example begin
26            
27             ~# slaughter --dump
28            
29             =for example end
30            
31             Usage of this module is as follows:
32            
33             =for example begin
34            
35             use Slaughter::Info::openbsd;
36            
37             my $obj = Slaughter::Info::openbsd->new();
38             my $data = $obj->getInformation();
39            
40             # use info now ..
41             print "We have $data->{'ip_count'} IPv4 addresses.\n";
42             print "We have $data->{'ip6_count'} IPv6 addresses.\n";
43            
44             =for example end
45            
46             When this module is used an attempt is also made to load the module
47             C<Slaughter::Info::Local::openbsd> - if that succeeds it will be used to
48             augment the information discovered and made available to slaughter
49             policies.
50            
51             =cut
52              
53              
54             =head1 METHODS
55            
56             Now follows documentation on the available methods.
57            
58             =cut
59              
60              
61 1     1   1251 use strict;
  1         2  
  1         38  
62 1     1   3 use warnings;
  1         2  
  1         625  
63              
64              
65             package Slaughter::Info::openbsd;
66              
67              
68              
69             #
70             # The version of our release.
71             #
72             our $VERSION = "3.0.5";
73              
74              
75              
76             =head2 new
77            
78             Create a new instance of this object.
79            
80             =cut
81              
82             sub new
83             {
84 1     1 1 502     my ( $proto, %supplied ) = (@_);
85 1   33     26     my $class = ref($proto) || $proto;
86              
87 1         3     my $self = {};
88 1         2     bless( $self, $class );
89 1         3     return $self;
90              
91             }
92              
93              
94             =head2 getInformation
95            
96             This function retrieves meta-information about the current host.
97            
98             The return value is a hash-reference of data determined dynamically.
99            
100             =cut
101              
102             sub getInformation
103             {
104 1     1 1 824     my ($self) = (@_);
105              
106             #
107             # The data we will return.
108             #
109 1         2     my $ref;
110              
111             #
112             # Call "hostname" to determine the local hostname.
113             #
114 1         2078     $ref->{ 'fqdn' } = `hostname`;
115 1         8     chomp( $ref->{ 'fqdn' } );
116              
117             #
118             # Get the hostname and domain name as seperate strings.
119             #
120 1 50       13     if ( $ref->{ 'fqdn' } =~ /^([^.]+)\.(.*)$/ )
121                 {
122 0         0         $ref->{ 'hostname' } = $1;
123 0         0         $ref->{ 'domain' } = $2;
124                 }
125                 else
126                 {
127              
128             #
129             # Better than nothing, right?
130             #
131 1         5         $ref->{ 'hostname' } = $ref->{ 'fqdn' };
132 1         4         $ref->{ 'domain' } = $ref->{ 'fqdn' };
133                 }
134              
135              
136             #
137             # Kernel version.
138             #
139 1         1658     $ref->{ 'release' } = `uname -r`;
140 1         10     chomp( $ref->{ 'release' } );
141              
142             #
143             # Are we i386/amd64?
144             #
145 1         1717     $ref->{ 'arch' } = `uname -p`;
146 1         9     chomp( $ref->{ 'arch' } );
147              
148             #
149             # This should be portable.
150             #
151 1         11     $ref->{ 'path' } = $ENV{ 'PATH' };
152              
153             #
154             # Count of IPv4/IPv6 addresses.
155             #
156 1         3     my $ipv4 = 1;
157 1         3     my $ipv6 = 1;
158              
159             #
160             # Parse the output of /sbin/ifconfig.
161             #
162 1         1915     foreach my $line ( split( /[\r\n]/, `ifconfig` ) )
163                 {
164 17         17         chomp($line);
165 17 100       42         next unless ( $line =~ /(inet|inet6)/ );
166              
167 4 100       16         if ( $line =~ /inet ([^ \t]+)/ )
168                     {
169 2         14             my $addr = $1;
170 2 50       6             next if ( $addr =~ /^127\./i );
171 2         15             $ref->{ 'ip_' . $ipv4 } = $addr;
172 2         8             $ipv4 += 1;
173                     }
174 4 100       14         if ( $line =~ /inet6 ([^ \t]+)/ )
175                     {
176 2         6             my $addr = $1;
177 2 50       8             next if ( $addr =~ /fe80/i );
178 2         8             $ref->{ 'ip6_' . $ipv6 } = $addr;
179 2         4             $ipv6 += 1;
180                     }
181                 }
182              
183             # counts of addresses
184 1         6     $ref->{ 'ip_count' } = $ipv4;
185 1         3     $ref->{ 'ip6_count' } = $ipv6;
186              
187             #
188             # Load Average - This test will always succeed on an OpenBSD
189             # system, but it is here to allow the module to be loaded/tested
190             # upon a GNU/Linux host
191             #
192 1 50       7     if ( $^O =~ /openbsd/ )
193                 {
194 0         0         $ref->{ 'load_average' } = `sysctl -n vm.loadavg`;
195 0         0         chomp( $ref->{ 'load_average' } );
196              
197             #
198             # Split into per-minute values.
199             #
200 0         0         my @avg = split( /[ \t]/, $ref->{ 'load_average' } );
201 0         0         $ref->{ 'load_average_1' } = $avg[0];
202 0         0         $ref->{ 'load_average_5' } = $avg[1];
203 0         0         $ref->{ 'load_average_15' } = $avg[2];
204              
205                 }
206              
207 1         10     return ($ref);
208             }
209              
210              
211              
212             1;
213              
214              
215              
216             =head1 AUTHOR
217            
218             Steve Kemp <steve@steve.org.uk>
219            
220             =cut
221              
222             =head1 LICENSE
223            
224             Copyright (c) 2010-2015 by Steve Kemp. All rights reserved.
225            
226             This module is free software;
227             you can redistribute it and/or modify it under
228             the same terms as Perl itself.
229             The LICENSE file contains the full text of the license.
230            
231             =cut
232