GSM/SMS/NBS/Stack.pm

   1 package GSM::SMS::NBS::Stack;
   2 use GSM::SMS::PDU;
   3 use Data::Dumper;
   4
   5 $VERSION = '0.1';
   6
   7 # $__NBSSTACK_PRINT++;
   8
   9 # Keep the packets alive for 1 day
  10 $__TIME_TO_LIVE = 60*60*24;
  11
  12 # Constructor
  13 sub new {
  14     my $proto = shift;
  15     my $class = ref($proto) || $proto;
  16
  17     my $self = {};
  18         $self->{STACK} = {};
  19         my %arg = @_;
  20         $self->{TRANSPORT} = $arg{"-transport"};
  21
  22     bless($self, $class);
  23     return $self;
  24 }
  25
  26 # receive NBS/SMS messages
  27 sub receive {
  28         my ($self, $ref_oa, $ref_msg, $ref_timestamp, $ref_transport, $ref_port, $block) =@_;
  29
  30         my ($stack) = $self->{STACK};
  31         my $t = $self->{TRANSPORT};
  32
  33         $self->_prt( "entering receive" );
  34
  35         while ($self->_complete_message_on_stack($stack, $ref_oa, $ref_msg, $ref_timestamp, $ref_transport, $ref_port)) {
  36
  37                 $self->_prt( "CHECK\n" );
  38
  39                 # look for new datagrams on the stack
  40                 foreach my $transporter ( @{$t->get_transports()} ) {
  41                         $self->_prt( "x" );
  42                         $self->_prt( "T: " . $transporter->get_name() . "\n" );
  43                         my $pdu;
  44                         if (!$transporter->receive(\$pdu)) {
  45                                 $self->_prt(  "SOMETHING\n" );
  46                                 $self->_place_message_on_stack($stack, $pdu, $transporter->get_name());
  47                                 $self->_prt( "RCV: $pdu\n" );
  48                         }
  49                 }
  50                 # Do some garbage collection -> when a datagram is not complete after a certain time frame
  51                 # +/- 2h then delete this datagram from the stack! (Long living stack with 'dead' messages.
  52                 $self->_garbage_collect($stack);
  53
  54                 select(undef, undef, undef, 0.25);
  55                 return -1 unless $block;
  56                 $self->_prt( "BLOCKING LOOP" );
  57         }
  58         return 0;
  59 }
  60
  61 sub _complete_message_on_stack {
  62         my ($self, $stack, $ref_oa, $ref_msg, $ref_timestamp, $ref_transport, $ref_port) = @_;
  63         my ($message, $complete, $msisdn, $timestamp, $transport, $port);
  64         my ($oa_del, $dg_del);
  65
  66         $self->_prt( "IN ($stack)\n" );
  67
  68         foreach my $i (keys %$stack) {
  69                 my $oa = $stack->{$i};
  70                 $self->_prt( $oa."\n" );
  71                 $oa_del = $i;
  72                 foreach my $j (keys %$oa) {
  73                         my $dg = $oa->{$j};
  74                         $dg_del = $j;
  75
  76                         # $dg is a datagram ref with ->{Fragments} = $PDU / ->{Timestamp} = time
  77                         # Check if we need to kill this datagram -> TTL expired
  78                         if ( (time - $dg->{Timestamp}) > $__TIME_TO_LIVE) {
  79                                 $self->_prt( "TTL expired!\n" );
  80                                 $self->_prt( $__TIME_TO_LIVE );
  81                                 $self->_prt( $dg->{Timestamp} );
  82                                 $self->_prt( "------------------" );
  83                                 delete $oa->{$j};
  84                                 next;
  85                         }
  86
  87                         my $decoded_pdu = $dg->{Fragments}->[1];
  88
  89                         if ($decoded_pdu) {
  90                                 $port = $decoded_pdu->{'TP-DPORT'};
  91                                 $msisdn = $decoded_pdu->{'TP-OA'};
  92                                 $message= $decoded_pdu->{'TP-UD'};
  93                                 $timestamp= $decoded_pdu->{'TP-SCTS'};
  94                                 $transport  = $decoded_pdu->{'XTRA-TRANSPORT'};
  95                         }
  96
  97                         if ($decoded_pdu && $decoded_pdu->{'TP-DPORT'}) {
  98                                 $self->_prt( "PORT!\n" );
  99                                 $self->_prt( "-> " . $decoded_pdu->{'TP-DPORT'} ."\n" );
 100                                 # We have a UDHI header structure here
 101                                 my $l = $decoded_pdu->{'TP-FRAGMAX'};
 102                                 $msisdn = $decoded_pdu->{'TP-OA'};
 103
 104                                 # assume complete ...
 105                                 $complete++;
 106                                 for (my $cnt=1; $cnt<=$l; $cnt++) {
 107                                         if ($dg->{Fragments}->[$cnt]) {
 108                                                 $self->_prt( "CNT $cnt passed\n" );
 109                                                 my $frag = $dg->{Fragments}->[$cnt];
 110                                                 $message.=$frag->{'TP-UD'};     # When having text headers '//SCK', we concatenate also the //SCK for the moment
 111                                                                                                 # we need a revision here for PDU.pm to solve this
 112                                                 $self->_prt( "[[".$frag->{'TP-UD'}."]]\n" );
 113                                         } else {
 114                                                         $complete = undef;
 115                                         }
 116                                 }
 117                         }
 118
 119                         if ($decoded_pdu && !$decoded_pdu->{'TP-DPORT'}) {
 120                                 # We have a simple sms message
 121                                 $self->_prt( "SIMPLE\n" );
 122                                 $msisdn         = $decoded_pdu->{'TP-OA'};
 123                                 $message        = $decoded_pdu->{'TP-UD'};
 124                                 $timestamp      = $decoded_pdu->{'TP-SCTS'};
 125                                 $transport  = $decoded_pdu->{'XTRA-TRANSPORT'};
 126                                 $complete++;
 127                         }
 128                         last if ($complete);
 129                 }
 130                 last if ($complete);
 131         }
 132         if ($complete) {
 133                 # Communicate message to caller
 134                 $$ref_oa  = $msisdn;
 135                 $$ref_msg = $message;
 136                 $$ref_timestamp = $timestamp;
 137                 $$ref_transport = $transport;
 138                 $$ref_port = $port;
 139
 140                 # delete reference
 141                 $self->_prt( "delete $oa_del, $dg_del :::::>>>>> ".$stack->{$oa_del}->{$dg_del}->{Fragments}->[1]->{'TP-UD'} );
 142                 $self->_prt( "\n" );
 143
 144                 delete $stack->{$oa_del}->{$dg_del};
 145                 return 0;
 146         }
 147         return -1;
 148 }
 149
 150
 151 sub _place_message_on_stack {
 152         my ($self, $stack, $msg, $transport) = @_;
 153
 154         my $p = GSM::SMS::PDU->new();
 155         my $decoded_pdu = $p->SMSDeliver($msg);
 156
 157         my $oa = $decoded_pdu->{'TP-OA'};
 158         my $dg = $decoded_pdu->{'TP-DATAGRAM'}  || 1;
 159         my $id = $decoded_pdu->{'TP-FRAGSQN'}   || 1;
 160
 161
 162         # a "hack" to add the name of the transport to the stack
 163
 164         $decoded_pdu->{'XTRA-TRANSPORT'} = $transport;
 165
 166         if (!$stack->{$oa}) {                           # Create a new datagram on the 'stack'
 167                 $stack->{$oa} = {};
 168                 $stack->{$oa}->{$dg} = {};
 169                 $stack->{$oa}->{$dg}->{Fragments} = [];
 170                 $stack->{$oa}->{$dg}->{Timestamp} = undef;
 171         }
 172         $self->_prt( "[$oa][$dg][$id]\n" );
 173
 174         $stack->{$oa}->{$dg}->{Fragments}->[$id] = $decoded_pdu;
 175         $stack->{$oa}->{$dg}->{Timestamp} = time;       # update timestamp
 176 }
 177
 178
 179 sub _garbage_collect {
 180         my ($self, $stack) = @_;
 181
 182         # I implemented the garbage collect intrinsic on the _complete_message on stack
 183         # It will kill of messages on the stack with an old timestamp ( > delta_time )
 184
 185 }
 186
 187 sub _prt {
 188         my ($self, $txt) = @_;
 189
 190         print $txt  if ($__NBSSTACK_PRINT);
 191 }
 192
 193 1;
 194
 195 =head1 NAME
 196
 197 GSM::SMS::NBS::Stack - Narrow Bandwidth Socket protocol stack.
 198
 199 =head1 DESCRIPTION
 200
 201 Implements the Reassmbly part for the NBS messages.
 202
 203 =head1 AUTHOR
 204
 205 Johan Van den Brande <johan@vandenbrande.com>