GSM/SMS/NBS/Message.pm

   1 package GSM::SMS::NBS::Message;
   2
   3 use strict;
   4 use warnings;
   5
   6 use     GSM::SMS::NBS::Lib;
   7 use     GSM::SMS::PDU;
   8 use Carp;
   9
  10 use vars qw($VERSION);
  11 $VERSION = '0.1';
  12
  13 use constant DEFAULT_DCS_UDH    => 0xF5; # 8bit, ME specific
  14 use constant DEFAULT_DCS_NOUDH  => 0x00; # default DCS (typically 7bit, SIM specific)
  15 use constant DEFAULT_VALIDITY   => "1d"; # FIXME: currently fixed to 1 day
  16 use constant DEFAULT_SMS_CENTER => "";   # FIXME: currently fixed to empty SMS center address
  17
  18 use constant USERDATA_LENGTH    => 140;
  19 use constant DECONCAT_TOTAL     => "_deconcat_total";  # internal: undef=>try single message, *=>try & messages
  20 use constant TEXT_POSITION      => "text_position";    # numeric position in $payload, UDH IE will be present only once
  21
  22 use constant IEI_IMELODY          => 0x0C;  #IEI: User Defined Sound (iMelody max 128 bytes)
  23 use constant IEI_ANIMATION_LARGE  => 0x0E;  #IEI: EMS large animation (16x16 x4 = 128 bytes)
  24 use constant IEI_ANIMATION_SMALL  => 0x0F;  #IEI: EMS small animation ( 8x 8 x4 =  32 bytes)
  25 use constant IEI_PICTURE_LARGE    => 0x10;  #IEI: EMS large    picture (32x32 = 128 bytes)
  26 use constant IEI_PICTURE_SMALL    => 0x11;  #IEI: EMS small    picture (16x16 =  32 bytes)
  27 use constant IEI_PICTURE_VARIABLE => 0x12;  #IEI: EMS variable picture (other)
  28 use constant IEI_ALCATEL          => 0x80;  #IEI: Alcatel proprietary "data download" type
  29
  30 # SAR for NBS messages
  31 # --------------------
  32 # This part does the segmentation ... look in Stack.pm for reassembly
  33
  34 sub new {
  35         my $proto = shift;
  36         my $class = ref($proto) || $proto;
  37
  38         my $self = {};
  39         $self->{'__FRAMES__'} = [];
  40
  41         bless($self, $class);
  42         return $self;
  43 }
  44
  45 # Create a message from a payload -- compatibility cludge!
  46 sub create {
  47         my ($self, $number, $payload, $destination_port, $source_port, $datacodingscheme) = @_;
  48         my %dcs_compat = (
  49                         "7bit" =>0x00,  # default DCS (typically 7bit, SIM specific)
  50                         "7biti"=>0xF0,  # 7bit, immediate display
  51                         "8bit" =>0xF6,  # 8bit, SIM specific
  52                         "8biti"=>0xF4,  # 8bit, immediate display
  53                         "8bitm"=>0xF5,  # 8bit, ME specific
  54         );
  55
  56         $datacodingscheme=$dcs_compat{$datacodingscheme} if $datacodingscheme && exists $dcs_compat{$datacodingscheme};
  57
  58         return $self->store($number, pack("H*", $payload),
  59                         "dcs"=>$datacodingscheme,
  60                         "udh"=>[
  61                                 {
  62                                         "type"            =>"port16",  #IEI: application port addressing scheme, 16 bit address
  63                                         "destination_port"=>$destination_port,
  64                                         "source_port"     =>$source_port,
  65                                 },
  66                         ],
  67                         );
  68 }
  69
  70 sub _iebuilder {
  71         my ($self, $iei, @iedata) = @_;
  72
  73         return ($iei,scalar(@iedata),@iedata);
  74 }
  75
  76 sub _ie_port16 {
  77         my ($self, %args) = @_;
  78
  79         return () if !defined $args{"destination_port"};
  80         my $source_port=$args{"source_port"} || $args{"destination_port"};
  81
  82         return $self->_iebuilder(0x05,  #IEI: application port addressing scheme, 16 bit address
  83                         ($args{"destination_port"} >> 8), ($args{"destination_port"} & 0xFF),
  84                         ($source_port >> 8), ($source_port & 0xFF),
  85         );
  86 }
  87
  88 sub _ie_concat8 {
  89         my ($self, %args) = @_;
  90
  91         return $self->_iebuilder(0x00,  #IEI: concatenated short message, 8 bit reference
  92                         $args{"drn"},  # reference number
  93                         $args{"fmax"}, # maximum number of short messages
  94                         $args{"fsn"},  # sequence number of the current short message
  95         );
  96 }
  97
  98 # Use $args{"force_variable"} to force type IEI_PICTURE_VARIABLE
  99 # It needs to be used for compatibility with Alcatel 311 (firmware 101.01)
 100 #  - reported/tested by Radek Kadner <radek.kadner@atspraha.cz>
 101
 102 sub _ie_ems_picture {
 103         my ($self, %args) = @_;
 104         my $bitmap = $args{"bitmap"};  # GSM::SMS::Bitmap instance
 105
 106         $bitmap->crop(0xFF*8,0xFF);
 107         my ($width, $height) = ($bitmap->{"width"}, $bitmap->{"height"});
 108
 109         my $iei;
 110            if ($width == 16 && $height == 16) { $iei = IEI_PICTURE_SMALL   ; }
 111         elsif ($width == 32 && $height == 32) { $iei = IEI_PICTURE_LARGE   ; }
 112         else                                  { $iei = IEI_PICTURE_VARIABLE; }
 113         $iei = IEI_PICTURE_VARIABLE if $args{"force_variable"};
 114
 115         return $self->_iebuilder($iei,
 116                         $args{TEXT_POSITION}, # position in the SMS
 117                         ($iei != IEI_PICTURE_VARIABLE ? () : (int(($width+7)/8), $height)),  # image size (optional)
 118                         $bitmap->pixlist_horiz()
 119         );
 120 }
 121
 122 # @$bitmaps
 123 sub ems_animation_maxsize
 124 {
 125 my($bitmaps)=@_;
 126
 127         if (4 != @$bitmaps) {
 128                 carp "Invalid length of EMS animation (4 required)"; return ();
 129         }
 130         my $bitmap = $$bitmaps[0];
 131         my ($width, $height) = ($bitmap->{"width"}, $bitmap->{"height"});
 132         for my $testbitmap (@$bitmaps) {
 133                 $width =max($width ,$testbitmap->{"width" });
 134                 $height=max($height,$testbitmap->{"height"});
 135                 }
 136         return ($width,$height);
 137 }
 138
 139 sub _ie_ems_animation {
 140         my ($self, %args) = @_;
 141         my $bitmaps = $args{"bitmaps"};  # list of GSM::SMS::Bitmap instances
 142
 143         my ($width, $height) = ems_animation_maxsize($bitmaps);
 144
 145         my $iei;
 146            if ($width <=  8 && $height <=  8) { $iei = IEI_ANIMATION_SMALL   ; }
 147         elsif ($width <= 16 && $height <= 16) { $iei = IEI_ANIMATION_LARGE   ; }
 148         else {
 149                 $iei = IEI_ANIMATION_LARGE;
 150                 carp "Invalid frame size of EMS animation (<=16x<=16 required)";
 151         }
 152
 153         return $self->_iebuilder($iei,
 154                         $args{TEXT_POSITION}, # position in the SMS
 155                         &{sub {
 156                                 my @r=();
 157                                 for my $bitmap (@$bitmaps) {
 158                                         push @r,$bitmap->pixlist_horiz();
 159                                 }
 160                                 return @r;
 161                         }}
 162         );
 163 }
 164
 165 sub _ie_ems_melody {
 166         my ($self, %args) = @_;
 167
 168         return $self->_iebuilder(IEI_IMELODY,
 169                         $args{TEXT_POSITION}, # position in the SMS
 170                         unpack("C*",$args{"textdata"}),
 171         );
 172 }
 173
 174 sub _ie_alcatel {
 175         my ($self, %args) = @_;
 176
 177         return $self->_iebuilder(IEI_ALCATEL,
 178                         (!defined($args{"name"}) ? (0x00) :  # bit 7=0 (use GSM charset)
 179                                         (length($args{"name"}), unpack("C*",
 180                                                         encode_payload(0xF1, GSM::SMS::PDU->inversetranslate($args{"name"}))))  # 0xF1 DCS=any 7bit
 181                                         ),
 182                         (!!$args{"ems_compat"} << 7)  # bit 7=EMS compatibility
 183                                         |($args{"alcatel_type"} & 0x07),  # bits 0..2=Alcatel message type
 184                         ($args{"length"} >> 8), ($args{"length"} & 0xFF),
 185         );
 186 }
 187
 188 sub _udh_build {
 189         my ($self, @srcs) = @_;
 190
 191         my @r=();
 192         no strict 'refs';
 193         my @list=map { &{"_ie_".$$_{"type"}}($self,%$_); } @srcs;
 194         use strict 'refs';
 195         return "" if !@list;
 196         # if it is too long it will be recalculated anyway
 197         return pack "C*",(@list<=0xFF ? scalar(@list) : 0xFF),@list;
 198 }
 199
 200 sub udh_prepare_ems_picture
 201 {
 202 my($udh)=@_;
 203
 204         my $bitmap=$udh->{"bitmap"};  # GSM::SMS::Bitmap instance
 205         $bitmap->crop(0xFF*8,0xFF);
 206         my ($width, $height) = ($bitmap->{"width"}, $bitmap->{"height"});
 207
 208         # pixel-payload of concat8 SMS w/one IEI_PICTURE_VARIABLE is 129 bytes
 209         my $stripe=int(129/int(($width+7)/8));
 210         carp "Image width too big to fit in one SMS part" if $stripe<=0;        # ==0
 211         return $udh if $stripe>=$height;
 212         my @r=();
 213         # Here we can't touch the text and thus we do split to lines without
 214         # giving there a newline! For proper way see &gsmcmd::ems_picture_send
 215         for (my $y=0;$y<$height;$y+=$stripe) {
 216                 push @r,{
 217                                 %$udh,
 218                                 "bitmap"=>GSM::SMS::Bitmap->new($bitmap,0,$y,$width,min($stripe,$height-$y)),
 219                                 };
 220                 }
 221         return @r;
 222 }
 223
 224 sub udh_prepare_ems_animation
 225 {
 226 my($udh)=@_;
 227
 228         my $bitmaps = $udh->{"bitmaps"};  # list of GSM::SMS::Bitmap instances
 229         my ($width, $height) = ems_animation_maxsize($bitmaps);
 230         return $udh if $width<=16 && $height<=16;
 231
 232         my @r=();
 233         my $height_now;
 234         # Here we can't touch the text and thus we do split to lines without
 235         # giving there a newline! For proper way see &gsmcmd::ems_animation_send
 236         for (my $y=0;$y<$height;$y+=$height_now) {
 237                 $height_now=($y+8>=$height ? 8 : 16);
 238                 my $width_now;
 239                 for (my $x=0;$x<$width;$x+=$width_now) {
 240                         # Never risk undeterministic wrapping if some rows yet to follow
 241                         # And we must be a square, not much other possibilies exist
 242                         $width_now=$height_now;
 243                         push @r,{
 244                                         %$udh,
 245                                         "bitmaps"=>[ map({
 246                                                         GSM::SMS::Bitmap->new($_,$x,$y,$width_now,$height_now);
 247                                                         } @$bitmaps) ],
 248                                         };
 249                         }
 250                 }
 251         return @r;
 252 }
 253
 254 sub udh_prepare
 255 {
 256 my($udh)=@_;
 257
 258         return udh_prepare_ems_picture($udh)   if $udh->{"type"} eq "ems_picture";
 259         return udh_prepare_ems_animation($udh) if $udh->{"type"} eq "ems_animation";
 260         return $udh;
 261 }
 262
 263 # Create a message from a payload
 264 # returns either error message or list (DECONCAT_TOTAL,total messages)
 265 sub _store_try {
 266         my ($self, $number, $payload, %args) = @_;
 267
 268         # Reset the FRAME array
 269         $self->{'__FRAMES__'} = [];
 270
 271
 272         my $PDU = GSM::SMS::PDU->new();
 273
 274         my @udhs=($args{"udh"} ? @{$args{"udh"}} : ());
 275         @udhs=map({ udh_prepare($_); } @udhs);
 276
 277         # We put ME-specific default if ANY element of UDH was specified
 278         # Autodetect $dcs BEFORE possible concatenation UDH IEs get inserted!
 279         my $dcs=$args{"dcs"} || (@udhs ? DEFAULT_DCS_UDH : DEFAULT_DCS_NOUDH);
 280         # print "DCS: $dcs\n";
 281
 282         my $deconcat_ieref; # defined only if deconcatenating
 283         if (defined $args{DECONCAT_TOTAL}) {
 284                 my %deconcat_ie=(
 285                                 "type"=>"concat8",
 286                                 "drn"=>int(rand(0xFF)),        # reference number
 287                                 "fmax"=>$args{DECONCAT_TOTAL}, # maximum number of short messages
 288                                 "fsn"=>0x00,                   # sequence number of the current short message
 289                 );
 290                 $deconcat_ieref=\%deconcat_ie;
 291                 push @udhs,$deconcat_ieref;
 292                 return "Too long message (".$deconcat_ie{"fmax"}." elements)" if (0xFF < $deconcat_ie{"fmax"});
 293         }
 294
 295         my @udhstatic=();
 296         my @udhpositioned=();
 297         for my $udh (@udhs) {
 298                 if (exists $udh->{TEXT_POSITION}) {
 299                         push(@udhpositioned, $udh);
 300                 } else {
 301                         push(@udhstatic, $udh);
 302                 }
 303         }
 304         @udhpositioned = sort { $a->{TEXT_POSITION} <=> $b->{TEXT_POSITION}; } @udhpositioned;
 305
 306         my $position=0;           # absolute current position in the whole long SMS
 307         while (length $payload || @udhpositioned) {
 308                 my @udhpositioned_now=();    # items from @udhpositioned placed in the current SMS part
 309                 my $payload_now="";          # text  from $payload       placed in the current SMS part
 310                 while (1) {
 311                         if (@udhpositioned && $udhpositioned[0]{TEXT_POSITION} <= $position) { # "<=" should be "=="
 312                                 if (USERDATA_LENGTH < length($self->_udh_build(@udhstatic,@udhpositioned_now,$udhpositioned[0]))
 313                                                 +nail_payload_len($dcs,length($payload_now))) {
 314                                         return (DECONCAT_TOTAL, undef) if !$deconcat_ieref;
 315                                         return "UDH IE (User Data Header Information Element) too long to fit in one SMS fragment"
 316                                                         if $payload_now eq "" && !@udhpositioned_now;
 317                                         last;
 318                                         }
 319
 320                                 my %udhei=%{shift @udhpositioned};  # copy it to local state - we will be modifying it
 321                                 # we subtract the absolute position base of current SMS part:
 322                                 $udhei{TEXT_POSITION} -= $position-length($payload_now);
 323
 324                                 push @udhpositioned_now,\%udhei;
 325                                 next;
 326                         }
 327                         my $minlen=length $payload;
 328                         $minlen=min($minlen,$udhpositioned[0]{TEXT_POSITION}-$position) if @udhpositioned;
 329                         $minlen=min($minlen,empty_subload($dcs,
 330                                         USERDATA_LENGTH-length($self->_udh_build(@udhstatic,@udhpositioned_now))-length($payload_now)))
 331                                         if defined $args{DECONCAT_TOTAL};
 332                         last if $minlen<=0; # "<=" should be "=="
 333                         $payload_now.=substr($payload,0,$minlen);
 334                         $payload=substr($payload,$minlen);
 335                         $position+=$minlen;
 336                 }
 337
 338                 # We will ship out the current SMS part here
 339                 ++$deconcat_ieref->{"fsn"} if $deconcat_ieref;
 340                 # We exceeded userdata size, this is probably the first undeconcatenaed try from store()!
 341                 my $userdata=$self->_udh_build(@udhstatic,@udhpositioned_now).encode_payload($dcs,$payload_now);
 342
 343                 return (DECONCAT_TOTAL, undef) if USERDATA_LENGTH < length($userdata);
 344
 345                 my $pdu = $PDU->SMSSubmit(DEFAULT_SMS_CENTER, $number, $userdata,
 346                                 $dcs, DEFAULT_VALIDITY, !!@udhstatic || !!@udhpositioned_now
 347                                 );
 348                 # Push on to frame array
 349                 # print "--> $pdu\n";
 350                 push(@{$self->{"__FRAMES__"}}, $pdu);
 351         }
 352
 353         carp "Last fsn==".$deconcat_ieref->{"fsn"}." but fmax==".$deconcat_ieref->{"fmax"}
 354                         if $args{DECONCAT_TOTAL} && $deconcat_ieref->{"fsn"}!=$deconcat_ieref->{"fmax"};
 355         return (undef,(!$deconcat_ieref ? 1 : $deconcat_ieref->{"fsn"})); # success, return number of _PRODUCED_ MSes
 356 }
 357
 358 sub store {
 359         my ($self, $number, $payload, %args) = @_;
 360
 361         my ($err, $total);
 362         ($err, $total) = $self->_store_try($number, $payload, %args, DECONCAT_TOTAL=>undef ); return $err if !$err || $err ne DECONCAT_TOTAL;
 363         ($err, $total) = $self->_store_try($number, $payload, %args, DECONCAT_TOTAL=>0     ); return $err if $err;
 364         ($err, $total) = $self->_store_try($number, $payload, %args, DECONCAT_TOTAL=>$total); return $err;
 365 }
 366
 367 # Return the frames
 368 sub get_frames {
 369         my $self = shift;
 370         return $self->{'__FRAMES__'};
 371 }
 372
 373
 374 1;
 375
 376 =head1 NAME
 377
 378 GSM::SMS::NBS::Message - SAR functionality for NBS messages.
 379
 380 =head1 DESCRIPTION
 381
 382 Implements the segmentation in the SAR engine ( Segmentation And Reassembly ).
 383
 384 =head1 AUTHOR
 385
 386 Johan Van den Brande <johan@vandenbrande.com>