ngcp-panel/lib/NGCP/Panel/Utils/License.pm

310 lines
7.6 KiB

package NGCP::Panel::Utils::License;
use strict;
use warnings;
use Sipwise::Base;
use List::Util qw(none);
use Fcntl;
use IO::Select;
sub get_license_status {
my ($c, $ref) = @_;
my $fd;
{
no autodie qw(sysopen);
if (!sysopen($fd, '/proc/ngcp/check', O_NONBLOCK|O_RDONLY)) {
$c->log->error('License status check failed: could not check license')
unless $c->config->{general}{ngcp_type} eq 'spce';
return 'missing';
}
}
my $status = '';
my @h = IO::Select->new($fd)->can_read(1);
map { $status = <$_> } @h;
close($fd);
unless ($status) {
$c->log->error('License status check failed: missing license');
return 'missing';
}
chomp($status);
if ($status =~ /^ok/) {
return 'ok';
}
if ($status =~ /missing license/) {
$c->log->error("License status check failed: $status");
return 'missing';
}
if ($status =~ /^(warning|error) \((.*)\)$/) {
if (ref($ref) eq 'SCALAR') {
$$ref = $status;
}
if ($status =~ /^warning/) {
# do not spam logs with warnings as it's related to graceful thresholds
} else {
$c->log->error("License status check failed: $status");
}
return $status;
}
if (ref($ref) eq 'SCALAR') {
$$ref = 'internal error';
}
$c->log->error("License status check failed: internal error");
return 'error';
}
sub is_license_status {
my $c = shift;
my @allowed = @_;
my $status = get_license_status($c);
return scalar grep {$_ eq $status} @allowed;
}
sub is_license_error {
my $c = shift;
my @allowed = @_;
@allowed or @allowed = ('error');
my $ext;
my $status = get_license_status($c, \$ext);
if (!grep {$_ eq $status} @allowed) {
return 0;
}
return $ext || $status;
}
sub get_license {
my ($c, $lic_name) = @_;
return 1 if $c->config->{general}{ngcp_type} eq 'spce';
my $proc_dir = '/proc/ngcp/flags';
unless (-d $proc_dir) {
$c->log->error("Failed to access $proc_dir")
unless $c->config->{general}{ngcp_type} eq 'spce';
return;
};
my $lic_file = $proc_dir . '/' . $lic_name;
return unless (-r $lic_file);
sysopen(my $fd, "$lic_file", O_NONBLOCK|O_RDONLY) || do {
$c->log->error("Failed to open license file $lic_name: $!");
return;
};
my $enabled;
my @h = IO::Select->new($fd)->can_read(1);
map { $enabled = <$_> } @h;
close $fd;
chomp($enabled) if defined $enabled;
return $enabled;
}
sub get_licenses {
my $c = shift;
my $proc_dir = '/proc/ngcp/flags';
unless (-d $proc_dir) {
$c->log->error("Failed to access $proc_dir")
unless $c->config->{general}{ngcp_type} eq 'spce';
return;
};
my @lics = ();
opendir(my $dh, $proc_dir) || do {
$c->log->error("Failed to open licenses dir $proc_dir: $!");
return;
};
while (readdir($dh)) {
my $lf = $_;
next if $lf =~ /^\.+$/;
sysopen(my $fd, "$proc_dir/$lf", O_NONBLOCK|O_RDONLY) || do {
$c->log->error("Failed to open license file $lf: $!");
next;
};
my $enabled;
my @h = IO::Select->new($fd)->can_read(1);
map { $enabled = <$_> } @h;
close $fd;
chomp($enabled) if defined $enabled;
push @lics, $lf if $enabled && $enabled == 1;
}
closedir $dh;
my @sorted_lics = sort @lics;
return \@sorted_lics;
}
sub get_license_meta {
my $c = shift;
my $proc_dir = '/proc/ngcp';
unless (-d $proc_dir) {
$c->log->error("Failed to access $proc_dir")
unless $c->config->{general}{ngcp_type} eq 'spce';
return;
};
my $meta = {};
my @collect = qw(
check
current_calls
current_pbx_groups
current_pbx_subscribers
current_registered_subscribers
current_subscribers
license_valid_until
max_calls
max_pbx_groups
max_pbx_subscribers
max_registered_subscribers
max_subscribers
valid
);
opendir(my $dh, $proc_dir) || do {
$c->log->error("Failed to open ngcp dir $proc_dir: $!");
return;
};
while (readdir($dh)) {
my $lf = $_;
next if $lf =~ /^\.+$/;
next if none { $lf eq $_ } @collect;
sysopen(my $fd, "$proc_dir/$lf", O_NONBLOCK|O_RDONLY) || do {
$c->log->error("Failed to open license file $lf: $!");
next;
};
my $value;
my @h = IO::Select->new($fd)->can_read(1);
map { $value = <$_> } @h;
close $fd;
chomp($value) if defined $value;
$meta->{$lf} = $value =~ /^-?\d+(\.\d+)?$/ ? $value+0 : $value;
}
closedir $dh;
return $meta;
}
sub get_license_count_type {
my ($c, $type, $lic) = @_;
return -1 if $c->config->{general}{ngcp_type} eq 'spce';
my $proc_dir = '/proc/ngcp';
unless (-d $proc_dir) {
$c->log->error("Failed to access $proc_dir");
return 0;
};
my $lic_file = $proc_dir . '/' . $type . '_' . $lic;
return unless (-r $lic_file);
sysopen(my $fd, "$lic_file", O_NONBLOCK|O_RDONLY) || do {
$c->log->error("Failed to open license file $lic_file: $!");
return 0;
};
my $value;
my @h = IO::Select->new($fd)->can_read(1);
map { $value = <$_> } @h;
close $fd;
chomp($value) if defined $value;
return -1 if $value eq 'unlimited';
return $value ? $value+0 : 0;
}
sub get_max_pbx_groups {
my ($c) = @_;
return get_license_count_type($c, 'max', 'pbx_groups');
}
sub get_max_pbx_subscribers {
my ($c) = @_;
return get_license_count_type($c, 'max', 'pbx_subscribers');
}
sub get_max_subscribers {
my ($c) = @_;
return get_license_count_type($c, 'max', 'subscribers');
}
sub get_current_pbx_groups {
my ($c) = @_;
return get_license_count_type($c, 'current', 'pbx_groups');
}
sub get_current_pbx_subscribers {
my ($c) = @_;
return get_license_count_type($c, 'current', 'pbx_subscribers');
}
sub get_current_subscribers {
my ($c) = @_;
return get_license_count_type($c, 'current', 'subscribers');
}
1;
=head1 NAME
NGCP::Panel::Utils::License
=head1 DESCRIPTION
Helper module for license handling
=head1 METHODS
=head2 get_license_status
Performs the actual check of the license status. Returns one of:
'missing': No license data present.
'ok': License present and all limits observed.
'warning': License present but some limits exceeded within the grace thresholds.
'error': License limits exceeded beyond the grace thresholds, or internal error.
A reference to a scalar can be passed as an optional first argument, in which case
a more detailed status description is written into that scalar in the 'warning'
and 'error' cases.
Example:
my $status = get_license_status($c, \$ext_status);
=head2 is_license_status
Takes a list of strings as argument list. Returns true or false if the license
status is one of the status names given in the argument list.
Example:
if (is_license_status($c, qw(missing error))) ...
=head2 is_license_error
Similar to is_license_status($c) but returns the status string instead of true if
the license status is one of the values given. If the argument list is empty, it
defaults to ('error').
Example:
if (my $status = is_license_error($c)) ...
=head1 AUTHOR
Richard Fuchs
=head1 LICENSE
This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
# vim: set tabstop=4 expandtab: