Skip to content

Instantly share code, notes, and snippets.

@bor
Created July 20, 2014 10:33
Show Gist options
  • Save bor/a7120fe8225f1cafd3ee to your computer and use it in GitHub Desktop.
Save bor/a7120fe8225f1cafd3ee to your computer and use it in GitHub Desktop.
Net::SMPP::Packet
package Net::SMPP::Packet;
use strict;
use warnings;
use Data::Dumper;
use List::Util qw/first/;
use base qw(Exporter);
our $VERSION = '0.01';
our %EXPORT_TAGS = ( 'all' => [qw{pack_pdu unpack_pdu}], );
our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} };
my $header_dict = {
0x34 => {
template => 'NNNN', # v3.4 'NNNN', #4> v4.0 'NNNNxxxx', must change in tandem with above <4#
lenght => 16, # v3.4 16, #4> v4.0 20, must change in tandem with smpp_version <4#
cmd_version => 0x00000000, # v3.4 0x00000000, #4> v4 0x00010000; to be or'd with cmd <4#
},
};
my $body_dict = {
0x34 => {
bind_transceiver_resp => {
id => 0x80000009,
template => 'Z*',
attr_seq => [qw/system_id/],
},
submit_sm => {
id => 0x00000004,
template => 'Z*CCZ*CCZ*CCCZ*Z*CCCCC',
attr_seq => [
qw/service_type source_addr_ton source_addr_npi source_addr dest_addr_ton dest_addr_npi destination_addr esm_class protocol_id priority_flag schedule_delivery_time validity_period registered_delivery replace_if_present_flag data_coding sm_default_msg_id sm_length/
],
},
submit_sm_resp => {
id => 0x80000004,
template => 'Z*',
attr_seq => [qw/message_id/],
},
unbind => {
id => 0x00000006,
template => '',
attr_seq => [],
},
'bind' => {
id => 0x00000009,
template => 'Z*Z*Z*CCCZ*',
attr_seq => [qw/system_id password system_type interface_version addr_ton addr_npi address_range/],
},
},
};
sub pack_pdu {
my ($data_ref) = @_;
validate($data_ref)
or return;
my $body_str = get_body_str($data_ref);
my $header_str = get_header_str( $data_ref, length($body_str) );
return $header_str . $body_str;
}
sub validate {
my ($data_ref) = @_;
my @header_attr = qw/version command status seq/;
my @missing_attr = grep { !exists $data_ref->{$_} } @header_attr;
if ( scalar @missing_attr > 0 ) {
warn 'following mandatory header fields are missing: ' . join( ', ', @missing_attr ) . "\n";
return;
}
my $body_attr_ref = $body_dict->{ $data_ref->{'version'} }->{ $data_ref->{'command'} }->{'attr_seq'};
@missing_attr = grep { !exists $data_ref->{$_} } @{$body_attr_ref};
if ( scalar @missing_attr > 0 ) {
warn 'following mandatory body fields are missing: ' . join( ', ', @missing_attr ) . "\n";
return;
}
return 1;
}
sub get_header_str {
my ( $data_ref, $body_len ) = @_;
my $head_templ = $header_dict->{ $data_ref->{'version'} }->{'template'};
my $head_len = $header_dict->{ $data_ref->{'version'} }->{'lenght'};
my $cmd_version = $header_dict->{ $data_ref->{'version'} }->{'cmd_version'};
my $op_code = $body_dict->{ $data_ref->{'version'} }->{ $data_ref->{'command'} }->{'id'};
return pack $head_templ, $head_len + $body_len, $op_code | $cmd_version, $data_ref->{'status'}, $data_ref->{'seq'};
}
sub get_body_str {
my ($data_ref) = @_;
my $template = $body_dict->{ $data_ref->{'version'} }->{ $data_ref->{'command'} }->{'template'};
my $attr_seq = $body_dict->{ $data_ref->{'version'} }->{ $data_ref->{'command'} }->{'attr_seq'};
return pack $template, map { $data_ref->{$_} } @{$attr_seq};
}
sub unpack_pdu {
my ($data_ref) = @_;
my %pdu;
my $head_templ = $header_dict->{ $data_ref->{'version'} }->{'template'};
my $head_len = $header_dict->{ $data_ref->{'version'} }->{'lenght'};
( $pdu{'length'}, $pdu{'command_id'}, $pdu{'status'}, $pdu{'seq'} ) = unpack $head_templ, $data_ref->{'data'};
$pdu{'version'} = $data_ref->{'version'};
$pdu{'command'} = get_command_name( $data_ref->{'version'}, $pdu{'command_id'} );
if ( $pdu{'length'} <= $head_len ) {
return \%pdu;
}
my $body_str = substr $data_ref->{'data'}, $head_len;
my $template = $body_dict->{ $data_ref->{'version'} }->{ $pdu{'command'} }->{'template'};
my $attr_seq = $body_dict->{ $data_ref->{'version'} }->{ $pdu{'command'} }->{'attr_seq'};
my @options = unpack $template, $body_str;
my $body_len = 0;
foreach my $idx ( 0 .. $#{$attr_seq} ) {
$pdu{ ${$attr_seq}[$idx] } = $options[$idx];
my $attr_len = length $options[$idx];
$body_len += $attr_len > 1 ? $attr_len + 1 : 1;
}
if ( exists $pdu{'sm_length'} ) {
( $pdu{'short_message'} ) = unpack "a$pdu{'sm_length'}", substr $body_str, $body_len;
}
return \%pdu;
}
sub get_command_name {
my ( $version, $command_id ) = @_;
return first { $command_id == $body_dict->{$version}->{$_}->{'id'} } keys %{ $body_dict->{$version} };
}
sub hexdump {
local ( $!, $@ );
no warnings qw(uninitialized);
while ( $_[0] =~ /(.{1,32})/smg ) {
my $line = $1;
my @c = ( ( map { sprintf "%02x", $_ } unpack( 'C*', $line ) ), ( (" ") x 32 ) )[ 0 .. 31 ];
$line =~ s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms;
print STDERR "$_[1] ", join( " ", @c, '|', $line ), "\n";
}
print STDERR "\n";
}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment