File Coverage

blib/lib/OSLV/Monitor/Backends/FreeBSD.pm

Criterion	Covered	Total	%
statement	26	231	11.2
branch	0	114	0.0
condition	0	51	0.0
subroutine	9	13	69.2
pod	3	4	75.0
total	38	413	9.2

package OSLV::Monitor::Backends::FreeBSD;

use 5.006;
use strict;
use warnings;
use JSON         qw(decode_json encode_json);
use Clone        qw(clone);
use File::Slurp  qw(read_file write_file);
use List::Util   qw( uniq );
use Scalar::Util qw(looks_like_number);
use Time::HiRes  qw(gettimeofday);

=head1 NAME

OSLV::Monitor::Backends::FreeBSD - backend for FreeBSD jails

=head1 VERSION

Version 0.0.5

=cut

our $VERSION = '0.0.5';

=head1 SYNOPSIS

    use OSLV::Monitor::Backends::FreeBSD;

    my $backend = OSLV::Monitor::Backends::FreeBSD->new;

    my $usable=$backend->usable;
    if ( $usable ){
        $return_hash_ref=$backend->run;
    }

The stats names match those produced by "ps --libxo json".

=head2 METHODS

=head2 new

Initiates the backend object.

    my $backend=OSLV::MOnitor::Backend::FreeBSD->new(
        base_dir => $base_dir,
    );

The following arguments are usable.

    - base_dir :: Path to use for the base dir, where the proc
            cache, freebsd_proc_cache.json, is is created.
        Default :: /var/cache/oslv_monitor

    - obj :: The OSLVM::Monitor object.

=cut

sub new {
	my ( $blank, %opts ) = @_;

	if ( !defined( $opts{base_dir} ) ) {
		$opts{base_dir} = '/var/cache/oslv_monitor';
	}

	if ( !defined( $opts{obj} ) ) {
		die('$opts{obj} is undef');
	} elsif ( ref( $opts{obj} ) ne 'OSLV::Monitor' ) {
		die('ref $opts{obj} is not OSLV::Monitor');
	}

	my $self = { version => 1, proc_cache => $opts{base_dir} . '/freebsd_proc_cache.json', obj => $opts{obj} };
	bless $self;

	return $self;
} ## end sub new

=head2 run

    $return_hash_ref=$backend->run;

=cut

sub run {
	my $self = $_[0];

	my $data = {
		errors        => [],
		cache_failure => 0,
		oslvms        => {},
		has           => {
			'linux_mem_stats' => 0,
			'rwdops'          => 0,
			'rwdbytes'        => 0,
			'rwdblocks'       => 1,
			'signals-taken'   => 1,
			'recv_sent_msgs'  => 1,
			'cows'            => 1,
			'stack-size'      => 1,
			'swaps'           => 1,
			'sock'            => 0,
		},
		totals => {
			'copy-on-write-faults'         => 0,
			'cpu-time'                     => 0,
			'data-size'                    => 0,
			'elapsed-times'                => 0,
			'involuntary-context-switches' => 0,
			'major-faults'                 => 0,
			'minor-faults'                 => 0,
			'percent-cpu'                  => 0,
			'percent-memory'               => 0,
			'read-blocks'                  => 0,
			'received-messages'            => 0,
			'rss'                          => 0,
			'sent-messages'                => 0,
			'stack-size'                   => 0,
			'swaps'                        => 0,
			'system-time'                  => 0,
			'text-size'                    => 0,
			'user-time'                    => 0,
			'virtual-size'                 => 0,
			'voluntary-context-switches'   => 0,
			'written-blocks'               => 0,
			'procs'                        => 0,
			'signals-taken'                => 0,
		},
	};

	my $proc_cache;
	my $new_proc_cache = {};
	my $cache_is_new   = 0;
	if ( -f $self->{proc_cache} ) {
		if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
			warn(     'DEBUG, '
					. join( '.', gettimeofday )
					. ': backend run loading proc cache "'
					. $self->{proc_cache}
					. '"' );
		}
		eval {
			my $raw_cache = read_file( $self->{proc_cache} );
			$proc_cache = decode_json($raw_cache);
		};
		if ($@) {
			if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
				warn(     'DEBUG, '
						. join( '.', gettimeofday )
						. ': backend run proc cache "'
						. $self->{proc_cache}
						. '" could not be loaded... '
						. $@ );
			}
			push(
				@{ $data->{errors} },
				'reading proc cache "' . $self->{proc_cache} . '" failed... using a empty one...' . $@
			);
			$data->{cache_failure} = 1;
			$proc_cache = {};
			return $data;
		} ## end if ($@)
	} else {
		if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
			warn( 'DEBUG, ' . join( '.', gettimeofday ) . ': backend run proc cache is new' );
		}
		$cache_is_new = 1;
	}

	my $base_stats = {
		'copy-on-write-faults'         => 0,
		'cpu-time'                     => 0,
		'data-size'                    => 0,
		'elapsed-times'                => 0,
		'involuntary-context-switches' => 0,
		'major-faults'                 => 0,
		'minor-faults'                 => 0,
		'percent-cpu'                  => 0,
		'percent-memory'               => 0,
		'read-blocks'                  => 0,
		'received-messages'            => 0,
		'rss'                          => 0,
		'sent-messages'                => 0,
		'stack-size'                   => 0,
		'swaps'                        => 0,
		'system-time'                  => 0,
		'text-size'                    => 0,
		'user-time'                    => 0,
		'virtual-size'                 => 0,
		'voluntary-context-switches'   => 0,
		'written-blocks'               => 0,
		'procs'                        => 0,
		'signals-taken'                => 0,
		'ip'                           => [],
		'path'                         => [],
	};

	# get a list of jails for jid to name mapping
	if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
		warn(     'DEBUG, '
				. join( '.', gettimeofday )
				. ': backend run calling "/usr/sbin/jls -h --libxo json 2> /dev/null"' );
	}
	my $output = `/usr/sbin/jls -h --libxo json 2> /dev/null`;
	if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
		warn(     'DEBUG, '
				. join( '.', gettimeofday )
				. ': backend run "/usr/sbin/jls -h --libxo json 2> /dev/null" finished' );
	}
	my $jls;
	my @IP_keys = ( 'ip4.addr', 'ip6.addr' );
	eval { $jls = decode_json($output) };
	if ($@) {
		push( @{ $data->{errors} }, 'decoding output from "jls -h --libxo json 2> /dev/null" failed... ' . $@ );
		return $data;
	}
	if (   defined($jls)
		&& ref($jls) eq 'HASH'
		&& defined( $jls->{'jail-information'} )
		&& ref( $jls->{'jail-information'} ) eq 'HASH'
		&& defined( $jls->{'jail-information'}{jail} )
		&& ref( $jls->{'jail-information'}{jail} ) eq 'ARRAY' )
	{
		foreach my $jls_jail ( @{ $jls->{'jail-information'}{jail} } ) {
			if ( defined( $jls_jail->{name} ) && defined( $jls_jail->{jid} ) ) {
				if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
					warn(     'DEBUG, '
							. join( '.', gettimeofday )
							. ': backend run processing jname="'
							. $jls_jail->{name}
							. '" jid="'
							. $jls_jail->{jid}
							. '"' );
				}

				my $jname        = $jls_jail->{name};
				my $include_jail = $self->{'obj'}->include($jname);

				if ($include_jail) {
					if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
						warn( 'DEBUG, ' . join( '.', gettimeofday ) . ': backend run calling clone($base_stats)' );
					}

					$data->{oslvms}{$jname} = clone($base_stats);

					if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
						warn( 'DEBUG, ' . join( '.', gettimeofday ) . ': backend run done clone($base_stats) done' );
					}

					# finds each ip ifconfig shows in a jail
					if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
						warn(     'DEBUG, '
								. join( '.', gettimeofday )
								. ': backend run calling "ifconfig -j '
								. $jname
								. ' 2> /dev/null"' );
					}
					my $output = `ifconfig -j $jname 2> /dev/null`;
					my %found_IPv4;
					my %found_IPv6;
					if ( $? eq 0 ) {
						if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
							warn(     'DEBUG, '
									. join( '.', gettimeofday )
									. ': backend run processing ifconfig info for jail' );
						}
						my @output_split = split( /\n/, $output );
						my $interface;
						foreach my $line (@output_split) {
							if ( $line =~ /^[a-zA-Z].*\:[\ \t]+flags\=/ ) {
								$interface = $line;
								$interface =~ s/\:[\ \t]+flags.*//;
							} elsif ( $line =~ /^[\ \t]+inet6 /
								&& defined($interface) )
							{
								$line =~ s/^[\ \t]+inet6 //;
								$line =~ s/\ .*$//;
								$line =~ s/\%.*$//;
								$found_IPv6{$line} = $interface;
							} elsif ( $line =~ /^[\ \t]+inet /
								&& defined($interface) )
							{
								$line =~ s/^[\ \t]+inet //;
								$line =~ s/ .*$//;
								$found_IPv4{$line} = $interface;
							}
						} ## end foreach my $line (@output_split)
					} elsif ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
						warn( 'DEBUG, ' . join( '.', gettimeofday ) . ': backend run ifconfig exited non-zero' );
					}
					## end if ( $? eq 0 )

					foreach my $ip_key (@IP_keys) {
						my @current_IPs;

						if ( $ip_key eq 'ip4.addr' ) {
							@current_IPs = keys(%found_IPv4);
						} else {
							@current_IPs = keys(%found_IPv6);
						}

						if (   defined( $jls_jail->{$ip_key} )
							&& ref( $jls_jail->{$ip_key} ) eq 'ARRAY'
							&& defined( $jls_jail->{$ip_key}[0] ) )
						{
							foreach my $ip ( @{ $jls_jail->{$ip_key} } ) {
								if ( ref($ip) eq '' && !defined( $found_IPv4{$ip} ) && !defined( $found_IPv6{$ip} ) ) {
									if (   $ip =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/
										|| $ip =~ /^[\:0-9a-fA-F]+$/ )
									{
										push( @current_IPs, $ip );
									}
								}
							}
						} ## end if ( defined( $jls_jail->{$ip_key} ) && ref...)
						foreach my $ip (@current_IPs) {
							my $ip_if;
							my $ip_gw;
							my $ip_gw_if;

							if ( $ip_key eq 'ip4.addr'
								&& defined( $found_IPv4{$ip} ) )
							{
								$ip_if = $found_IPv4{$ip};
							} elsif ( $ip_key eq 'ip6.addr'
								&& defined( $found_IPv6{$ip} ) )
							{
								$ip_if = $found_IPv6{$ip};
							}
							# set the ip type flag for netstat
							my $ip_flag = '-6';
							if ( $ip_key eq 'ip4.addr' ) {
								$ip_flag = '-4';
							}

							# fetch route info for the jail
							if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
								warn(     'DEBUG, '
										. join( '.', gettimeofday )
										. ': backend run calling "route -n -j '
										. $jname . ' '
										. $ip_flag
										. ' show default 2> /dev/null"' );
							}
							my $output = `route -n -j $jname $ip_flag show default 2> /dev/null`;
							if ( $? eq 0 ) {
								my @output_split = split( /\n/, $output );
								foreach my $line (@output_split) {
									if ( $line =~ /gateway\:[\ \t]/ ) {
										$line =~ s/.*gateway\:[\ \t]+//;
										$line =~ s/[\ \t]*$//;
										$ip_gw = $line;
									} elsif ( $line =~ /interface:[\ \t]/ ) {
										$line =~ s/.*interface\:[\ \t]+//;
										$line =~ s/[\ \t]*$//;
										$ip_gw_if = $line;
									}
								} ## end foreach my $line (@output_split)
							} elsif ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
								warn( 'DEBUG, ' . join( '.', gettimeofday ) . ': backend run route exited non-zero' );
							}

							push(
								@{ $data->{oslvms}{$jname}{ip} },
								{
									ip    => $ip,
									if    => $ip_if,
									gw    => $ip_gw,
									gw_if => $ip_gw_if,
								}
							);
						} ## end foreach my $ip (@current_IPs)
					} ## end foreach my $ip_key (@IP_keys)
				} ## end if ($include_jail)
			} ## end if ( defined( $jls_jail->{name} ) && defined...)
		} ## end foreach my $jls_jail ( @{ $jls->{'jail-information'...}})
	} ## end if ( defined($jls) && ref($jls) eq 'HASH' ...)

	# remove possible dup paths
	my @found_jails = keys( %{ $data->{oslvms} } );
	foreach my $jail (@found_jails) {
		my @uniq_paths = uniq( @{ $data->{oslvms}{$jail}{path} } );
		$data->{oslvms}{$jail}{path} = \@uniq_paths;
	}

	my @stats = (
		'copy-on-write-faults',         'cpu-time',
		'data-size',                    'elapsed-times',
		'involuntary-context-switches', 'major-faults',
		'minor-faults',                 'percent-cpu',
		'percent-memory',               'read-blocks',
		'received-messages',            'rss',
		'sent-messages',                'stack-size',
		'swaps',                        'system-time',
		'text-size',                    'user-time',
		'virtual-size',                 'voluntary-context-switches',
		'written-blocks',               'signals-taken',
	);

	# values that are time stats that require additional processing
	my $times = { 'cpu-time' => 1, 'system-time' => 1, 'user-time' => 1, };
	# these are counters and differences needed computed for them
	my $counters = {
		'cpu-time'                     => 1,
		'system-time'                  => 1,
		'user-time'                    => 1,
		'read-blocks'                  => 1,
		'major-faults'                 => 1,
		'involuntary-context-switches' => 1,
		'minor-faults'                 => 1,
		'received-messages'            => 1,
		'sent-messages'                => 1,
		'swaps'                        => 1,
		'voluntary-context-switches'   => 1,
		'written-blocks'               => 1,
		'copy-on-write-faults'         => 1,
		'signals-taken'                => 1,
	};

	foreach my $jail (@found_jails) {
		if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
			warn(     'DEBUG, '
					. join( '.', gettimeofday )
					. ': backend run calling "/bin/ps ax --libxo json -o %cpu,%mem,pid,acflag,cow,dsiz,etimes,inblk,jail,majflt,minflt,msgrcv,msgsnd,nivcsw,nswap,nvcsw,oublk,rss,ssiz,systime,time,tsiz,usertime,vsz,pid,gid,uid,command,nsigs -J '
					. $jail
					. ' 2> /dev/null"' );
		}
		$output
			= `/bin/ps ax --libxo json -o %cpu,%mem,pid,acflag,cow,dsiz,etimes,inblk,jail,majflt,minflt,msgrcv,msgsnd,nivcsw,nswap,nvcsw,oublk,rss,ssiz,systime,time,tsiz,usertime,vsz,pid,gid,uid,command,nsigs -J $jail 2> /dev/null`;
		my $ps;
		eval { $ps = decode_json($output); };
		if ( !$@ ) {
			if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
				warn(     'DEBUG, '
						. join( '.', gettimeofday )
						. ': backend run processing proc info for jail '
						. $jail
						. '' );
			}
			foreach my $proc ( @{ $ps->{'process-information'}{process} } ) {
				if ( $proc->{'elapsed-times'} ne '-' ) {
					my $cache_name
						= $proc->{pid} . '-' . $proc->{uid} . '-' . $proc->{gid} . '-' . $jail . '-' . $proc->{command};

					foreach my $stat (@stats) {
						my $stat_value = $proc->{$stat};
						# pre-process the stat if it is a time value that requires it
						if ( $times->{$stat} ) {
							# [days-][hours:]minutes:seconds
							my $seconds = 0;
							my $time    = $stat_value;

							if ( $time =~ /-/ ) {
								my $days = $time;
								$days =~ s/\-.*$//;
								$time =~ s/^.*\-//;
								$seconds = $seconds + ( $days * 86400 );
							}
							my @time_split = split( /\:/, $time );
							if ( defined( $time_split[2] ) ) {
								$seconds
									= $seconds + ( 3600 * $time_split[0] ) + ( 60 * $time_split[1] ) + $time_split[2];
							} else {
								$seconds = $seconds + ( 60 * $time_split[1] ) + $time_split[1];
							}
							$stat_value = $seconds;
							$proc->{$stat} = $stat_value;
						} ## end if ( $times->{$stat} )

						if ( looks_like_number($stat_value) ) {
							if ( $counters->{$stat} ) {
								if (   defined( $proc_cache->{$cache_name} )
									&& defined( $proc_cache->{$cache_name}{$stat} ) )
								{
									$stat_value = ( $stat_value - $proc_cache->{$cache_name}{$stat} ) / 300;
								} else {
									$stat_value = $stat_value / 300;
								}
								$data->{oslvms}{$jail}{$stat}
									= $data->{oslvms}{$jail}{$stat} + $stat_value;
								$data->{totals}{$stat} = $data->{totals}{$stat} + $stat_value;
							} else {
								$data->{oslvms}{$jail}{$stat}
									= $data->{oslvms}{$jail}{$stat} + $stat_value;
								$data->{totals}{$stat} = $data->{totals}{$stat} + $stat_value;
							}
						} else {
							warn( '"' . $stat_value . '" for ' . $stat . ' does not appear numeric' );
						}
					} ## end foreach my $stat (@stats)

					$data->{oslvms}{$jail}{procs}++;
					$data->{totals}{procs}++;

					$new_proc_cache->{$cache_name} = $proc;
				} ## end if ( $proc->{'elapsed-times'} ne '-' )
			} ## end foreach my $proc ( @{ $ps->{'process-information'...}})
		} ## end if ( !$@ )
	} ## end foreach my $jail (@found_jails)

	# save the proc cache for next run
	if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
		warn(     'DEBUG, '
				. join( '.', gettimeofday )
				. ': backend run writing proc cache to "'
				. $self->{proc_cache}
				. '"' );
	}
	eval { write_file( $self->{proc_cache}, encode_json($new_proc_cache) ); };
	if ($@) {
		if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
			warn(     'DEBUG, '
					. join( '.', gettimeofday )
					. ': backend run errored writing proc cache to "'
					. $self->{proc_cache} . '"... '
					. $@ );
		}
		push( @{ $data->{errors} }, 'saving proc cache failed, "' . $self->{proc_cache} . '"... ' . $@ );
	} ## end if ($@)

	if ($cache_is_new) {
		if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
			warn(     'DEBUG, '
					. join( '.', gettimeofday )
					. ': backend run cache is new so not returning any oslvm info and zeroing totals' );
		}
		delete( $data->{oslvms} );
		$data->{oslvms} = {};
		my @total_keys = keys( %{ $data->{totals} } );
		foreach my $total_key (@total_keys) {
			if ( ref( $data->{totals}{$total_key} ) eq '' ) {
				$data->{totals}{$total_key} = 0;
			}
		}
	} ## end if ($cache_is_new)

	if ( $ENV{'OSLV_MONITOR_DEBUG'} ) {
		warn( 'DEBUG, ' . join( '.', gettimeofday ) . ': backend run done' );
	}

	return $data;
} ## end sub run

=head2 usable

Dies if not usable.

    eval{ $backend->usable; };
    if ( $@ ){
        print 'Not usable because... '.$@."\n";
    }

=cut

sub usable {
	my $self = $_[0];

	# make sure it is freebsd
	if ( $^O !~ 'freebsd' ) {
		die '$^O is "' . $^O . '" and not "freebsd"';
	}

	# make sure we can locate jls
	my $cmd_bin = `/bin/sh -c 'which jls 2> /dev/null'`;
	if ( $? != 0 ) {
		die 'The command "jls" is not in the path... ' . $ENV{PATH};
	}

	return 1;
} ## end sub usable

sub ip_to_if {
	my $self = $_[0];
	my $ip   = $_[1];

	if ( !defined($ip) || ref($ip) ne '' ) {
		return undef;
	}

	my $if = IO::Interface::Simple->new_from_address($ip);

	if ( !defined($if) ) {
		return undef;
	}

	return $if->name;
} ## end sub ip_to_if

=head1 AUTHOR

Zane C. Bowers-Hadley, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc OSLV::Monitor


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2024 by Zane C. Bowers-Hadley.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)


=cut

1;    # End of OSLV::Monitor