- reworked /bin/* provisioning scripts to use NGCP::API::Client - completely reworked ngcp-fraud-* ngcp-credit-warning scripts Change-Id: I416847c5c1d3e7dda5695d700a03182fa47f5b24changes/52/5052/11
parent
82a1be5c3e
commit
3d65648d9f
@ -1,61 +1,232 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Email::Sender::Simple qw(sendmail);
|
||||
use English;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use NGCP::API::Client;
|
||||
use Readonly;
|
||||
use XML::Simple;
|
||||
use Sipwise::DB;
|
||||
use Sipwise::Provisioning::Config;
|
||||
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';
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
sub load_config {
|
||||
$config = XML::Simple->new()->XMLin($config_file, ForceArray => 0)
|
||||
or die "Cannot load config: $config_file: $ERRNO";
|
||||
return;
|
||||
}
|
||||
|
||||
sub send_email {
|
||||
my ($cwarning, $contracts) = @_;
|
||||
|
||||
my $MTA = '/usr/sbin/sendmail -oi -t';
|
||||
my $template = get_email_template() || return;
|
||||
|
||||
sub main;
|
||||
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
|
||||
}
|
||||
|
||||
main;
|
||||
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 => [
|
||||
To => ref $cwarning->{recipients} eq 'ARRAY'
|
||||
? join(', ', @{$cwarning->{recipients}})
|
||||
: $cwarning->{recipients},
|
||||
From => $template->{from_email},
|
||||
Subject => $template->{subject},
|
||||
],
|
||||
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 {
|
||||
my $xs = new XML::Simple;
|
||||
my $conf = Sipwise::Provisioning::Config->new()->get_config();
|
||||
my $db = new Sipwise::DB ( $$conf{billingdb} );
|
||||
|
||||
$$conf{credit_warnings} = [ $$conf{credit_warnings} ]
|
||||
if defined eval { %{$$conf{credit_warnings}} };
|
||||
|
||||
foreach my $domcfg (@{$$conf{credit_warnings}}) {
|
||||
|
||||
my $contracts = $db->sql_get_all_arrayref("
|
||||
SELECT a.contract_id,a.cash_balance,a.cash_balance_interval,GROUP_CONCAT(c.username,'\@',d.domain) AS subscribers
|
||||
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
|
||||
AND b.status != 'terminated'
|
||||
AND a.contract_id = c.contract_id
|
||||
AND c.domain_id = d.id
|
||||
AND d.domain = ?
|
||||
AND c.status != 'terminated'
|
||||
AND a.cash_balance < ?
|
||||
GROUP BY contract_id
|
||||
", $$domcfg{domain}, $$domcfg{threshold});
|
||||
if(@$contracts) {
|
||||
$$domcfg{recipients} = [ $$domcfg{recipients} ]
|
||||
unless defined eval { @{$$domcfg{recipients}} };
|
||||
|
||||
my $mailtxt;
|
||||
$mailtxt .= "Credit threshold warning for: $$domcfg{domain}\nThe following contracts are below the configured threshold of $$domcfg{threshold} cent:\n\n";
|
||||
$mailtxt .= "account_id\tcash_balance\tcash_balance_interval\tsubscribers\n";
|
||||
for(@$contracts) {
|
||||
$mailtxt .= "$$_{contract_id}\t$$_{cash_balance}\t$$_{cash_balance_interval}\t$$_{subscribers}\n";
|
||||
}
|
||||
|
||||
sendmail ( Email::Simple->create(
|
||||
header => [
|
||||
To => join(', ', @{$$domcfg{recipients}}),
|
||||
From => $$conf{adminmail},
|
||||
Subject => 'Sipwise NGCP credit threshold notification',
|
||||
],
|
||||
body => $mailtxt,
|
||||
));
|
||||
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
|
||||
|
||||
use strict;
|
||||
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);
|
||||
use Sipwise::Provisioning::Billing;
|
||||
|
||||
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 $o = Sipwise::Provisioning::Billing->new();
|
||||
my $db = $o->{database};
|
||||
|
||||
# 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}};
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# if account or billing profile 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;
|
||||
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;
|
||||
}
|
||||
|
||||
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 {
|
||||
$config = XML::Simple->new()->XMLin($config_file, ForceArray => 0)
|
||||
or die "Cannot load config: $config_file: $ERRNO";
|
||||
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 ];
|
||||
}
|
||||
|
||||
$e->{fraud_interval_lock} and
|
||||
$o->lock_voip_account({id => $e->{id}, lock => $LOCK{$e->{fraud_interval_lock}}});
|
||||
sub get_email_template {
|
||||
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};
|
||||
}
|
||||
return $selected_template;
|
||||
}
|
||||
|
||||
$e->{fraud_interval_notify} or next;
|
||||
sub send_email {
|
||||
my ($event, $subscribers) = @_;
|
||||
|
||||
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 $template = get_email_template($event);
|
||||
|
||||
my $cur = sprintf('%.2f', $e->{interval_cost} / 100);
|
||||
my $max = sprintf('%.2f', $e->{fraud_interval_limit} / 100);
|
||||
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',
|
||||
};
|
||||
|
||||
my ($subject, $body);
|
||||
if ($e->{fraud_interval_lock}) {
|
||||
$body = "Account ID " . $e->{id} . " has been locked due to exceeding the configured" . "\n"
|
||||
. "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 fraud detection';
|
||||
}
|
||||
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';
|
||||
foreach my $subscriber (@{$subscribers}) {
|
||||
$vars->{subscribers} .= sprintf "%s\@%s %s\n",
|
||||
@{$subscriber}{qw(username domain)},
|
||||
$subscriber->{external_id}
|
||||
? '('.$subscriber->{external_id}.')' : '';
|
||||
}
|
||||
|
||||
if (!$subs || !@$subs) {
|
||||
$body .= "There are no affected subscribers.\n";
|
||||
}
|
||||
else {
|
||||
$body .= "Affected subscribers:\n";
|
||||
for my $s (@$subs) {
|
||||
$body .= "\t$s->{username}\@$s->{domain}".
|
||||
($s->{external_id} ? " (external ID '$s->{external_id}')"
|
||||
: '') . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
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 => [
|
||||
To => $e->{fraud_interval_notify},
|
||||
From => $$conf{adminmail},
|
||||
Subject => $subject,
|
||||
To => $event->{interval_notify},
|
||||
From => $template->{from_email},
|
||||
Subject => $template->{subject},
|
||||
],
|
||||
body => $body,
|
||||
));
|
||||
body => $template->{body},
|
||||
);
|
||||
|
||||
Email::Sender::Simple->send($email, { transport => $transport })
|
||||
or die sprintf "Cannot send fraud auto 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;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
use strict;
|
||||
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);
|
||||
use Sipwise::Provisioning::Billing;
|
||||
|
||||
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 $o = Sipwise::Provisioning::Billing->new();
|
||||
my $db = $o->{database};
|
||||
|
||||
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 daily_cost,
|
||||
bpinfo.fraud_daily_limit, bpinfo.fraud_daily_lock, bpinfo.fraud_daily_notify
|
||||
FROM (
|
||||
SELECT contracts.id, bp.fraud_use_reseller_rates,
|
||||
CASE WHEN cfp.fraud_daily_limit > 0 THEN 'account_limit'
|
||||
ELSE 'profile_limit' END as type,
|
||||
IF (cfp.fraud_daily_limit > 0, cfp.fraud_daily_limit, bp.fraud_daily_limit) as fraud_daily_limit,
|
||||
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;
|
||||
Readonly my @required => qw();
|
||||
Readonly my $config_file => '/etc/ngcp-panel/provisioning.conf';
|
||||
Readonly my $interval => 'day';
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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 }) {
|
||||
$e->{fraud_daily_lock} and
|
||||
$o->lock_voip_account({id => $e->{id}, lock => $LOCK{$e->{fraud_daily_lock}}});
|
||||
|
||||
$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';
|
||||
sub load_config {
|
||||
$config = XML::Simple->new()->XMLin($config_file, ForceArray => 0)
|
||||
or die "Cannot load config: $config_file: $ERRNO";
|
||||
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 $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 {
|
||||
$body = "Account ID " . $e->{id} . " is currently exceeding the configured daily 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 daily fraud detection limit';
|
||||
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}.')' : '';
|
||||
}
|
||||
|
||||
if (!$subs || !@$subs) {
|
||||
$body .= "There are no affected subscribers.\n";
|
||||
}
|
||||
else {
|
||||
$body .= "Affected subscribers:\n";
|
||||
for my $s (@$subs) {
|
||||
$body .= "\t$s->{username}\@$s->{domain}".
|
||||
($s->{external_id} ? " (external ID '$s->{external_id}')"
|
||||
: '') . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
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 => [
|
||||
To => $e->{fraud_daily_notify},
|
||||
From => $$conf{adminmail},
|
||||
Subject => $subject,
|
||||
To => $event->{interval_notify},
|
||||
From => $template->{from_email},
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
1;
|
||||
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
|
||||
use strict;
|
||||
use warnings;
|
||||
use English;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use NGCP::API::Client;
|
||||
use Readonly;
|
||||
|
||||
Readonly my @required => qw(id);
|
||||
|
||||
my $opts = {
|
||||
verbose => 0,
|
||||
};
|
||||
|
||||
GetOptions( $opts,
|
||||
"help|h" => \&usage,
|
||||
"id=i",
|
||||
"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 Data::Dumper;
|
||||
use Sipwise::Provisioning::Voip;
|
||||
use Sipwise::Provisioning::Config;
|
||||
sub usage {
|
||||
my $missing = shift;
|
||||
pod2usage(-exitval => $missing ? 1 : 0,
|
||||
-verbose => 99,
|
||||
-sections => [ qw(NAME OPTIONS USAGE) ],
|
||||
-message => $missing ? "Missing parameters: $missing" : '',
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
my %CONFIG = (admin => 'cmd');
|
||||
sub main {
|
||||
check_params();
|
||||
my $uri = '/api/soundsets/';
|
||||
$uri .= $opts->{id} ? $opts->{id} : '';
|
||||
my $client = new NGCP::API::Client;
|
||||
$client->set_verbose($opts->{verbose});
|
||||
my $res = $client->request("GET", $uri);
|
||||
$res->is_success ? print $res->content."\n"
|
||||
: print $res->result."\n";
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
my $config = Sipwise::Provisioning::Config->new()->get_config();
|
||||
main();
|
||||
|
||||
unless ($CONFIG{password} = $config->{acl}->{$CONFIG{admin}}->{password}) {
|
||||
die "Error: No provisioning password found for user $CONFIG{admin}\n";
|
||||
}
|
||||
exit 0;
|
||||
|
||||
sub main;
|
||||
sub usage;
|
||||
sub call_prov;
|
||||
__END__
|
||||
|
||||
my $prov = Sipwise::Provisioning::Voip->new();
|
||||
=head1 NAME
|
||||
|
||||
main;
|
||||
ngcp-sound_set - retreives an NGCP Sound Set
|
||||
|
||||
sub main {
|
||||
# use no indentation/linebreaks, for syslog logging
|
||||
$Data::Dumper::Indent = 1;
|
||||
# don't print useless variable names
|
||||
$Data::Dumper::Terse = 1;
|
||||
# sort hash keys, so parameters always have the same order
|
||||
$Data::Dumper::Sortkeys = 1;
|
||||
|
||||
my $return;
|
||||
|
||||
print "Fetching all sound sets\n";
|
||||
$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;
|
||||
}
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 8
|
||||
|
||||
sub call_prov {
|
||||
# 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($@) {
|
||||
if(ref $@ eq 'SOAP::Fault') {
|
||||
die "Voip\::$function failed: ". $@->faultstring;
|
||||
} else {
|
||||
die "Voip\::$function failed: $@";
|
||||
}
|
||||
}
|
||||
=item B<-help>
|
||||
|
||||
return $result;
|
||||
}
|
||||
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