- reworked /bin/* provisioning scripts to use NGCP::API::Client
- completely reworked ngcp-fraud-* ngcp-credit-warning scripts
Change-Id: I416847c5c1d3e7dda5695d700a03182fa47f5b24
(cherry picked from commit 3d65648d9f
)
changes/55/5555/1
parent
7b68db7c31
commit
9f394cac51
@ -1,61 +1,232 @@
|
|||||||
#!/usr/bin/perl -w
|
#!/usr/bin/perl
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use English;
|
||||||
use Email::Sender::Simple qw(sendmail);
|
use Getopt::Long;
|
||||||
|
use Pod::Usage;
|
||||||
|
use NGCP::API::Client;
|
||||||
|
use Readonly;
|
||||||
use XML::Simple;
|
use XML::Simple;
|
||||||
use Sipwise::DB;
|
use Template;
|
||||||
use Sipwise::Provisioning::Config;
|
use Email::Sender::Simple qw();
|
||||||
|
use Email::Simple;
|
||||||
|
use Email::Simple::Creator;
|
||||||
|
use Email::Sender::Transport::Sendmail qw();
|
||||||
|
|
||||||
my $MTA = '/usr/sbin/sendmail -oi -t';
|
Readonly my @required => qw();
|
||||||
|
Readonly my $config_file => '/etc/ngcp-panel/provisioning.conf';
|
||||||
|
|
||||||
sub main;
|
my $opts = {
|
||||||
|
verbose => 0,
|
||||||
|
};
|
||||||
|
|
||||||
main;
|
my $config;
|
||||||
|
|
||||||
sub main {
|
GetOptions( $opts,
|
||||||
my $xs = new XML::Simple;
|
"help|h" => \&usage,
|
||||||
my $conf = Sipwise::Provisioning::Config->new()->get_config();
|
"verbose",
|
||||||
my $db = new Sipwise::DB ( $$conf{billingdb} );
|
) or usage();
|
||||||
|
|
||||||
$$conf{credit_warnings} = [ $$conf{credit_warnings} ]
|
sub check_params {
|
||||||
if defined eval { %{$$conf{credit_warnings}} };
|
my @missing;
|
||||||
|
foreach my $param (@required) {
|
||||||
foreach my $domcfg (@{$$conf{credit_warnings}}) {
|
push @missing, $param unless $opts->{$param};
|
||||||
|
}
|
||||||
my $contracts = $db->sql_get_all_arrayref("
|
usage(join(' ', @missing)) if scalar @missing;
|
||||||
SELECT a.contract_id,a.cash_balance,a.cash_balance_interval,GROUP_CONCAT(c.username,'\@',d.domain) AS subscribers
|
return;
|
||||||
FROM contract_balances a, contracts b,voip_subscribers c, domains d
|
}
|
||||||
WHERE a.start = DATE_FORMAT(now(), '%Y-%m-01 00:00:00')
|
|
||||||
AND a.contract_id = b.id
|
sub usage {
|
||||||
AND b.status != 'terminated'
|
my $msg = shift;
|
||||||
AND a.contract_id = c.contract_id
|
pod2usage(-exitval => $msg ? 1 : 0,
|
||||||
AND c.domain_id = d.id
|
-verbose => 99,
|
||||||
AND d.domain = ?
|
-sections => [ qw(NAME OPTIONS USAGE) ],
|
||||||
AND c.status != 'terminated'
|
-message => $msg
|
||||||
AND a.cash_balance < ?
|
? $msg =~ /not found/i
|
||||||
GROUP BY contract_id
|
? $msg
|
||||||
", $$domcfg{domain}, $$domcfg{threshold});
|
: "Missing parameters: $msg"
|
||||||
if(@$contracts) {
|
: '',
|
||||||
$$domcfg{recipients} = [ $$domcfg{recipients} ]
|
);
|
||||||
unless defined eval { @{$$domcfg{recipients}} };
|
return;
|
||||||
|
}
|
||||||
my $mailtxt;
|
|
||||||
$mailtxt .= "Credit threshold warning for: $$domcfg{domain}\nThe following contracts are below the configured threshold of $$domcfg{threshold} cent:\n\n";
|
sub load_config {
|
||||||
$mailtxt .= "account_id\tcash_balance\tcash_balance_interval\tsubscribers\n";
|
$config = XML::Simple->new()->XMLin($config_file, ForceArray => 0)
|
||||||
for(@$contracts) {
|
or die "Cannot load config: $config_file: $ERRNO";
|
||||||
$mailtxt .= "$$_{contract_id}\t$$_{cash_balance}\t$$_{cash_balance_interval}\t$$_{subscribers}\n";
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
sendmail ( Email::Simple->create(
|
sub send_email {
|
||||||
|
my ($cwarning, $contracts) = @_;
|
||||||
|
|
||||||
|
my $template = get_email_template() || return;
|
||||||
|
|
||||||
|
my $vars = { domain => $cwarning->{domain},
|
||||||
|
threshold => $cwarning->{threshold},
|
||||||
|
adminmail => $config->{adminmail} };
|
||||||
|
|
||||||
|
foreach my $data (@{$contracts}) {
|
||||||
|
$vars->{contracts} .= sprintf <<EOF, @{$data}{qw(id cash_balance)};
|
||||||
|
contract_id: %s cash_balance: %s
|
||||||
|
EOF
|
||||||
|
}
|
||||||
|
|
||||||
|
my $tt = Template->new();
|
||||||
|
map { my $out;
|
||||||
|
$tt->process(\$template->{$_}, $vars, \$out);
|
||||||
|
$out and $template->{$_} = $out;
|
||||||
|
} keys %{$template};
|
||||||
|
|
||||||
|
my $transport = Email::Sender::Transport::Sendmail->new;
|
||||||
|
my $email = Email::Simple->create(
|
||||||
header => [
|
header => [
|
||||||
To => join(', ', @{$$domcfg{recipients}}),
|
To => ref $cwarning->{recipients} eq 'ARRAY'
|
||||||
From => $$conf{adminmail},
|
? join(', ', @{$cwarning->{recipients}})
|
||||||
Subject => 'Sipwise NGCP credit threshold notification',
|
: $cwarning->{recipients},
|
||||||
|
From => $template->{from_email},
|
||||||
|
Subject => $template->{subject},
|
||||||
],
|
],
|
||||||
body => $mailtxt,
|
body => $template->{body},
|
||||||
));
|
);
|
||||||
|
|
||||||
|
Email::Sender::Simple->send($email, { transport => $transport })
|
||||||
|
or die sprintf "Cannot send credit warning notification to %s: $ERRNO",
|
||||||
|
$email->header('To');
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_data {
|
||||||
|
my ($uri, $link) = @_;
|
||||||
|
my $client = new NGCP::API::Client;
|
||||||
|
$client->set_verbose($opts->{verbose});
|
||||||
|
my $res = $client->request("GET", $uri);
|
||||||
|
die $res->result unless $res->is_success;
|
||||||
|
my $res_hash = $res->as_hash;
|
||||||
|
return [] unless $res_hash->{total_count} && $res_hash->{total_count} > 0;
|
||||||
|
my $data = $res_hash->{_embedded}{'ngcp:'.$link};
|
||||||
|
return ref $data eq 'ARRAY' ? $data : [ $data ];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_email_template {
|
||||||
|
my $templates_data = get_data('/api/emailtemplates/', 'emailtemplates');
|
||||||
|
foreach my $template (@{$templates_data}) {
|
||||||
|
next unless $template->{name} eq 'credit_warning_default_email';
|
||||||
|
return $template;
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub main {
|
||||||
|
check_params();
|
||||||
|
load_config();
|
||||||
|
my $cwarnings = ref $config->{credit_warnings} eq 'ARRAY'
|
||||||
|
? $config->{credit_warnings}
|
||||||
|
: [ $config->{credit_warnings} ];
|
||||||
|
foreach my $cwarning (@{$cwarnings}) {
|
||||||
|
unless ($cwarning->{recipients}) {
|
||||||
|
die "No recipients defined for domain: $cwarning->{domain}";
|
||||||
}
|
}
|
||||||
|
unless ($cwarning->{domain}) {
|
||||||
|
die "Missing domain in a credit warning check";
|
||||||
}
|
}
|
||||||
|
my @contracts;
|
||||||
|
my $balances =
|
||||||
|
get_data(sprintf('/api/customerbalances/?domain=%s',
|
||||||
|
$cwarning->{domain}),
|
||||||
|
'customerbalances');
|
||||||
|
foreach my $balance (@{$balances}) {
|
||||||
|
next if $balance->{cash_balance} >= $cwarning->{threshold};
|
||||||
|
push @contracts,
|
||||||
|
{ map { $_ => $balance->{$_} } qw(id cash_balance) };
|
||||||
}
|
}
|
||||||
|
if (@contracts) {
|
||||||
|
send_email($cwarning, \@contracts);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
main();
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
ngcp-credit-warning - checks for contract balances above credit warning thresholds
|
||||||
|
|
||||||
|
=head1 OPTIONS
|
||||||
|
|
||||||
|
=over 8
|
||||||
|
|
||||||
|
=item B<-help>
|
||||||
|
|
||||||
|
Print a brief help message.
|
||||||
|
|
||||||
|
=item B<-verbose>
|
||||||
|
|
||||||
|
Show additional debug information. Default false.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 USAGE
|
||||||
|
|
||||||
|
ngcp-credit-warning [options]
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
B<This program> checks for contract balances above credit warning thresholds and sends email notifications about the incidents
|
||||||
|
|
||||||
|
=head1 REQUIRED ARGUMENTS
|
||||||
|
|
||||||
|
None
|
||||||
|
|
||||||
|
=head1 EXIT STATUS
|
||||||
|
|
||||||
|
Exit code 0 means everything is ok otherwise 1.
|
||||||
|
|
||||||
|
=head1 CONFIGURATION
|
||||||
|
|
||||||
|
=head1 DIAGNOSTICS
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
NGCP::API::Client
|
||||||
|
|
||||||
|
=head1 DEPENDENCIES
|
||||||
|
|
||||||
|
ngcp-credit-warning relies on a bunch of Perl modules, all of them specified as
|
||||||
|
dependencies through the Debian package.
|
||||||
|
|
||||||
|
=head1 INCOMPATIBILITIES
|
||||||
|
|
||||||
|
No known at this time.
|
||||||
|
|
||||||
|
=head1 BUGS AND LIMITATIONS
|
||||||
|
|
||||||
|
Please report problems you notice to the Sipwise
|
||||||
|
Development Team <support@sipwise.com>.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Kirill Solomko <ksolomko@sipwise.com>
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
Copyright (C) 2016 Sipwise GmbH, Austria
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
|
(at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
@ -1,154 +1,259 @@
|
|||||||
#!/usr/bin/perl
|
#!/usr/bin/perl
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use English;
|
||||||
|
use Getopt::Long;
|
||||||
|
use Pod::Usage;
|
||||||
|
use NGCP::API::Client;
|
||||||
|
use Readonly;
|
||||||
|
use XML::Simple;
|
||||||
|
use Template;
|
||||||
|
use Email::Sender::Simple qw();
|
||||||
|
use Email::Simple;
|
||||||
|
use Email::Simple::Creator;
|
||||||
|
use Email::Sender::Transport::Sendmail qw();
|
||||||
|
|
||||||
|
Readonly my @required => qw();
|
||||||
|
Readonly my $config_file => '/etc/ngcp-panel/provisioning.conf';
|
||||||
|
Readonly my $interval => 'month';
|
||||||
|
|
||||||
|
my $opts = {
|
||||||
|
verbose => 0,
|
||||||
|
};
|
||||||
|
|
||||||
|
my $config;
|
||||||
|
|
||||||
|
GetOptions( $opts,
|
||||||
|
"help|h" => \&usage,
|
||||||
|
"verbose",
|
||||||
|
) or usage();
|
||||||
|
|
||||||
|
sub check_params {
|
||||||
|
my @missing;
|
||||||
|
foreach my $param (@required) {
|
||||||
|
push @missing, $param unless $opts->{$param};
|
||||||
|
}
|
||||||
|
usage(join(' ', @missing)) if scalar @missing;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
use Email::Sender::Simple qw(sendmail);
|
sub usage {
|
||||||
use Sipwise::Provisioning::Billing;
|
my $msg = shift;
|
||||||
|
pod2usage(-exitval => $msg ? 1 : 0,
|
||||||
my %LOCK = (
|
-verbose => 99,
|
||||||
none => undef,
|
-sections => [ qw(NAME OPTIONS USAGE) ],
|
||||||
foreign => 1,
|
-message => $msg
|
||||||
outgoing => 2,
|
? $msg =~ /not found/i
|
||||||
incoming => 3,
|
? $msg
|
||||||
global => 4,
|
: "Missing parameters: $msg"
|
||||||
0 => 'none',
|
: '',
|
||||||
1 => 'foreign',
|
|
||||||
2 => 'outgoing',
|
|
||||||
3 => 'incoming',
|
|
||||||
4 => 'global',
|
|
||||||
);
|
);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
my $conf = Sipwise::Provisioning::Config->new()->get_config();
|
sub load_config {
|
||||||
|
$config = XML::Simple->new()->XMLin($config_file, ForceArray => 0)
|
||||||
my $o = Sipwise::Provisioning::Billing->new();
|
or die "Cannot load config: $config_file: $ERRNO";
|
||||||
my $db = $o->{database};
|
return;
|
||||||
|
|
||||||
# We select only those billing profile hits which exceed the fraud limit and
|
|
||||||
# have an action attached to keep the number of result rows small.
|
|
||||||
# However, we select all account hits and manually check them later, as they
|
|
||||||
# can potentially override billing profile hits.
|
|
||||||
my $a = $db->sql_get_all_arrayref(<<"!");
|
|
||||||
SELECT bpinfo.type, bpinfo.id,
|
|
||||||
IF (bpinfo.fraud_use_reseller_rates > 0, SUM(cdr.source_reseller_cost),
|
|
||||||
SUM(cdr.source_customer_cost)) as interval_cost,
|
|
||||||
bpinfo.fraud_interval_limit, bpinfo.fraud_interval_lock, bpinfo.fraud_interval_notify
|
|
||||||
FROM (
|
|
||||||
SELECT contracts.id, bp.fraud_use_reseller_rates,
|
|
||||||
CASE WHEN cfp.fraud_interval_limit > 0 THEN 'account_limit'
|
|
||||||
ELSE 'profile_limit' END as type,
|
|
||||||
IF (cfp.fraud_interval_limit > 0, cfp.fraud_interval_limit, bp.fraud_interval_limit) as fraud_interval_limit,
|
|
||||||
IF (cfp.fraud_interval_limit > 0, cfp.fraud_interval_lock, bp.fraud_interval_lock) as fraud_interval_lock,
|
|
||||||
IF (cfp.fraud_interval_limit > 0, cfp.fraud_interval_notify, bp.fraud_interval_notify) as fraud_interval_notify
|
|
||||||
FROM billing.contracts
|
|
||||||
JOIN billing.billing_profiles bp
|
|
||||||
ON (bp.id =
|
|
||||||
(SELECT m.billing_profile_id
|
|
||||||
FROM billing.billing_mappings m
|
|
||||||
USE INDEX (contractid_idx)
|
|
||||||
JOIN products pr ON pr.id = m.product_id
|
|
||||||
WHERE ((m.start_date IS NULL) OR (m.start_date <= NOW()))
|
|
||||||
AND ((m.end_date IS NULL) OR (m.end_date >= NOW()))
|
|
||||||
AND (m.contract_id = contracts.id)
|
|
||||||
AND (pr.class IN ('sipaccount', 'pbxaccount') OR pr.class IS NULL)
|
|
||||||
ORDER BY m.start_date DESC LIMIT 1
|
|
||||||
)
|
|
||||||
)
|
|
||||||
LEFT JOIN billing.contract_fraud_preferences cfp ON cfp.contract_id = contracts.id
|
|
||||||
WHERE (contracts.status = 'active')
|
|
||||||
AND (cfp.fraud_interval_limit > 0 OR bp.fraud_interval_limit > 0)
|
|
||||||
) as bpinfo
|
|
||||||
JOIN accounting.cdr ON cdr.source_account_id = bpinfo.id
|
|
||||||
WHERE cdr.start_time BETWEEN UNIX_TIMESTAMP(DATE_FORMAT(NOW(), '%Y-%m-01 00:00:00'))
|
|
||||||
AND UNIX_TIMESTAMP(DATE_FORMAT(NOW() + INTERVAL 1 MONTH, '%Y-%m-01 00:00:00'))-1
|
|
||||||
GROUP BY bpinfo.id
|
|
||||||
HAVING interval_cost >= fraud_interval_limit
|
|
||||||
AND (fraud_interval_lock > 0 OR fraud_interval_notify <> '')
|
|
||||||
!
|
|
||||||
|
|
||||||
my $x = {};
|
|
||||||
for my $e (@{ $a }) {
|
|
||||||
if(exists $x->{$e->{id}}) {
|
|
||||||
if($x->{$e->{id}}->{type} eq 'profile_limit' && $e->{type} eq 'account_limit') {
|
|
||||||
|
|
||||||
# if account limit hits and it has lock and/or notify, mark for action
|
|
||||||
if(defined $e->{fraud_interval_limit} and
|
|
||||||
int($e->{interval_cost}) >= int($e->{fraud_interval_limit}) and
|
|
||||||
($e->{fraud_interval_lock} || $e->{fraud_interval_notify})) {
|
|
||||||
|
|
||||||
$x->{$e->{id}} = $e;
|
|
||||||
} else {
|
|
||||||
# we have account fraud prefs set, but either the limit is not reached
|
|
||||||
# or no actions are necessary, let it slip through, overriding
|
|
||||||
# billing profile fraud settings
|
|
||||||
delete $x->{$e->{id}};
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub get_data {
|
||||||
|
my ($uri, $link) = @_;
|
||||||
|
my $client = new NGCP::API::Client;
|
||||||
|
$client->set_verbose($opts->{verbose});
|
||||||
|
my $res = $client->request("GET", $uri);
|
||||||
|
die $res->result unless $res->is_success;
|
||||||
|
my $res_hash = $res->as_hash;
|
||||||
|
return [] unless $res_hash->{total_count} && $res_hash->{total_count} > 0;
|
||||||
|
my $data = $res_hash->{_embedded}{'ngcp:'.$link};
|
||||||
|
return ref $data eq 'ARRAY' ? $data : [ $data ];
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
# if account or billing profile limit hits and it has lock and/or notify,
|
sub get_email_template {
|
||||||
# mark for action
|
my $event = shift;
|
||||||
if(defined $e->{fraud_interval_limit} and
|
my $lock_type = $event->{interval_lock} ? 'lock' : 'warning';
|
||||||
int($e->{interval_cost}) >= int($e->{fraud_interval_limit}) and
|
my $reseller_id = $event->{reseller_id};
|
||||||
($e->{fraud_interval_lock} || $e->{fraud_interval_notify})) {
|
my $templates_data = get_data('/api/emailtemplates/', 'emailtemplates');
|
||||||
|
my $selected_template;
|
||||||
$x->{$e->{id}} = $e;
|
foreach my $template (@{$templates_data}) {
|
||||||
|
next if $template->{name} ne 'customer_fraud_'.$lock_type.'_default_email'
|
||||||
|
&& $template->{name} ne 'customer_fraud_'.$lock_type.'_email';
|
||||||
|
next if $template->{reseller_id} && $template->{reseller_id} != $reseller_id;
|
||||||
|
$selected_template = $template;
|
||||||
|
last if $template->{reseller_id};
|
||||||
}
|
}
|
||||||
|
return $selected_template;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub send_email {
|
||||||
|
my ($event, $subscribers) = @_;
|
||||||
|
|
||||||
|
my $template = get_email_template($event);
|
||||||
|
|
||||||
|
my $vars = { adminmail => $config->{adminmail},
|
||||||
|
customer_id => $event->{id},
|
||||||
|
interval_cost => sprintf('%.2f', $event->{interval_cost}/100),
|
||||||
|
interval_limit => sprintf('%.2f', $event->{interval_limit}/100),
|
||||||
|
type => $event->{type} eq 'profile_limit'
|
||||||
|
? 'billing profile' : 'customer',
|
||||||
|
};
|
||||||
|
|
||||||
|
foreach my $subscriber (@{$subscribers}) {
|
||||||
|
$vars->{subscribers} .= sprintf "%s\@%s %s\n",
|
||||||
|
@{$subscriber}{qw(username domain)},
|
||||||
|
$subscriber->{external_id}
|
||||||
|
? '('.$subscriber->{external_id}.')' : '';
|
||||||
}
|
}
|
||||||
|
|
||||||
for my $e (values %{ $x }) {
|
my $tt = Template->new();
|
||||||
|
map { my $out;
|
||||||
|
$tt->process(\$template->{$_}, $vars, \$out);
|
||||||
|
$out and $template->{$_} = $out;
|
||||||
|
} keys %{$template};
|
||||||
|
|
||||||
$e->{fraud_interval_lock} and
|
my $transport = Email::Sender::Transport::Sendmail->new;
|
||||||
$o->lock_voip_account({id => $e->{id}, lock => $LOCK{$e->{fraud_interval_lock}}});
|
my $email = Email::Simple->create(
|
||||||
|
header => [
|
||||||
|
To => $event->{interval_notify},
|
||||||
|
From => $template->{from_email},
|
||||||
|
Subject => $template->{subject},
|
||||||
|
],
|
||||||
|
body => $template->{body},
|
||||||
|
);
|
||||||
|
|
||||||
$e->{fraud_interval_notify} or next;
|
Email::Sender::Simple->send($email, { transport => $transport })
|
||||||
|
or die sprintf "Cannot send fraud auto lock notification to %s: $ERRNO",
|
||||||
|
$email->header('To');
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
my $subs = $db->sql_get_all_arrayref(<<"!", $e->{id});
|
|
||||||
SELECT s.username, d.domain, s.external_id
|
|
||||||
FROM voip_subscribers s
|
|
||||||
LEFT JOIN domains d ON d.id = s.domain_id
|
|
||||||
WHERE s.contract_id = ?
|
|
||||||
AND s.status != 'terminated'
|
|
||||||
!
|
|
||||||
|
|
||||||
my $cur = sprintf('%.2f', $e->{interval_cost} / 100);
|
sub lock_customer {
|
||||||
my $max = sprintf('%.2f', $e->{fraud_interval_limit} / 100);
|
my ($event, $subscribers) = @_;
|
||||||
|
|
||||||
my ($subject, $body);
|
my $client = new NGCP::API::Client;
|
||||||
if ($e->{fraud_interval_lock}) {
|
$client->set_verbose($opts->{verbose});
|
||||||
$body = "Account ID " . $e->{id} . " has been locked due to exceeding the configured" . "\n"
|
my $uri = '/api/customers/'.$event->{id};
|
||||||
. "credit balance threshold ($cur >= $max ) in the "
|
my $data = [ { op => 'replace',
|
||||||
. ($e->{type} eq 'profile_limit' ? 'billing profile' : 'account settings') . "\n\n";
|
path => '/status',
|
||||||
$subject = 'Account ID ' . $e->{id} . ' locked by fraud detection';
|
value => 'locked' } ];
|
||||||
|
my $res = $client->request("PATCH", $uri, $data);
|
||||||
|
if ($res->status_line =~ /200 OK/) {
|
||||||
|
foreach my $subscriber (@{$subscribers}) {
|
||||||
|
$uri = '/api/subscribers/'.$subscriber->{id};
|
||||||
|
$data = [ { op => 'replace',
|
||||||
|
path => '/status',
|
||||||
|
value => 'locked' },
|
||||||
|
{ op => 'replace',
|
||||||
|
path => '/lock',
|
||||||
|
value => $event->{interval_lock} } ];
|
||||||
|
$res = $client->request("PATCH", $uri, $data);
|
||||||
}
|
}
|
||||||
else {
|
|
||||||
$body = "Account ID " . $e->{id} . " is currently exceeding the configured credit balance" . "\n"
|
|
||||||
. "threshold ($cur >= $max) in the "
|
|
||||||
. ($e->{type} eq 'profile_limit' ? 'billing profile' : 'account settings') . ",\n"
|
|
||||||
. "but has not been locked due to configuration.\n\n";
|
|
||||||
$subject = 'Account ID ' . $e->{id} . ' exceeding fraud detection limit';
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!$subs || !@$subs) {
|
return;
|
||||||
$body .= "There are no affected subscribers.\n";
|
|
||||||
}
|
}
|
||||||
else {
|
|
||||||
$body .= "Affected subscribers:\n";
|
sub main {
|
||||||
for my $s (@$subs) {
|
check_params();
|
||||||
$body .= "\t$s->{username}\@$s->{domain}".
|
load_config();
|
||||||
($s->{external_id} ? " (external ID '$s->{external_id}')"
|
my $events = get_data(sprintf('/api/customerfraudevents/?interval=%s',
|
||||||
: '') . "\n";
|
$interval),
|
||||||
|
'customerfraudevents');
|
||||||
|
foreach my $event (@{$events}) {
|
||||||
|
my $subscribers = get_data(sprintf('/api/subscribers/?customer_id=%d',
|
||||||
|
$event->{id}),
|
||||||
|
'subscribers');
|
||||||
|
if ($event->{interval_lock} > 0) {
|
||||||
|
lock_customer($event, $subscribers);
|
||||||
}
|
}
|
||||||
|
send_email($event, $subscribers);
|
||||||
}
|
}
|
||||||
|
return;
|
||||||
sendmail ( Email::Simple->create(
|
|
||||||
header => [
|
|
||||||
To => $e->{fraud_interval_notify},
|
|
||||||
From => $$conf{adminmail},
|
|
||||||
Subject => $subject,
|
|
||||||
],
|
|
||||||
body => $body,
|
|
||||||
));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
main();
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
ngcp-fraud-auto-lock - checks for contract balances above fraud limit thresholds
|
||||||
|
|
||||||
|
=head1 OPTIONS
|
||||||
|
|
||||||
|
=over 8
|
||||||
|
|
||||||
|
=item B<-help>
|
||||||
|
|
||||||
|
Print a brief help message.
|
||||||
|
|
||||||
|
=item B<-verbose>
|
||||||
|
|
||||||
|
Show additional debug information. Default false.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 USAGE
|
||||||
|
|
||||||
|
ngcp-fraud-auto-lock [options]
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
B<This program> checks for contract balances above fraud limit warning thresholds and sends email notifications about the incidents as applying actions on such contracts (e.g. lock). Interval: 'month'
|
||||||
|
|
||||||
|
=head1 REQUIRED ARGUMENTS
|
||||||
|
|
||||||
|
None
|
||||||
|
|
||||||
|
=head1 EXIT STATUS
|
||||||
|
|
||||||
|
Exit code 0 means everything is ok otherwise 1.
|
||||||
|
|
||||||
|
=head1 CONFIGURATION
|
||||||
|
|
||||||
|
=head1 DIAGNOSTICS
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
NGCP::API::Client
|
||||||
|
|
||||||
|
=head1 DEPENDENCIES
|
||||||
|
|
||||||
|
ngcp-fraud-auto-lock relies on a bunch of Perl modules, all of them specified as
|
||||||
|
dependencies through the Debian package.
|
||||||
|
|
||||||
|
=head1 INCOMPATIBILITIES
|
||||||
|
|
||||||
|
No known at this time.
|
||||||
|
|
||||||
|
=head1 BUGS AND LIMITATIONS
|
||||||
|
|
||||||
|
Please report problems you notice to the Sipwise
|
||||||
|
Development Team <support@sipwise.com>.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Kirill Solomko <ksolomko@sipwise.com>
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
Copyright (C) 2016 Sipwise GmbH, Austria
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
|
(at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
@ -1,146 +1,259 @@
|
|||||||
#!/usr/bin/perl
|
#!/usr/bin/perl
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use English;
|
||||||
|
use Getopt::Long;
|
||||||
|
use Pod::Usage;
|
||||||
|
use NGCP::API::Client;
|
||||||
|
use Readonly;
|
||||||
|
use XML::Simple;
|
||||||
|
use Template;
|
||||||
|
use Email::Sender::Simple qw();
|
||||||
|
use Email::Simple;
|
||||||
|
use Email::Simple::Creator;
|
||||||
|
use Email::Sender::Transport::Sendmail qw();
|
||||||
|
|
||||||
use Email::Sender::Simple qw(sendmail);
|
Readonly my @required => qw();
|
||||||
use Sipwise::Provisioning::Billing;
|
Readonly my $config_file => '/etc/ngcp-panel/provisioning.conf';
|
||||||
|
Readonly my $interval => 'day';
|
||||||
my %LOCK = (
|
|
||||||
none => undef,
|
|
||||||
foreign => 1,
|
|
||||||
outgoing => 2,
|
|
||||||
incoming => 3,
|
|
||||||
global => 4,
|
|
||||||
0 => 'none',
|
|
||||||
1 => 'foreign',
|
|
||||||
2 => 'outgoing',
|
|
||||||
3 => 'incoming',
|
|
||||||
4 => 'global',
|
|
||||||
);
|
|
||||||
|
|
||||||
my $conf = Sipwise::Provisioning::Config->new()->get_config();
|
my $opts = {
|
||||||
|
verbose => 0,
|
||||||
my $o = Sipwise::Provisioning::Billing->new();
|
};
|
||||||
my $db = $o->{database};
|
|
||||||
|
my $config;
|
||||||
my $a = $db->sql_get_all_arrayref(<<"!");
|
|
||||||
SELECT bpinfo.type, bpinfo.id,
|
GetOptions( $opts,
|
||||||
IF (bpinfo.fraud_use_reseller_rates > 0, SUM(cdr.source_reseller_cost),
|
"help|h" => \&usage,
|
||||||
SUM(cdr.source_customer_cost)) as daily_cost,
|
"verbose",
|
||||||
bpinfo.fraud_daily_limit, bpinfo.fraud_daily_lock, bpinfo.fraud_daily_notify
|
) or usage();
|
||||||
FROM (
|
|
||||||
SELECT contracts.id, bp.fraud_use_reseller_rates,
|
sub check_params {
|
||||||
CASE WHEN cfp.fraud_daily_limit > 0 THEN 'account_limit'
|
my @missing;
|
||||||
ELSE 'profile_limit' END as type,
|
foreach my $param (@required) {
|
||||||
IF (cfp.fraud_daily_limit > 0, cfp.fraud_daily_limit, bp.fraud_daily_limit) as fraud_daily_limit,
|
push @missing, $param unless $opts->{$param};
|
||||||
IF (cfp.fraud_daily_limit > 0, cfp.fraud_daily_lock, bp.fraud_daily_lock) as fraud_daily_lock,
|
|
||||||
IF (cfp.fraud_daily_limit > 0, cfp.fraud_daily_notify, bp.fraud_daily_notify) as fraud_daily_notify
|
|
||||||
FROM billing.contracts
|
|
||||||
JOIN billing.billing_profiles bp
|
|
||||||
ON (bp.id =
|
|
||||||
(SELECT m.billing_profile_id
|
|
||||||
FROM billing.billing_mappings m
|
|
||||||
USE INDEX (contractid_idx)
|
|
||||||
WHERE ((m.start_date IS NULL) OR (m.start_date <= NOW()))
|
|
||||||
AND ((m.end_date IS NULL) OR (m.end_date >= NOW()))
|
|
||||||
AND (m.contract_id = contracts.id)
|
|
||||||
ORDER BY m.start_date DESC LIMIT 1
|
|
||||||
)
|
|
||||||
)
|
|
||||||
LEFT JOIN billing.contract_fraud_preferences cfp ON cfp.contract_id = contracts.id
|
|
||||||
WHERE (contracts.status = 'active')
|
|
||||||
AND (cfp.fraud_daily_limit > 0 OR bp.fraud_daily_limit > 0)
|
|
||||||
) as bpinfo
|
|
||||||
JOIN accounting.cdr ON cdr.source_account_id = bpinfo.id
|
|
||||||
WHERE cdr.start_time BETWEEN UNIX_TIMESTAMP(DATE_FORMAT(NOW(), '%Y-%m-%d 00:00:00'))
|
|
||||||
AND UNIX_TIMESTAMP(DATE_FORMAT(NOW(), '%Y-%m-%d 23:59:59'))
|
|
||||||
GROUP BY bpinfo.id
|
|
||||||
HAVING daily_cost >= fraud_daily_limit
|
|
||||||
!
|
|
||||||
|
|
||||||
my $x = {};
|
|
||||||
for my $e (@{ $a }) {
|
|
||||||
if(exists $x->{$e->{id}}) {
|
|
||||||
if($x->{$e->{id}}->{type} eq 'profile_limit' && $e->{type} eq 'account_limit') {
|
|
||||||
|
|
||||||
# if account limit hits and it has lock and/or notify, mark for action
|
|
||||||
if(defined $e->{fraud_daily_limit} and
|
|
||||||
int($e->{daily_cost}) >= int($e->{fraud_daily_limit}) and
|
|
||||||
($e->{fraud_daily_lock} || $e->{fraud_daily_notify})) {
|
|
||||||
|
|
||||||
$x->{$e->{id}} = $e;
|
|
||||||
} else {
|
|
||||||
# we have account fraud prefs set, but either the limit is not reached
|
|
||||||
# or no actions are necessary, let it slip through, overriding
|
|
||||||
# billing profile fraud settings
|
|
||||||
delete $x->{$e->{id}};
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
# if account or billing profile limit hits and it has lock and/or notify,
|
|
||||||
# mark for action
|
|
||||||
if(defined $e->{fraud_daily_limit} and
|
|
||||||
int($e->{daily_cost}) >= int($e->{fraud_daily_limit}) and
|
|
||||||
($e->{fraud_daily_lock} || $e->{fraud_daily_notify})) {
|
|
||||||
|
|
||||||
$x->{$e->{id}} = $e;
|
|
||||||
}
|
}
|
||||||
|
usage(join(' ', @missing)) if scalar @missing;
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub usage {
|
||||||
|
my $msg = shift;
|
||||||
|
pod2usage(-exitval => $msg ? 1 : 0,
|
||||||
|
-verbose => 99,
|
||||||
|
-sections => [ qw(NAME OPTIONS USAGE) ],
|
||||||
|
-message => $msg
|
||||||
|
? $msg =~ /not found/i
|
||||||
|
? $msg
|
||||||
|
: "Missing parameters: $msg"
|
||||||
|
: '',
|
||||||
|
);
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
for my $e (values %{ $x }) {
|
sub load_config {
|
||||||
$e->{fraud_daily_lock} and
|
$config = XML::Simple->new()->XMLin($config_file, ForceArray => 0)
|
||||||
$o->lock_voip_account({id => $e->{id}, lock => $LOCK{$e->{fraud_daily_lock}}});
|
or die "Cannot load config: $config_file: $ERRNO";
|
||||||
|
return;
|
||||||
$e->{fraud_daily_notify} or next;
|
|
||||||
|
|
||||||
my $subs = $db->sql_get_all_arrayref(<<"!", $e->{id});
|
|
||||||
SELECT s.username, d.domain, s.external_id
|
|
||||||
FROM voip_subscribers s
|
|
||||||
LEFT JOIN domains d ON d.id = s.domain_id
|
|
||||||
WHERE s.contract_id = ?
|
|
||||||
AND s.status != 'terminated'
|
|
||||||
!
|
|
||||||
|
|
||||||
my $cur = sprintf('%.2f', $e->{daily_cost} / 100);
|
|
||||||
my $max = sprintf('%.2f', $e->{fraud_daily_limit} / 100);
|
|
||||||
|
|
||||||
my ($subject, $body);
|
|
||||||
if ($e->{fraud_daily_lock}) {
|
|
||||||
$body = "Account ID " . $e->{id} . " has been locked due to exceeding the configured" . "\n"
|
|
||||||
. "daily credit balance threshold ($cur >= $max ) in the "
|
|
||||||
. ($e->{type} eq 'profile_limit' ? 'billing profile' : 'account settings') . "\n\n";
|
|
||||||
$subject = 'Account ID ' . $e->{id} . ' locked by daily fraud detection';
|
|
||||||
}
|
}
|
||||||
else {
|
|
||||||
$body = "Account ID " . $e->{id} . " is currently exceeding the configured daily credit balance" . "\n"
|
sub get_data {
|
||||||
. "threshold ($cur >= $max) in the "
|
my ($uri, $link) = @_;
|
||||||
. ($e->{type} eq 'profile_limit' ? 'billing profile' : 'account settings') . ",\n"
|
my $client = new NGCP::API::Client;
|
||||||
. "but has not been locked due to configuration.\n\n";
|
$client->set_verbose($opts->{verbose});
|
||||||
$subject = 'Account ID ' . $e->{id} . ' exceeding daily fraud detection limit';
|
my $res = $client->request("GET", $uri);
|
||||||
|
die $res->result unless $res->is_success;
|
||||||
|
my $res_hash = $res->as_hash;
|
||||||
|
return [] unless $res_hash->{total_count} && $res_hash->{total_count} > 0;
|
||||||
|
my $data = $res_hash->{_embedded}{'ngcp:'.$link};
|
||||||
|
return ref $data eq 'ARRAY' ? $data : [ $data ];
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!$subs || !@$subs) {
|
sub get_email_template {
|
||||||
$body .= "There are no affected subscribers.\n";
|
my $event = shift;
|
||||||
|
my $lock_type = $event->{interval_lock} ? 'lock' : 'warning';
|
||||||
|
my $reseller_id = $event->{reseller_id};
|
||||||
|
my $templates_data = get_data('/api/emailtemplates/', 'emailtemplates');
|
||||||
|
my $selected_template;
|
||||||
|
foreach my $template (@{$templates_data}) {
|
||||||
|
next if $template->{name} ne 'customer_fraud_'.$lock_type.'_default_email'
|
||||||
|
&& $template->{name} ne 'customer_fraud_'.$lock_type.'_email';
|
||||||
|
next if $template->{reseller_id} && $template->{reseller_id} != $reseller_id;
|
||||||
|
$selected_template = $template;
|
||||||
|
last if $template->{reseller_id};
|
||||||
}
|
}
|
||||||
else {
|
return $selected_template;
|
||||||
$body .= "Affected subscribers:\n";
|
|
||||||
for my $s (@$subs) {
|
|
||||||
$body .= "\t$s->{username}\@$s->{domain}".
|
|
||||||
($s->{external_id} ? " (external ID '$s->{external_id}')"
|
|
||||||
: '') . "\n";
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub send_email {
|
||||||
|
my ($event, $subscribers) = @_;
|
||||||
|
|
||||||
|
my $template = get_email_template($event);
|
||||||
|
|
||||||
|
my $vars = { adminmail => $config->{adminmail},
|
||||||
|
customer_id => $event->{id},
|
||||||
|
interval_cost => sprintf('%.2f', $event->{interval_cost}/100),
|
||||||
|
interval_limit => sprintf('%.2f', $event->{interval_limit}/100),
|
||||||
|
type => $event->{type} eq 'profile_limit'
|
||||||
|
? 'billing profile' : 'customer',
|
||||||
|
};
|
||||||
|
|
||||||
|
foreach my $subscriber (@{$subscribers}) {
|
||||||
|
$vars->{subscribers} .= sprintf "%s\@%s %s\n",
|
||||||
|
@{$subscriber}{qw(username domain)},
|
||||||
|
$subscriber->{external_id}
|
||||||
|
? '('.$subscriber->{external_id}.')' : '';
|
||||||
}
|
}
|
||||||
|
|
||||||
sendmail ( Email::Simple->create(
|
my $tt = Template->new();
|
||||||
|
map { my $out;
|
||||||
|
$tt->process(\$template->{$_}, $vars, \$out);
|
||||||
|
$out and $template->{$_} = $out;
|
||||||
|
} keys %{$template};
|
||||||
|
|
||||||
|
my $transport = Email::Sender::Transport::Sendmail->new;
|
||||||
|
my $email = Email::Simple->create(
|
||||||
header => [
|
header => [
|
||||||
To => $e->{fraud_daily_notify},
|
To => $event->{interval_notify},
|
||||||
From => $$conf{adminmail},
|
From => $template->{from_email},
|
||||||
Subject => $subject,
|
Subject => $template->{subject},
|
||||||
],
|
],
|
||||||
body => $body,
|
body => $template->{body},
|
||||||
));
|
);
|
||||||
|
|
||||||
|
Email::Sender::Simple->send($email, { transport => $transport })
|
||||||
|
or die sprintf "Cannot send fraud daily lock notification to %s: $ERRNO",
|
||||||
|
$email->header('To');
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub lock_customer {
|
||||||
|
my ($event, $subscribers) = @_;
|
||||||
|
|
||||||
|
my $client = new NGCP::API::Client;
|
||||||
|
$client->set_verbose($opts->{verbose});
|
||||||
|
my $uri = '/api/customers/'.$event->{id};
|
||||||
|
my $data = [ { op => 'replace',
|
||||||
|
path => '/status',
|
||||||
|
value => 'locked' } ];
|
||||||
|
my $res = $client->request("PATCH", $uri, $data);
|
||||||
|
if ($res->status_line =~ /200 OK/) {
|
||||||
|
foreach my $subscriber (@{$subscribers}) {
|
||||||
|
$uri = '/api/subscribers/'.$subscriber->{id};
|
||||||
|
$data = [ { op => 'replace',
|
||||||
|
path => '/status',
|
||||||
|
value => 'locked' },
|
||||||
|
{ op => 'replace',
|
||||||
|
path => '/lock',
|
||||||
|
value => $event->{interval_lock} } ];
|
||||||
|
$res = $client->request("PATCH", $uri, $data);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
sub main {
|
||||||
|
check_params();
|
||||||
|
load_config();
|
||||||
|
my $events = get_data(sprintf('/api/customerfraudevents/?interval=%s',
|
||||||
|
$interval),
|
||||||
|
'customerfraudevents');
|
||||||
|
foreach my $event (@{$events}) {
|
||||||
|
my $subscribers = get_data(sprintf('/api/subscribers/?customer_id=%d',
|
||||||
|
$event->{id}),
|
||||||
|
'subscribers');
|
||||||
|
if ($event->{interval_lock} > 0) {
|
||||||
|
lock_customer($event, $subscribers);
|
||||||
|
}
|
||||||
|
send_email($event, $subscribers);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
main();
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
ngcp-fraud-daily-lock - checks for contract balances above fraud limit thresholds
|
||||||
|
|
||||||
|
=head1 OPTIONS
|
||||||
|
|
||||||
|
=over 8
|
||||||
|
|
||||||
|
=item B<-help>
|
||||||
|
|
||||||
|
Print a brief help message.
|
||||||
|
|
||||||
|
=item B<-verbose>
|
||||||
|
|
||||||
|
Show additional debug information. Default false.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 USAGE
|
||||||
|
|
||||||
|
ngcp-fraud-daily-lock [options]
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
B<This program> checks for contract balances above fraud limit warning thresholds and sends email notifications about the incidents as applying actions on such contracts (e.g. lock). Interval: 'day'
|
||||||
|
|
||||||
|
=head1 REQUIRED ARGUMENTS
|
||||||
|
|
||||||
|
None
|
||||||
|
|
||||||
|
=head1 EXIT STATUS
|
||||||
|
|
||||||
|
Exit code 0 means everything is ok otherwise 1.
|
||||||
|
|
||||||
|
=head1 CONFIGURATION
|
||||||
|
|
||||||
|
=head1 DIAGNOSTICS
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
NGCP::API::Client
|
||||||
|
|
||||||
|
=head1 DEPENDENCIES
|
||||||
|
|
||||||
|
ngcp-fraud-daily-lock relies on a bunch of Perl modules, all of them specified as
|
||||||
|
dependencies through the Debian package.
|
||||||
|
|
||||||
|
=head1 INCOMPATIBILITIES
|
||||||
|
|
||||||
|
No known at this time.
|
||||||
|
|
||||||
|
=head1 BUGS AND LIMITATIONS
|
||||||
|
|
||||||
|
Please report problems you notice to the Sipwise
|
||||||
|
Development Team <support@sipwise.com>.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Kirill Solomko <ksolomko@sipwise.com>
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
Copyright (C) 2016 Sipwise GmbH, Austria
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
|
(at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
@ -1,99 +1,147 @@
|
|||||||
#!/usr/bin/perl
|
#!/usr/bin/perl
|
||||||
use strict;
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use English;
|
||||||
|
use Getopt::Long;
|
||||||
|
use Pod::Usage;
|
||||||
|
use NGCP::API::Client;
|
||||||
|
use Readonly;
|
||||||
|
|
||||||
use Data::Dumper;
|
Readonly my @required => qw(id);
|
||||||
use Sipwise::Provisioning::Voip;
|
|
||||||
use Sipwise::Provisioning::Config;
|
|
||||||
|
|
||||||
my %CONFIG = (admin => 'cmd');
|
my $opts = {
|
||||||
|
verbose => 0,
|
||||||
|
};
|
||||||
|
|
||||||
my $config = Sipwise::Provisioning::Config->new()->get_config();
|
GetOptions( $opts,
|
||||||
|
"help|h" => \&usage,
|
||||||
|
"id=i",
|
||||||
|
"verbose",
|
||||||
|
) or usage();
|
||||||
|
|
||||||
unless ($CONFIG{password} = $config->{acl}->{$CONFIG{admin}}->{password}) {
|
sub check_params {
|
||||||
die "Error: No provisioning password found for user $CONFIG{admin}\n";
|
my @missing;
|
||||||
|
foreach my $param (@required) {
|
||||||
|
push @missing, $param unless $opts->{$param};
|
||||||
|
}
|
||||||
|
usage(join(' ', @missing)) if scalar @missing;
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub main;
|
sub usage {
|
||||||
sub usage;
|
my $missing = shift;
|
||||||
sub call_prov;
|
pod2usage(-exitval => $missing ? 1 : 0,
|
||||||
|
-verbose => 99,
|
||||||
my $prov = Sipwise::Provisioning::Voip->new();
|
-sections => [ qw(NAME OPTIONS USAGE) ],
|
||||||
|
-message => $missing ? "Missing parameters: $missing" : '',
|
||||||
main;
|
);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
sub main {
|
sub main {
|
||||||
# use no indentation/linebreaks, for syslog logging
|
check_params();
|
||||||
$Data::Dumper::Indent = 1;
|
my $uri = '/api/soundsets/';
|
||||||
# don't print useless variable names
|
$uri .= $opts->{id} ? $opts->{id} : '';
|
||||||
$Data::Dumper::Terse = 1;
|
my $client = new NGCP::API::Client;
|
||||||
# sort hash keys, so parameters always have the same order
|
$client->set_verbose($opts->{verbose});
|
||||||
$Data::Dumper::Sortkeys = 1;
|
my $res = $client->request("GET", $uri);
|
||||||
|
$res->is_success ? print $res->content."\n"
|
||||||
my $return;
|
: print $res->result."\n";
|
||||||
|
|
||||||
print "Fetching all sound sets\n";
|
return;
|
||||||
$return = call_prov('get_sound_sets');
|
|
||||||
print "Sound Sets:\n", Dumper $return;
|
|
||||||
|
|
||||||
print "Creating global sound set\n";
|
|
||||||
$return = call_prov('create_sound_set', {
|
|
||||||
reseller_id => 1,
|
|
||||||
name => 'api sound set',
|
|
||||||
description => 'sound set created via api',
|
|
||||||
});
|
|
||||||
print "Created Sound Set:\n", Dumper $return;
|
|
||||||
my $set_id = $return;
|
|
||||||
|
|
||||||
print "Fetching new sound set\n";
|
|
||||||
$return = call_prov('get_sound_set', { id => $set_id });
|
|
||||||
print "Sound Set:\n", Dumper $return;
|
|
||||||
|
|
||||||
print "Updating global sound set\n";
|
|
||||||
$return = call_prov('update_sound_set', {
|
|
||||||
id => $set_id,
|
|
||||||
name => 'updated sound set',
|
|
||||||
description => 'updated sound set created via api',
|
|
||||||
account_id => 23,
|
|
||||||
});
|
|
||||||
print "Updated Sound Set:\n", Dumper $return;
|
|
||||||
|
|
||||||
print "Fetching new sound set\n";
|
|
||||||
$return = call_prov('get_sound_set', { id => $set_id });
|
|
||||||
print "Sound Set:\n", Dumper $return;
|
|
||||||
|
|
||||||
print "Delete new sound set\n";
|
|
||||||
$return = call_prov('delete_sound_set', { id => $set_id });
|
|
||||||
print "Sound Set Deleted:\n", Dumper $return;
|
|
||||||
|
|
||||||
exit;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
main();
|
||||||
|
|
||||||
sub call_prov {
|
exit 0;
|
||||||
# scalar, scalar, hash-ref
|
|
||||||
my ($function, $parameter) = @_;
|
|
||||||
my $result;
|
|
||||||
|
|
||||||
eval {
|
|
||||||
$result = $prov->handle_request( $function,
|
|
||||||
{
|
|
||||||
authentication => {
|
|
||||||
type => 'system',
|
|
||||||
username => $CONFIG{admin},
|
|
||||||
password => $CONFIG{password},
|
|
||||||
},
|
|
||||||
parameters => $parameter,
|
|
||||||
});
|
|
||||||
};
|
|
||||||
|
|
||||||
if($@) {
|
__END__
|
||||||
if(ref $@ eq 'SOAP::Fault') {
|
|
||||||
die "Voip\::$function failed: ". $@->faultstring;
|
|
||||||
} else {
|
|
||||||
die "Voip\::$function failed: $@";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return $result;
|
=head1 NAME
|
||||||
}
|
|
||||||
|
ngcp-sound_set - retreives an NGCP Sound Set
|
||||||
|
|
||||||
|
=head1 OPTIONS
|
||||||
|
|
||||||
|
=over 8
|
||||||
|
|
||||||
|
=item B<-help>
|
||||||
|
|
||||||
|
Print a brief help message.
|
||||||
|
|
||||||
|
=item B<-id>
|
||||||
|
|
||||||
|
Sound set id
|
||||||
|
|
||||||
|
=item B<-verbose>
|
||||||
|
|
||||||
|
Show additional debug information. Default false.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 USAGE
|
||||||
|
|
||||||
|
ngcp-sound_set [options]
|
||||||
|
|
||||||
|
ngcp-sound_set --id 11
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
B<This program> retreives a sound set from the NGCP platform.
|
||||||
|
|
||||||
|
=head1 REQUIRED ARGUMENTS
|
||||||
|
|
||||||
|
=over 8
|
||||||
|
|
||||||
|
=item B<-id>
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 EXIT STATUS
|
||||||
|
|
||||||
|
Exit code 0 means everything is ok otherwise 1.
|
||||||
|
|
||||||
|
=head1 CONFIGURATION
|
||||||
|
|
||||||
|
=head1 DIAGNOSTICS
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
NGCP::API::Client
|
||||||
|
|
||||||
|
=head1 DEPENDENCIES
|
||||||
|
|
||||||
|
ngcp-sound_set relies on a bunch of Perl modules, all of them specified as
|
||||||
|
dependencies through the Debian package.
|
||||||
|
|
||||||
|
=head1 INCOMPATIBILITIES
|
||||||
|
|
||||||
|
No known at this time.
|
||||||
|
|
||||||
|
=head1 BUGS AND LIMITATIONS
|
||||||
|
|
||||||
|
Please report problems you notice to the Sipwise
|
||||||
|
Development Team <support@sipwise.com>.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Victor Seva <vseva@sipwise.com>
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
Copyright (C) 2016 Sipwise GmbH, Austria
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
|
(at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
Loading…
Reference in new issue