--- /dev/null
+Revision history for Perl extension GSM::SMS.
+
+ Thu Dec 20 22:44:59 CET 2001
+ - Got a nice patch from David Wright. He fixed some bugs in the
+ code handling the ringtones (RTTTL.pm)
+ - PDU.pm: Solved warning when doing test with Test::More
+ - Transport.pm : Bails out properly now when a transport fails to load.
+
+0.142 Wed Dec 12 23:13:04 CET 2001
+ - Fixed the mysteriously vanishing of SMS messages from the GSM modem.
+ I can't reproduce the error anymore, since I fixed the
+ TTL (Time To Live) in Stack.pm.
+
+0.141 Sat Aug 18 16:11:35 CEST 2001
+ - Fixed export of OTAOperatorlogo_from{file,b64} in GSM::SMS::OTA::
+ Operatorlogo.
+
+0.14 Wed Aug 8 19:13:44 CEST 2001
+ - Release for 1.4
+
+0.133 Tue Aug 7 22:31:33 CEST 2001
+ - We now have MIDI support!
+ Added GSM::SMS::Support::RTTTL2MIDI, kindly donated by isminiz
+ <ethemevlice@yahoo.com>. Based upon code from G.Babakhani ...
+
+0.132 Tue Aug 7 20:03:30 CEST 2001
+ - Serial transport now waites for the GSM modem to come up. It will
+ read out the SIM card ( phonebook? ) when first coming up, and
+ this could cause some trouble. Thanks to Warwick Smith for fixing
+ this.
+
+0.131 Mon Aug 6 23:11:59 CEST 2001
+ - Updated NBS.pm and Transport.pm. Now the return value from
+ the Trnsport subsystem really gets into the upper API.
+ Thanks to Warwick Smith for pointing this one out to me.
+
+0.13 Tue Jul 24 22:45:37 CEST 2001
+ - Updated examples/slashdot/slashdot to be verbose
+ on not being able to send. Using the new return
+ values from GSM::SMS::NBS.
+
+ Sat Jul 21 17:57:11 CEST 2001
+ - Changed the return value in NBS.pm of all functions.
+ The return value was 'hardwired' to -1, meaning success.
+ Now this value has changed to the C convention:
+ -1 means failure.
+ 0 means success.
+ ( This oddity needs to get in the release documentation,
+ as it can break existing implementations. )
+
+0.12 Sat Jul 14 23:27:00 CEST 2001
+ - Adding support for an XmlRpc node transport.
+ This transport is application specific, it used by the
+ mercury project, a small SMS Messaging Server build
+ on top of the GSM::SMS package.
+
+0.11 Sat Jul 14 20:52:24 CEST 2001
+ - MCube (www.mcube.be) support for text messages implemented
+ Binary support does not seem to work correctly for now.
+ - Implemented optimised delete for Serial transport.
+ Attributed by Toni Mattila <tontsa@asiaonline.net.my>.
+ - New config parameter for Serial transport:
+ memorylimit = nn
+ ( nn = 10 for WaveCom, nn = 15 for Siemens C25 )
+ Pointed out by Toni Mattila <tontsa@asiaonline.net.my>
+
+0.1 Sun Jun 17 01:06:12 2001
+ - Preparing launch on CPAN
+ - added documentation and examples
+
+0.0 Sun Jun 3 21:46:04 2001
+ - original version; created by h2xs 1.20 with options
+ -XA -n GSM::SMS
+ - used the iSMS library modules and put them in another base
+ directory (class path). ( Tektonica::iSMS -> GSM::SMS ). I did this
+ to able to release them on CPAN.
--- /dev/null
+ NO WARRANTY
+
+BECAUSE THE SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE
+SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
+SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
--- /dev/null
+Changes
+MANIFEST
+Makefile.PL
+README
+DISCLAIMER
+novelsoft_example.conf
+SMS/Config.pm
+SMS/Log.pm
+SMS/NBS.pm
+SMS/NBS/Frame.pm
+SMS/NBS/Message.pm
+SMS/NBS/Stack.pm
+SMS/PDU.pm
+SMS/Spool.pm
+SMS/Transport.pm
+SMS/Transport/Transport.pm
+SMS/Transport/NovelSoft.pm
+SMS/Transport/Serial.pm
+SMS/Transport/XmlRpc.pm
+SMS/OTA/OTA.pm
+SMS/OTA/Bitmap.pm
+SMS/OTA/CLIicon.pm
+SMS/OTA/Config.pm
+SMS/OTA/Operatorlogo.pm
+SMS/OTA/RTTTL.pm
+SMS/OTA/VCard.pm
+SMS/Support/RTTTL2MIDI.pm
+t/01_constructor.t
+t/02_transport_mcube.t
+examples/smartmessagingserver/README
+examples/smartmessagingserver/sms
+examples/smartmessagingserver/sms.conf
+examples/smartmessagingserver/transport.conf
+examples/smartmessagingserver/media/groupgraphics/0001.gif
+examples/smartmessagingserver/media/groupgraphics/0002.gif
+examples/smartmessagingserver/media/groupgraphics/0003.gif
+examples/smartmessagingserver/media/rtttl/0001.rtttl
+examples/smartmessagingserver/media/rtttl/0002.rtttl
+examples/smartmessagingserver/media/rtttl/0003.rtttl
+examples/slashdot/README
+examples/slashdot/slashdot
+examples/slashdot/transport.conf
+codes.txt
+rtttlsyntax.txt
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'GSM::SMS',
+ 'VERSION_FROM' => 'SMS/NBS.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+);
--- /dev/null
+ GSM::SMS
+ Perl Modules For Smart Messaging
+
+
+
+INTRODUCTION
+
+This set of modules allows you to send and receive SMS messages. Besides text
+messages you can also use Smart Messages, also known as ringing tones,
+groupgraphics, vcards etc...
+
+Out of the box, it comes with a serial transport and a transport for Novelsoft,
+a HTTP based SMSC (http://www.sms-wap.com ). To use the serial transport you
+will need a GSM modem, like the wavecom WMOD2B ( http://www.wavecom.com ). If
+you want to receive SMS messages, the serial solution is the only one for the
+moment. You even can have some success with running the gnokii project to power
+a Nokia 6110 or something, but I have not tested this. Other options are the
+M20 from Siemens and the A1 or A2 from Falcom.
+
+The module that is the most interesting for you is probably the GSM::SMS::NBS
+module, as this is the high level interface you are supposed to use. Please
+look at the examples to see how you use the library.
+
+For the moment the package comes with support for the following Smart Messaging
+formats:
+
+ * ring tones (RTTTL)
+ * Caller Line Identification logos
+ * Operator logos
+ * VCard
+ * OTA Configuration for WAP phones
+
+NEW IN THIS RELEASE
+ Look in the 'Changes' file for a complete review and credits.
+
+ * GSM::SMS::NBS::sendOperatorLogo_from{file,b64} now works.
+ * GSM::SMS::Support::RTTTL2MIDI converts rtttl strings to midi.
+ * Serial transport wait correctly for the modem to come up when
+ reading SIM card information (phonebook, ...).
+ * GSM::SMS::NBS returns success and failure correctly
+ * XmlRpc Transport for remote node functionality.
+ ( Look at the iSMS package for example, http://www.tektonica.com )
+ * Faster SMS delete on Serial transport
+ * Supports more GSM modems ( Siemens ) by use of extra
+ config parameter ( memorylimit ).
+
+PREREQUISITES
+
+Following packages are mandatory
+
+ * Data::Dumper
+ * MIME::Base64
+ * Image::Magick
+ * LWP
+ * Device::SerialPort
+
+
+
+INSTALL
+
+I *should* be a simple:
+ perl Makefile.PL
+ make
+ make install
+
+
+
+CONFIGURATION
+
+This is important, because the transports need to be configured.
+The best you can do is look in the examples for the file transport.cfg.
+This file contains the necessary settings for the transports and are
+(clearly) documented. As time permits I will be expanding the documentation.
+
+SERIAL TRANSPORT
+
+A note about the serial transport. To use this you need to have
+Device::SerialPort installed. For the moment this also means that this part is
+not Win32 compliant, as another module ( Win32::SerialPort ) is used on the
+other system. Expect an update that also works on window systems.
+
+A problem that can arise when using the serial tarnsport is the setting of the
+service center address. If this happens, or if you want to set this manually,
+use the following command(s) in your favourite comms program. I use minicom ...
+
+ >minicom -s
+ AT+CPIN?
+ Check for pincode
+ AT+CPIN="nnnn"
+ Set pincode. Important ... only 3 tries!!!
+ AT+CSCA?
+ Check for service center address
+ AT+CSCA="+32475161616"
+ Set service center address. ( This one is for proximus belgium ).
+
+EXAMPLES
+
+Look in the examples directory, this should get you started.
+The most complex one is the smartmessagingserver, allowing you to request a
+rttl or groupgraphic by sending an sms message. The slashdot example allows
+you to receive the latest slashdot headlines in a SMS message. The ideas are
+ofcourse endless. I've build an application on top of these modules that
+expose the send functions in an XMLRPC way, thus creating a SMS webservice.
+
+
+
+BUGS
+
+Probably a lot. I hope I get a lot of feedback so we can figure the bugs out
+and start fixing them!
+
+
+AUTHOR
+
+Johan Van den Brande
+johan@vandenbrande.com
+
+
+
+COPYRIGHT
+
+Copyright (c) 1999-2001 Johan Van den Brande
+All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+DISCLAIMER
+
+I take no responsibility for anything that can go wrong or can be done wrong
+with this piece of software.
+
+Please look at the file DISCLAIMER.
--- /dev/null
+package GSM::SMS::Config;\r
+# Test for config\r
+# ------------------------------------------------------------------------\r
+\r
+# Config format:\r
+# ^# := comment\r
+# ^[.+]$ := start block\r
+# ^.+=.+$ := var, value pair\r
+# $_preferences->{$blockname}->{$var}=$value\r
+# $blockname = ( 'default', <blocknames> }\r
+\r
+use Exporter;\r
+@ISA = ('Exporter');\r
+@EXPORT = qw( &read_config &get_config);\r
+$VERSION = '0.1';\r
+\r
+sub read_config {\r
+ my ($filename) = @_;\r
+ my $config = {};\r
+ \r
+ # prepare default config\r
+ my $hook = {};\r
+ $config->{'default'} = [];\r
+ push(@{$config->{'default'}}, $hook);\r
+ \r
+ # open config file\r
+ local(*F);\r
+ open F, $filename or return undef;\r
+ while (<F>) {\r
+ chomp; # loose trailing newline\r
+ s/#.*//; # loose comments\r
+ s/^\s+//; # loose leading white\r
+ s/\s+$//; # loose trailing white;\r
+ next unless length; # did we loose everything?\r
+ \r
+ # recon block or var/value pair ...\r
+ if ( /\[(.+?)\]/ ) {\r
+ $hook = {} ;\r
+ $config->{$1} = [];\r
+ push( @{$config->{$1}}, $hook );\r
+ } else {\r
+ my ($var, $value) = split(/\s*=\s*/, $_, 2);\r
+ $hook->{$var} = $value;\r
+ }\r
+ }\r
+ close F;\r
+\r
+ return $config;\r
+}\r
+\r
+sub get_config {\r
+ my ($config, $name) = @_;\r
+ \r
+ return ${$config->{$name}}[0];\r
+}\r
+1; \r
+\r
+=head1 NAME\r
+\r
+GSM::SMS::Config - Implements a simple .ini style config.\r
+\r
+=head1 DESCRIPTION\r
+\r
+Implements a simple configuration format. Used mainly for the transports config file.\r
+\r
+=head1 AUTHOR\r
+\r
+Johan Van den Brande johan@vandenbrande.com>\r
--- /dev/null
+package GSM::SMS::Log;
+use Time::localtime;
+
+# Very simple logger
+#
+
+use Exporter;
+@ISA = ('Exporter');
+@EXPORT = qw( logentry );
+$VERSION = '0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ $self->{'__LOGFILE__'} = shift;
+ bless($self, $class);
+ return $self;
+}
+
+sub logentry {
+ my ( $self, $text ) = @_;
+ local (*F);
+
+ my $LOGFILE = $self->{'__LOGFILE__'};
+ if ( $LOGFILE ) {
+
+ open F, ">>$LOGFILE";
+ my $tm = localtime(time);
+ print F sprintf("[%02d/%02d/%02d %02d:%02d:%02d]\t%s\n",
+ $tm->mday,
+ $tm->mon+1,
+ $tm->year+1900,
+ $tm->hour,
+ $tm->min,
+ $tm->sec,
+ $text
+ );
+ close F;
+
+ }
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::Log - Implements a simple file logger.
+
+=head1 DESCRIPTION
+
+Implements a simple logger.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::NBS;
+
+use vars qw($VERSION);
+
+$VERSION = '0.142';
+
+use GSM::SMS::NBS::Message;
+use GSM::SMS::NBS::Stack;
+use GSM::SMS::OTA::RTTTL;
+use GSM::SMS::OTA::CLIicon;
+use GSM::SMS::OTA::Operatorlogo;
+use GSM::SMS::OTA::VCard;
+use GSM::SMS::OTA::Config;
+use GSM::SMS::Transport;
+use MIME::Base64;
+
+
+#
+# Constructor
+#
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless($self, $class);
+
+ $self->{'__CONFIG_FILE__'} = shift;
+ return undef unless $self->{'__TRANSPORT__'} = GSM::SMS::Transport->new( $self->{'__CONFIG_FILE__'});
+ $self->{'__STACK__'} = GSM::SMS::NBS::Stack->new( -transport => $self->{'__TRANSPORT__'} );
+ return $self;
+}
+
+#
+# Send message
+#
+sub sendto {
+ my ($self, $msisdn, $message, $dport, $sport, $dcs ) = @_;
+ my $ret = 0;
+
+ my $transport = $self->{'__TRANSPORT__'};
+
+ my $nbs_message = GSM::SMS::NBS::Message->new();
+ $nbs_message->create($msisdn, $message, $dport, $sport, $dcs);
+ foreach my $frame ( @{$nbs_message->get_frames()} ) {
+ # transport->send returns -1 on failure.
+ $ret = -1 if $transport->send($msisdn, $frame);
+ }
+ return $ret;
+}
+
+#
+# send ringing tone
+#
+sub sendRTTTL {
+ my ($self, $msisdn, $rtttlstring) = @_;
+
+ if ( my $error = OTARTTTL_check($rtttlstring) ) {
+ return $error;
+ }
+
+ my $music = OTARTTTL_makestream($rtttlstring);
+ return $self->sendto( $msisdn, $music, OTARTTTL_PORT);
+}
+
+#
+# send operator logo
+#
+sub sendOperatorLogo_b64 {
+ my ($self, $msisdn, $country, $operator, $b64, $format) = @_;
+
+ my $ol = OTAOperatorlogo_fromb64( $country, $operator, $b64, $format );
+ return $self->sendto( $msisdn, $ol, OTAOperatorlogo_PORT);
+}
+
+#
+# send operator logo
+#
+sub sendOperatorLogo_file {
+ my ($self, $msisdn, $country, $operator, $file ) = @_;
+
+ my $ol = OTAOperatorlogo_fromfile( $country, $operator, $file );
+ return $self->sendto($msisdn, $ol, OTAOperatorlogo_PORT);
+}
+
+#
+# send group graphic
+#
+sub sendGroupGraphic_b64 {
+ my ($self, $msisdn, $b64, $format) = @_;
+
+ my $gg = OTACLIicon_fromb64( $b64, $format );
+ return $self->sendto($msisdn, $gg, OTACLIicon_PORT);
+}
+
+#
+# send group graphic
+#
+sub sendGroupGraphic_file {
+ my ($self, $msisdn, $file) = @_;
+
+ my $gg = OTACLIicon_fromfile( $file );
+
+ return $self->sendto($msisdn, $gg, OTACLIicon_PORT);
+}
+
+#
+# send VCard
+#
+sub sendVCard {
+ my ($self, $msisdn, $lname, $fname, $phone) = @_;
+
+ my $vcard = OTAVcard_makestream( $last, $first, $phone );
+ return $self->sendto( $msisdn, $vcard, OTAVcard_PORT);
+}
+
+#
+# send OTA
+#
+sub sendConfig {
+ my ($self, $msisdn, $bearer, $connection, $auth, $type, $speed, $proxy, $home, $uid, $pwd, $phone, $name) = @_;
+
+ my $ret = -1;
+ my $ota = OTAConfig_makestream( $bearer, $connection, $auth, $type, $speed, $proxy, $home, $uid, $pwd, $phone, $name);
+ if ( $ota ) {
+ $ret = $self->sendto( $msisdn, $ota, OTAConfig_PORT, 9200);
+ }
+ return $ret;
+}
+
+#
+# send SMS text message
+#
+sub sendSMSTextMessage {
+ my ($self, $msisdn, $msg, $multipart) = @_;
+ my $cnt = 0;
+ my $ret = 0;
+ if ( $multipart ) {
+ while (length($msg) > 0) {
+ my $xmsg = substr($msg, 0, (length($msg)<160)?length($msg):160 );
+ $msg = substr($msg, 160, length($msg) - 160);
+ $ret = -1 if $self->sendto( $msisdn, $xmsg, undef, undef, '7bit');
+ $cnt++;
+ }
+ } else {
+ $msg = substr($msg, 0, (length($msg)<160)?length($msg):160 );
+ $ret = $self->sendto( $msisdn, $msg, undef , undef , '7bit');
+ }
+ return ($ret==-1)?$ret:$cnt;
+}
+
+#
+# receive SMS message from stack
+#
+sub receive {
+ my ($self, $ref_originatingaddress, $ref_message, $ref_timestamp, $ref_transportname, $ref_port, $blocking) = @_;
+
+ my $stack = $self->{'__STACK__'};
+ return $stack->receive($ref_originatingaddress, $ref_message, $ref_timestamp, $ref_transportname, $ref_port, $blocking);
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::NBS - API for sending and receiving SMS messages.
+
+=head1 SYNOPSIS
+
+ use GSM::SMS::NBS;
+
+ my $nbs = GSM::SMS::NBS->new( $transportconfigfile );
+
+ ...
+
+ $nbs->sendRTTTL( '+32475000000', $rtttl_string );
+ $nbs->sendOperatorLogo_b64( $msisdn, $countrycode, $operator, $b64, 'gif' );
+ $nbs->sendOperatorLogo_file( $msisdn, $countrycode, $operatorcode, $file );
+ $nbs->sendGroupGraphic_b64( $msisdn, $b64, 'png' );
+ $nbs->sendGroupGraphic_file( $msisdn, $file );
+ $nbs->sendVCard( $msisdn, $lastname, $firstname, $phonenumber );
+ $nbs->sendConfig( .... );
+ $nbs->sendSMSTextMessage( $msisdn, $message, $multipart );
+
+ ...
+
+ my $originatingaddress;
+ my $message;
+ my $timestamp;
+ my $transportname;
+ my $port;
+ my $blocking = 1;
+
+ $nbs->receive( \$originatingaddress,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ $blocking
+ );
+
+ print "I got a message from $originatingaddress\n";
+
+
+=head1 DESCRIPTION
+
+This module is the API you would normally use to send and receive sms messages.
+It exports all the important methods and hides some of the more complex things.
+It needs a configuration file in it's constructor. The configuration is transport specific but looks like:
+
+ [transportname]
+ name = parameter
+ ...
+ [othertransport]
+ name = parameter
+ ...
+
+Look into the transport.cfg files in the examples on how to set it up.
+
+=head1 METHODS
+
+=head2 new
+
+ my $nbs = GSM::SMS::NBS->new( $configfile );
+
+This is the constructor, it expects a file name of a transport configuration as an argument.
+All functions return -1 on failure, 0 on success.
+
+=head2 sendSMSTextMessage
+
+ $nbs->sendSMSTextMessage( $msisdn, $msg, $multipart );
+
+Send a text message ( $msg ) to the gsm number ( $msisdn ). If you set $multipart to true (!=0) the message will be split automatically in 160 char blocks. When $multipart is set to false it will be truncated at 160 characters.
+
+=head2 sendRTTTL
+
+ $nbs->sendRTTTL( $msisdn, $rtttlstring );
+
+Send a ringing tone ( $rtttlstring ) to the specified telephone number ( $msisdn ). The RTTTL ( Ringing Tone Tagged Text Language ) format is specified as described in the file rtttlsyntax.txt.
+
+You can find a lot of information about RTTTL ( and a lot of ringing tones ) on the internet. Just point your favourite browser to your favourite searchengine and look for ringing tones.
+
+=head2 sendGroupGraphic_b64
+
+ $nbs->sendGroupGraphic_b64( $msisdn, $b64, $format);
+
+Send a group graphic, also called a Caller Line Identification icon ( CLIicon ),to the recipient indicated by the telephone number $msisdn. It expects a base 64 encoded image and the format the image is in, like 'gif', 'png'. To find out which image formats are supported, look at the superb package Image::Magick. The base 64 encoded image is just a serialisation of an image file, not of the image bitarray. The image is limited in size, it needs to be 71x14 pixels.
+The base 64 encoding is used here because you maybe want to build a HTTP (XMLRPC ) gateway to send images. Without the _b64 method you would need to save the image file to disk and use the _file method, this is cumbersome ...
+A group graphic is used to visually identify the group the caller belongs to. If you have a friend who calls you and his number is in the group 'friends', you probably would want to picture a pint of beer.
+
+=head2 sendGroupGraphic_file
+
+ $nbs->sendGroupGraphic_file( $msisdn, $file);
+
+Send a group graphic to $msisdn, use the image in file $file. The image must be 71x14 pixels.
+
+=head2 sendOperatorLogo_b64
+
+ $nbs->sendOperatorLogo_b64( $msisdn, $country, $operator, $b64, $format);
+
+An operator logo indicates the operator you are connected to for the moment. This is used to have a nice logo on your telephone all of the time. I have also heard the term 'branding' overhere.
+You also need to provide a country code and operator code. I have assembled some of these and you can find them in the file codes.txt. These files will move into a seperate package, because you can find the operator and country codes programatically by using the first n numbers of the msisdn.
+The method expects a base64 serialised image and the format of the image, 'gif', 'png', next to the receiving telephone number ( $msisdn ) and the country and operator code.
+The image needs to be 71x14 pixels.
+
+=head2 sendOperatorLogo_file
+
+ $nbs->sendOperatorLogo_file( $msisdn, $country, $operator, $file );
+
+Send an operator logo to $msisdn, using the image in file $file.
+
+=head2 sendVCard
+
+ $nbs->sendVCard( $msisdn, $lastname, $firstname, $telephone );
+
+A VCard is a small business card, containing information about a person. It is not a GSM only standard, netscape uses vcards to identify the mail sender ( attach vcard option ). You can look at the complete VCard MIME specification in RFC 2425 and RFC 2426.
+
+=head2 sendConfig
+
+ $nbs->sendConfig( $msisdn, $bearer, $connection, $auth, $type, $speed, $proxy, $home, $uid, $pwd, $phone, $name);
+
+Send a WAP configuration to a WAP capable handset. It expects the following parameters:
+
+ The parameters in UPPERCASE are exported constants by the GSM::SMS::OTA::COnfig.
+
+ $msisdn Phonenumber recipient
+
+ $bearer OTA_BEARER_CSD | OTA_BEARER_SMS
+
+ The carrier used ( circuit switched data or sms ), WAP is
+ independent of the underlying connectivity layer.
+
+ $connection OTA_CONNECTIONTYPE_TEMPORARY
+ OTA_CONNECTIONTYPE_CONTINUOUS
+
+ You have to use continuous for CSD type of calls.
+
+ $auth OTA_CSD_AUTHTYPE_PAP
+ OTA_CSD_AUTHTYPE_CHAP
+
+ Use PAP or CHAP as authentication type. A CSD call is just
+ a data call, and as such can use a normal dial-in point.
+
+ $type OTA_CSD_CALLTYPE_ISDN
+ OTA_CSD_CALLTYPE_ANALOGUE
+
+ $speed OTA_CSD_CALLSPEED_9600
+ OTA_CSD_CALLSPEED_14400
+ OTA_CSD_CALLSPEED_AUTO
+
+ $proxy IP address of the WAP gateway to use.
+
+ $home URL of the homepage for this setting. e.g.
+ http://wap.domain.com
+
+ $uid Dial-up userid
+
+ $pwd Dial-up password
+
+ $phone Dial-up telephone number
+
+ $name Nick name for this connection.
+
+ This feature has been tested on a Nokia 7110, but other Nokia
+ handsets are also supported.
+
+=head2 receive
+
+ $nbs->receive( \$originatingaddress,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ $blocking
+ );
+
+This method is used for implementing bidirectional SMS. With you can receive incoming messages. The only transport ( for the moment ) that can receive SMS messages is the Serial transport.
+
+The originatingaddress contains the sender msisdn number.
+
+The message contains the ( concatenated ) message. A NBS message can be larger than 140 bytes, so a UDP like format is used to send fragements. The lower layers of the GSM::SMS package take care of the SAR ( Segmentation And Reassembly ).
+
+The timestamp has the following format:
+
+ YYMMDDHHMMSSTZ
+
+ YY := 2 digits for the year ( 01 = 2001 )
+ MM := 2 digits for the month
+ DD := 2 digits for the day
+ HH := 2 digits for the hour
+ MM := 2 ditits for the minutes
+ SS := 2 digits for the seconds
+ TZ := timezone
+
+Transportname contains the name of the transport as defined in the config file.
+
+Port is the port number used to denote a specified service in the NBS stack.
+
+ my $originatingaddress;
+ my $message;
+ my $timestamp;
+ my $transportname;
+ my $port;
+ my $blocking = 1;
+
+ $nbs->receive( \$originatingaddress,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ $blocking
+ );
+
+ print "I got a message from $originatingaddress\n";
+
+=head1 BUGS
+
+Probably a lot. I hope to get some bug reports ...
+One odd behaviour is that the CSCA is not always set correctly.
+If receiving works, but sending not ( on the serial transport ),
+then issue the next command to the modem in e.g. minicom.
+
+ AT+CSCA="+32475161616"
+ ( For belgian proximus ... look at your operator
+ for correct csca address ).
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::NBS::Frame;
+
+$VERSION = '0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ bless($self, $class);
+ return $self;
+}
+
+
+sub destination_port {
+ my ($self, $dest)=@_;
+
+ $self->{destination} = $dest;
+}
+
+
+sub source_port {
+ my ($self, $source)=@_;
+
+ $self->{source} = $source;
+}
+
+sub datagram_reference_number {
+ my ($self, $drn)=@_;
+
+ $self->{drn} = $drn;
+}
+
+
+sub fragment_maximum {
+ my ($self, $fmax)=@_;
+
+ $self->{fmax} = $fmax;
+}
+
+sub fragment_sequence_number {
+ my ($self, $fsn) = @_;
+
+ $self->{fsn} = $fsn;
+}
+
+
+sub asString {
+ my ($self) = @_;
+
+ my $len;
+ my $out='';
+ my @NBS_HEADER;
+
+ $NBS_HEADER[0] = 11; # header length, without this byte
+ $NBS_HEADER[1] = 5; # Port address information element, 16bit
+ $NBS_HEADER[2] = 4; # Length of the info element
+ $NBS_HEADER[3] = ($self->{destination} & 0xff00) >> 8; # high byte destination
+ $NBS_HEADER[4] = $self->{destination} & 0xff; # low byte destination
+ $NBS_HEADER[5] = ($self->{source} & 0xff00) >> 8; # high byte source
+ $NBS_HEADER[6] = $self->{source} & 0xff; # low byte source
+ $NBS_HEADER[7] = 0; # Fragmentation information element
+ $NBS_HEADER[8] = 3; # Length of Info el
+ $NBS_HEADER[9] = $self->{drn}; # fragment id
+ $NBS_HEADER[10] = $self->{fmax}; # max amount of frags
+ $NBS_HEADER[11] = $self->{fsn}; # sequence number fragment
+
+ $len=12;
+ if ($self->{fmax} == 1) {
+ $len=7;
+ $NBS_HEADER[0] = 6;
+ }
+
+ for (my $j=0; $j<$len; $j++) {
+ $i=$NBS_HEADER[$j];
+ $out.=sprintf("%02x", $i);
+ }
+
+ return $out;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::NBS::Frame - Encapsulates frames for NBS messages.
+
+=head1 DESCRIPTION
+
+Create a frame for a NBS message.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::NBS::Message;
+use GSM::SMS::PDU;
+use GSM::SMS::NBS::Frame;
+
+$VERSION = '0.1';
+
+use constant DATAGRAM_LENGTH => 128;
+
+# SAR for NBS messages
+# --------------------
+# This part does the segmentation ... look in Stack.pm for reassembly
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{'__FRAMES__'} = [];
+
+ bless($self, $class);
+ return $self;
+}
+
+# Create a message from a payload
+sub create {
+ my ($self, $number, $payload, $destination_port, $source_port, $datacodingscheme) = @_;
+
+ # Reset the FRAME array
+ $#{$self->{'__FRAMES__'}} = -1;
+
+
+ my $nbs = GSM::SMS::NBS::Frame->new();
+ my $pdu = GSM::SMS::PDU->new();
+
+ my $datagram_length = DATAGRAM_LENGTH;
+
+ $source_port = $destination_port if (!defined($source_port));
+ my $dcs = '7bit';
+ $dcs = '8bitm' if (defined($destination_port));
+
+ # print "DATACODINGSCHEME: $datacodingscheme\n";
+
+ $dcs = $datacodingscheme if (defined($datacodingscheme));
+
+ my $udhi = -1;
+ $udhi = 0 if (!defined($destination_port));
+
+
+ my $payload_len = length($payload)/2;
+ my $frags;
+
+ # test if the payload can fit in one message (6= length of minimal header)
+ if (($payload_len + 6) <= 140) {
+ # Ok we can have 1 message
+ $frags=1;
+ $datagram_length = $payload_len;
+ } else {
+ $frags = int($payload_len/$datagram_length) + 1;
+ }
+
+ $nbs->destination_port($destination_port);
+ $nbs->source_port($source_port);
+
+ # If no destination port defined, then also no source port can be defined
+ # There can be a problem ! what if 2 nbs's send a nbs to the same phone with 2 the same datagrams?
+ # We have to solve this!
+ $nbs->datagram_reference_number(int(rand(255)));
+ $nbs->fragment_maximum($frags);
+
+ my $ok = 0;
+ for (my $i=1; $i<=$frags; $i++) {
+ my $subload = substr($payload, ($i-1)*$datagram_length*2, $datagram_length*2);
+ $nbs->fragment_sequence_number($i);
+ my $msg;
+ if ($destination_port) {
+ $msg = uc $nbs->asString().$subload;
+ } else {
+ $msg = $subload;
+ }
+ # print "DCS-> $dcs\n";
+ my $p = $pdu->SMSSubmit('', $number, $msg, $dcs, '1d', $udhi);
+ # print "--> $p\n";
+ # Push on to frame array
+ push(@{$self->{'__FRAMES__'}}, $p );
+
+ }
+ return 0 if ($ok == $frags);
+ return -1;
+}
+
+# Return the frames
+sub get_frames {
+ my $self = shift;
+ return $self->{'__FRAMES__'};
+}
+
+
+1;
+
+=head1 NAME
+
+GSM::SMS::NBS::Message - SAR functionality for NBS messages.
+
+=head1 DESCRIPTION
+
+Implements the segmentation in the SAR engine ( Segmentation And Reassembly ).
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::NBS::Stack;
+use GSM::SMS::PDU;
+use Data::Dumper;
+
+$VERSION = '0.1';
+
+# $__NBSSTACK_PRINT++;
+
+# Keep the packets alive for 1 day
+$__TIME_TO_LIVE = 60*60*24;
+
+# Constructor
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{STACK} = {};
+ my %arg = @_;
+ $self->{TRANSPORT} = $arg{"-transport"};
+
+ bless($self, $class);
+ return $self;
+}
+
+# receive NBS/SMS messages
+sub receive {
+ my ($self, $ref_oa, $ref_msg, $ref_timestamp, $ref_transport, $ref_port, $block) =@_;
+
+ my ($stack) = $self->{STACK};
+ my $t = $self->{TRANSPORT};
+
+ $self->_prt( "entering receive" );
+
+ while ($self->_complete_message_on_stack($stack, $ref_oa, $ref_msg, $ref_timestamp, $ref_transport, $ref_port)) {
+
+ $self->_prt( "CHECK\n" );
+
+ # look for new datagrams on the stack
+ foreach my $transporter ( @{$t->get_transports()} ) {
+ $self->_prt( "x" );
+ $self->_prt( "T: " . $transporter->get_name() . "\n" );
+ my $pdu;
+ if (!$transporter->receive(\$pdu)) {
+ $self->_prt( "SOMETHING\n" );
+ $self->_place_message_on_stack($stack, $pdu, $transporter->get_name());
+ $self->_prt( "RCV: $pdu\n" );
+ }
+ }
+ # Do some garbage collection -> when a datagram is not complete after a certain time frame
+ # +/- 2h then delete this datagram from the stack! (Long living stack with 'dead' messages.
+ $self->_garbage_collect($stack);
+
+ select(undef, undef, undef, 0.25);
+ return -1 unless $block;
+ $self->_prt( "BLOCKING LOOP" );
+ }
+ return 0;
+}
+
+sub _complete_message_on_stack {
+ my ($self, $stack, $ref_oa, $ref_msg, $ref_timestamp, $ref_transport, $ref_port) = @_;
+ my ($message, $complete, $msisdn, $timestamp, $transport, $port);
+ my ($oa_del, $dg_del);
+
+ $self->_prt( "IN ($stack)\n" );
+
+ foreach my $i (keys %$stack) {
+ my $oa = $stack->{$i};
+ $self->_prt( $oa."\n" );
+ $oa_del = $i;
+ foreach my $j (keys %$oa) {
+ my $dg = $oa->{$j};
+ $dg_del = $j;
+
+ # $dg is a datagram ref with ->{Fragments} = $PDU / ->{Timestamp} = time
+ # Check if we need to kill this datagram -> TTL expired
+ if ( (time - $dg->{Timestamp}) > $__TIME_TO_LIVE) {
+ $self->_prt( "TTL expired!\n" );
+ $self->_prt( $__TIME_TO_LIVE );
+ $self->_prt( $dg->{Timestamp} );
+ $self->_prt( "------------------" );
+ delete $oa->{$j};
+ next;
+ }
+
+ my $decoded_pdu = $dg->{Fragments}->[1];
+
+ if ($decoded_pdu) {
+ $port = $decoded_pdu->{'TP-DPORT'};
+ $msisdn = $decoded_pdu->{'TP-OA'};
+ $message= $decoded_pdu->{'TP-UD'};
+ $timestamp= $decoded_pdu->{'TP-SCTS'};
+ $transport = $decoded_pdu->{'XTRA-TRANSPORT'};
+ }
+
+ if ($decoded_pdu && $decoded_pdu->{'TP-DPORT'}) {
+ $self->_prt( "PORT!\n" );
+ $self->_prt( "-> " . $decoded_pdu->{'TP-DPORT'} ."\n" );
+ # We have a UDHI header structure here
+ my $l = $decoded_pdu->{'TP-FRAGMAX'};
+ $msisdn = $decoded_pdu->{'TP-OA'};
+
+ # assume complete ...
+ $complete++;
+ for (my $cnt=1; $cnt<=$l; $cnt++) {
+ if ($dg->{Fragments}->[$cnt]) {
+ $self->_prt( "CNT $cnt passed\n" );
+ my $frag = $dg->{Fragments}->[$cnt];
+ $message.=$frag->{'TP-UD'}; # When having text headers '//SCK', we concatenate also the //SCK for the moment
+ # we need a revision here for PDU.pm to solve this
+ $self->_prt( "[[".$frag->{'TP-UD'}."]]\n" );
+ } else {
+ $complete = undef;
+ }
+ }
+ }
+
+ if ($decoded_pdu && !$decoded_pdu->{'TP-DPORT'}) {
+ # We have a simple sms message
+ $self->_prt( "SIMPLE\n" );
+ $msisdn = $decoded_pdu->{'TP-OA'};
+ $message = $decoded_pdu->{'TP-UD'};
+ $timestamp = $decoded_pdu->{'TP-SCTS'};
+ $transport = $decoded_pdu->{'XTRA-TRANSPORT'};
+ $complete++;
+ }
+ last if ($complete);
+ }
+ last if ($complete);
+ }
+ if ($complete) {
+ # Communicate message to caller
+ $$ref_oa = $msisdn;
+ $$ref_msg = $message;
+ $$ref_timestamp = $timestamp;
+ $$ref_transport = $transport;
+ $$ref_port = $port;
+
+ # delete reference
+ $self->_prt( "delete $oa_del, $dg_del :::::>>>>> ".$stack->{$oa_del}->{$dg_del}->{Fragments}->[1]->{'TP-UD'} );
+ $self->_prt( "\n" );
+
+ delete $stack->{$oa_del}->{$dg_del};
+ return 0;
+ }
+ return -1;
+}
+
+
+sub _place_message_on_stack {
+ my ($self, $stack, $msg, $transport) = @_;
+
+ my $p = GSM::SMS::PDU->new();
+ my $decoded_pdu = $p->SMSDeliver($msg);
+
+ my $oa = $decoded_pdu->{'TP-OA'};
+ my $dg = $decoded_pdu->{'TP-DATAGRAM'} || 1;
+ my $id = $decoded_pdu->{'TP-FRAGSQN'} || 1;
+
+
+ # a "hack" to add the name of the transport to the stack
+
+ $decoded_pdu->{'XTRA-TRANSPORT'} = $transport;
+
+ if (!$stack->{$oa}) { # Create a new datagram on the 'stack'
+ $stack->{$oa} = {};
+ $stack->{$oa}->{$dg} = {};
+ $stack->{$oa}->{$dg}->{Fragments} = [];
+ $stack->{$oa}->{$dg}->{Timestamp} = undef;
+ }
+ $self->_prt( "[$oa][$dg][$id]\n" );
+
+ $stack->{$oa}->{$dg}->{Fragments}->[$id] = $decoded_pdu;
+ $stack->{$oa}->{$dg}->{Timestamp} = time; # update timestamp
+}
+
+
+sub _garbage_collect {
+ my ($self, $stack) = @_;
+
+ # I implemented the garbage collect intrinsic on the _complete_message on stack
+ # It will kill of messages on the stack with an old timestamp ( > delta_time )
+
+}
+
+sub _prt {
+ my ($self, $txt) = @_;
+
+ print $txt if ($__NBSSTACK_PRINT);
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::NBS::Stack - Narrow Bandwidth Socket protocol stack.
+
+=head1 DESCRIPTION
+
+Implements the Reassmbly part for the NBS messages.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::OTA::Bitmap;
+# Generic package for OTA bitmaps
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw( BITMAP_WIDTH BITMAP_HEIGHT OTABitmap_makestream OTABitmap_fromfile OTABitmap_fromb64 );
+
+$VERSION = '0.1';
+
+use constant BITMAP_WIDTH => 72;
+use constant BITMAP_HEIGHT => 14;
+
+use MIME::Base64;
+use Image::Magick;
+
+
+sub OTABitmap_makestream {
+ my ($width, $height, $depth, $ref_bytearray) = @_;
+
+
+ my $stream='';
+
+ $stream.= sprintf("%02X", $width);
+ $stream.= sprintf("%02X", $height);
+ $stream.= sprintf("%02X", $depth);
+ foreach my $byte (@$ref_bytearray) {
+ $stream.= uc unpack ('H2' , $byte);
+ }
+ return $stream;
+}
+
+sub OTABitmap_fromfile {
+ my ($filename) = @_;
+
+ my $image = Image::Magick->new( );
+ return -1 unless $image;
+
+ $image->Read( $filename );
+
+ # check image size
+ return -1 unless ( $image->Get('columns') == BITMAP_WIDTH && $image->Get('height') == BITMAP_HEIGHT );
+
+ # convert to monochrome
+ $image->Set(magick => 'mono');
+ my $monochrome = $image->ImageToBlob( );
+
+ # reverse bitorder
+ my @ba;
+ foreach my $b ( split //, $monochrome ) {
+ my $byte = reverse(unpack("B8", $b));
+ push(@ba, pack("B8", $byte));
+ }
+ undef $image;
+ return (\@ba);
+}
+
+sub OTABitmap_fromb64 {
+ my ($b64image, $format) = @_;
+
+ my $blob = decode_base64( $b64image );
+
+ my $image = Image::Magick->new( magick => $format );
+ return -1 unless $image; # wrong format ;-)
+
+ $image->BlobToImage( $blob );
+
+ # check image size
+ return -1 unless ( $image->Get('columns') == BITMAP_WIDTH && $image->Get('height') == BITMAP_HEIGHT );
+
+ # convert to monochrome
+ $image->Set(magick => 'mono');
+ my $monochrome = $image->ImageToBlob( );
+
+ # reverse bitorder
+ my @ba;
+ foreach my $b ( split //, $monochrome ) {
+ my $byte = reverse(unpack("B8", $b));
+ push(@ba, pack("B8", $byte));
+ }
+ undef $image;
+ return (\@ba);
+}
+1;
+
+=head1 NAME
+
+GSM::SMS::OTA::Bitmap
+
+=head1 DESCRIPTION
+
+Used to create a ota bitmap to use in CLI and OPERATOR logo's. We use the perlinterface to ImageMagick instead of the 'convert' command from the same package.
+
+=head1 METHODS
+
+=head2 OTABitmap_fromb64
+
+ $ref_bitmaparray = OTABitmap_fromb64($bitmap_image_b64, $format_of_image);
+
+Expects a bitmap in base64 format and the format of the image (e.g. 'gif', 'png'). The base64 method is here to be able to use the function in a webcentric way. This way you can e.g. use xmlrpc calls to exchange images for sending via SMS.
+
+=head2 OTABitmap_fromfile
+
+ $ref_bitmaparray = OTABitmap_fromfile($image_file);
+
+Create a bitmap array from a file.
+
+=head2 OTABitmap_makestream
+
+ $stream = OTABitmap_makestream( $width, $height, $depth, $ref_bitmaparray );
+
+Create a OTA Bitmap. Width is 72 and height is 14 pixels, you can find those back in the constants BITMAP_WIDTH and BITMAP_HEIGHT.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::OTA::CLIicon;
+use GSM::SMS::OTA::Bitmap;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw( OTACLIicon_makestream
+ OTACLIicon_PORT
+ OTACLIicon_fromb64
+ OTACLIicon_fromfile
+ );
+
+$VERSION = '0.1';
+
+use constant OTACLIicon_PORT => 5507;
+
+sub OTACLIicon_fromb64 {
+ my ($b64, $format) = @_;
+
+ my $arr = OTABitmap_fromb64( $b64, $format );
+ return -1 if $arr == -1;
+
+ return OTACLIicon_makestream( 72, 14, 1, $arr );
+}
+
+sub OTACLIicon_fromfile {
+ my ($file) = @_;
+
+ my $arr = OTABitmap_fromfile( $file );
+ return -1 if $arr == -1;
+
+ return OTACLIicon_makestream( 72, 14, 1, $arr );
+}
+
+sub OTACLIicon_makestream {
+ my ($width, $height, $depth, $ref_bytearray) = @_;
+
+ my $stream;
+
+ $stream.='00'; # Nokia stuff for CLI identification
+ $stream.=OTABitmap_makestream($width, $height, $depth, $ref_bytearray);
+
+ return $stream;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::OTA::CLIicon
+
+=head1 DESCRIPTION
+
+This package implements encoding of a CLI ( Caller Line Identification ) icon.
+
+=head1 METHODS
+
+=head2 OTACLIicon_fromb64
+
+ $stream = OTACLIicon_fromb64( $b64, $format );
+
+Generate a CLI icon from a b64 endoded bitmap in the specified format ( gif, png, bmp, ... ).
+
+=head2 OTACLIicon_fromfile
+
+ $stream =OTACLIicon_fromfile( $file );
+
+Generate a CLI icon from an image file.
+
+=head2 OTACLIicon_PORT
+
+NSB port number for CLI icon message.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::OTA::Config;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = '0.1';
+
+@EXPORT = qw( OTA_BEARER_CSD
+ OTA_BEARER_SMS
+ OTA_CONNECTIONTYPE_TEMPORARY
+ OTA_CONNECTIONTYPE_CONTINUOUS
+ OTA_CSD_AUTHTYPE_PAP
+ OTA_CSD_AUTHTYPE_CHAP
+ OTA_CSD_CALLTYPE_ISDN
+ OTA_CSD_CALLTYPE_ANALOGUE
+ OTA_CSD_CALLSPEED_9600
+ OTA_CSD_CALLSPEED_AUTO
+ OTA_CSD_CALLSPEED_14400
+ OTAmakestream
+ OTAConfig_makestream
+ );
+
+sub OTAConfig_makestream {
+ my ($bearer, $connection, $auth, $type, $speed, $proxy, $home, $uid, $pwd, $phone, $name) = @_;
+
+ # BEARER
+ my $_bearer;
+ if ( $bearer eq "CSD" ) {
+ $_bearer = OTA_BEARER_CSD;
+ }
+ elsif ( $bearer eq "SMS" ) {
+ $_bearer = OTA_BEARER_SMS;
+ }
+ else {
+ # print "Unknown bearer type: $bearer!\n";
+ return;
+ }
+
+ # CONNECTION
+ my $_connection;
+ if ( $connection eq "TEMPORARY" ) {
+ $_connection = OTA_CONNECTIONTYPE_TEMPORARY;
+ }
+ elsif ( $connection eq "CONTINUOUS" ) {
+ $_connection = OTA_CONNECTIONTYPE_CONTINUOUS;
+ }
+ else {
+ # print "Unknown connection type: $connection!\n";
+ return;
+ }
+
+ # AUTH
+ my $_auth;
+ if ( $auth eq "PAP" ) {
+ $_auth = OTA_CSD_AUTHTYPE_PAP;
+ }
+ elsif ( $auth eq "CHAP" ) {
+ $_auth = OTA_CSD_AUTHTYPE_CHAP;
+ }
+ else {
+ # print "Unknwon authentication type: $auth!\n";
+ return;
+ }
+
+ # TYPE
+ my $_type;
+ if ( $type eq "ISDN" ) {
+ $_type = OTA_CSD_CALLTYPE_ISDN;
+ }
+ elsif ( $type eq "ANALOGUE" ) {
+ $_type = OTA_CSD_CALLTYPE_ANALOGUE;
+ }
+ else {
+ # print "Unknown calltype: $type!\n";
+ return;
+ }
+
+ # SPEED
+ my $_speed;
+ if ( $speed eq "9600" ) {
+ $_speed = OTA_CSD_CALLSPEED_9600;
+ }
+ elsif ( $speed eq "AUTO" ) {
+ $_speed = OTA_CSD_CALLSPEED_AUTO;
+ }
+ elsif ( $speed eq "14400" ) {
+ $_speed = OTA_CSD_CALLSPEED_14400;
+ }
+ else {
+ # print "Unknown speed: $speed!\n";
+ return;
+ }
+
+
+ # We do not check the other parameters
+
+ my $ota = OTAmakestream(
+ $_bearer,
+ $proxy,
+ $_connection,
+ $phone,
+ $_auth,
+ $uid,
+ $pwd,
+ $_type,
+ $_speed,
+ $home,
+ $name);
+
+ return $ota;
+}
+
+
+sub OTAmakestream {
+ my ( $BEARER,
+ $PROXY,
+ $CONNECTIONTYPE,
+ $CSD_DIALSTRING,
+ $CSD_AUTHTYPE,
+ $CSD_AUTHNAME,
+ $CSD_AUTHSECRET,
+ $CSD_CALLTYPE,
+ $CSD_CALLSPEED,
+ $URL,
+ $NAME ) = @_;
+
+
+
+my $_PROXY = OTAencode_8bit( $PROXY );
+my $_CSD_DIALSTRING = OTAencode_8bit( $CSD_DIALSTRING );
+my $_CSD_AUTHNAME = OTAencode_8bit( $CSD_AUTHNAME );
+my $_CSD_AUTHSECRET = OTAencode_8bit( $CSD_AUTHSECRET );
+my $_URL = OTAencode_8bit( $URL );
+my $_NAME = OTAencode_8bit( $NAME );
+
+
+
+my $ota = <<END;
+01
+06
+04
+03
+9481EA00
+010045C606
+018712${BEARER}
+0187131103
+${_PROXY}00
+018714${CONNECTIONTYPE}
+0187211103
+${_CSD_DIALSTRING}00
+018722${CSD_AUTHTYPE}
+0187231103
+${_CSD_AUTHNAME}00
+0187241103
+${_CSD_AUTHSECRET}00
+018728${CSD_CALLTYPE}
+018729${CSD_CALLSPEED}
+01
+0186071103
+${_URL}00
+01C608
+0187151103
+${_NAME}00
+01
+01
+01
+END
+
+$ota=~s/[\n\s]//ig;
+return $ota;
+
+}
+
+# constant definition
+use constant OTA_BEARER_CSD => '45';
+use constant OTA_BEARER_SMS => '41';
+use constant OTA_CONNECTIONTYPE_TEMPORARY => '60';
+use constant OTA_CONNECTIONTYPE_CONTINUOUS => '61';
+use constant OTA_CSD_AUTHTYPE_PAP => '70';
+use constant OTA_CSD_AUTHTYPE_CHAP => '71';
+use constant OTA_CSD_CALLTYPE_ISDN => '73';
+use constant OTA_CSD_CALLTYPE_ANALOGUE => '72';
+use constant OTA_CSD_CALLSPEED_9600 => '6B';
+use constant OTA_CSD_CALLSPEED_AUTO => '6A';
+use constant OTA_CSD_CALLSPEED_14400 => '6C';
+use constant OTAConfig_PORT => 49999;
+
+# help functions
+
+sub OTAdecode_8bit {
+ my ($ud) = @_;
+ my $msg;
+
+ while (length($ud)) {
+ $msg .= pack('H2',substr($ud,0,2));
+ $ud = substr($ud,2);
+ }
+ return $msg;
+}
+
+
+sub OTAencode_8bit {
+ my ($ud) = @_;
+ my $msg;
+
+ while (length($ud)) {
+ $msg .= sprintf("%.2X", ord(substr($ud,0,1)));
+ $ud = substr($ud,1);
+ }
+ return $msg;
+}
+
+
+1;
+
+=head1 NAME
+
+GSM::SMS::OTA::Config
+
+=head1 DESCRIPTION
+
+Create an "over the air" configuration message to configure a WAP telephone with a proper setting. I only tested this one on Nokia phones (7110). This is very useful to "bulk configurate" WAP telephones.
+
+=head1 METHODS
+
+=head2 OTAConfig_makestream
+
+ $stream = OTAConfig_makestream(
+ $bearer,
+ $connection,
+ $auth,
+ $type,
+ $speed,
+ $proxy,
+ $home,
+ $uid,
+ $pwd,
+ $phone,
+ $name
+ );
+
+ $bearer:
+ CSD | SMS
+
+ $connection:
+ TEMPORARY | CONTINUOUS
+
+ $auth:
+ PAP | CHAP
+
+ $type:
+ ISDN | ANALOGUE
+
+ $speed:
+ 9600 | 14400 | AUTO
+
+ $proxy:
+ IP address of wap gateway to use
+
+ $home:
+ URL of home address
+
+ $uid:
+ Username for dialin authentication
+
+ $pwd:
+ Password for dialin authentification
+
+ $phone:
+ Phone number to dial for dial-in connection
+
+ $name:
+ Nick name you can give for this connection
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
+
--- /dev/null
+package GSM::SMS::OTA::OTA;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw( OTAdecode_8bit
+ OTAencode_8bit);
+
+$VERSION = '0.1';
+
+sub OTAdecode_8bit {
+ my ($ud) = @_;
+ my $msg;
+
+ while (length($ud)) {
+ $msg .= pack('H2',substr($ud,0,2));
+ $ud = substr($ud,2);
+ }
+ return $msg;
+}
+
+
+sub OTAencode_8bit {
+ my ($ud) = @_;
+ my $msg;
+
+ while (length($ud)) {
+ $msg .= sprintf("%.2X", ord(substr($ud,0,1)));
+ $ud = substr($ud,1);
+ }
+ return $msg;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::OTA::OTA
+
+=head1 DESCRIPTION
+
+This package contains 2 functions to decode and encode 8 bit data in an ASCII alphabet. It just writes out a byte as a 2 character string, containing the hexadecimal representation.
+
+=head1 METHODS
+
+ $binary = OTAdecode_8bit( $text )
+ $text = OTAencode_8bit( $binary )
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::OTA::Operatorlogo;
+use GSM::SMS::OTA::Bitmap;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw( OTAOperatorlogo_makestream
+ OTAOperatorlogo_PORT
+ OTAOperatorlogo_fromb64
+ OTAOperatorlogo_fromfile
+ );
+
+$VERSION = '0.1';
+
+use constant OTAOperatorlogo_PORT => 5506;
+
+sub OTAOperatorlogo_fromb64 {
+ my ($countrycode, $operatorcode, $b64, $format) = @_;
+
+ my $arr = OTABitmap_fromb64( $b64, $format );
+ return -1 if $arr == -1;
+
+ return OTAOperatorlogo_makestream( $countrycode, $operatorcode, 72, 14, 1, $arr );
+}
+
+sub OTAOperatorlogo_fromfile {
+ my ($countrycode, $operatorcode, $file) = @_;
+
+ my $arr = OTABitmap_fromfile( $file );
+ return -1 if $arr == -1;
+
+ return OTAOperatorlogo_makestream( $countrycode, $operatorcode, 72, 14, 1, $arr );
+}
+
+
+sub OTAOperatorlogo_makestream {
+ my ($countrycode, $operatorcode, $width, $height, $depth, $ref_bytearray) = @_;
+
+ my $stream;
+
+ $stream.= encodeOperatorID($countrycode, $operatorcode);
+ $stream.='00'; # Nokia stuff for validity period
+ $stream.=OTABitmap_makestream($width, $height, $depth, $ref_bytearray);
+
+ return $stream;
+}
+
+# encode the operator ID (country, operator) into a litlle endian BCD string
+sub encodeOperatorID {
+ my ($country, $operator) = @_;
+
+ my $c = sprintf("%03d", $country);
+ my $o = sprintf("%02d", $operator);
+
+ my @arr = split /|/, sprintf("%03d%02d", $country, $operator);
+ my @enc;
+
+ $enc[0] = ($arr[1] & 0x0F) << 4 | ($arr[0] & 0x0F);
+ $enc[1] = (0x0F << 4) | ($arr[2] & 0x0F);
+ $enc[2] = ($arr[4] & 0x0F) << 4 | ($arr[3] & 0x0F);
+
+ return join("", map { sprintf("%02X", $_) } @enc );
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::OTA::Operatorlogo
+
+=head1 DESCRIPTION
+
+This package implements encoding of an Operatorlogo icon.
+
+=head1 METHODS
+
+=head2 OTAOperatorlogo_fromb64
+
+ $stream = OTAOperatorlogo_fromb64($countrycode, $operatorcode, $b64, $format);
+
+Create a operator logo from a b64 encoded image in the specified format ( gif, png, ...). The countrycode and operator code are 2 codes that specfify either the operator or the country of the receiving handset.
+
+=head2 OTAOperatorlogo_fromfile
+
+ $stream = OTAOperatorlogo_fromfile($countrycode, $operatorcode, $file );
+
+Create a operator logo from a file.
+
+=head2 OTAOperatorlogo_PORT
+
+NSB Port number for Operator logos.
+
+=head1 ISSUES
+
+The country and operator coe have to be provided manually. It would be
+interesting to have other modules: GSM::SMS::Countrycode and GSM::SMS::OPeratorcode , that handle this automatically. Give them a msisdn and they provide you with the code.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::OTA::RTTTL;\r
+\r
+# Author: Johan Van den Brande <johan@vandenbrande.com>\r
+\r
+require Exporter;\r
+@ISA = qw(Exporter);\r
+\r
+@EXPORT = qw( OTARTTTL_makestream\r
+ OTARTTTL_check\r
+ OTARTTTL_PORT );\r
+\r
+$VERSION = '0.1';\r
+\r
+use strict;\r
+use constant OTARTTTL_PORT => 5505;\r
+\r
+# Parse defaults\r
+use constant RTTTL_DEF_DURATION => 4;\r
+use constant RTTTL_DEF_SCALE => 6;\r
+use constant RTTTL_DEF_BPM => 63;\r
+\r
+# Bit string constants\r
+\r
+# Command-Part encoding\r
+use constant RTTTL_CANCEL_COMMAND => "0000101";\r
+use constant RTTTL_RINGING_TONE_PROGRAMMING => "0100101";\r
+use constant RTTTL_SOUND => "0011101";\r
+use constant RTTTL_UNICODE => "0100010";\r
+use constant RTTTL_COMMAND_END => "00000000";\r
+\r
+# Song Type Encoding\r
+use constant RTTTL_BASIC_SONG_TYPE => "001";\r
+use constant RTTTL_TEMPORARY_SONG_TYPE => "010";\r
+use constant RTTTL_MIDI_SONG_TYPE => "011";\r
+use constant RTTTL_DIGITIZED_SONG_TYPE => "100";\r
+\r
+# Pattern ID encoding\r
+use constant RTTTL_A_PART => "00";\r
+use constant RTTTL_B_PART => "01";\r
+use constant RTTTL_C_PART => "10";\r
+use constant RTTTL_D_PART => "11";\r
+\r
+# Instruction ID Encoding\r
+use constant RTTTL_PATTERN_HEADER_ID => "000";\r
+use constant RTTTL_NOTE_INSTRUCTION_ID => "001";\r
+use constant RTTTL_SCALE_INSTRUCTION_ID => "010";\r
+use constant RTTTL_STYLE_INSTRUCTION_ID => "011";\r
+use constant RTTTL_TEMPO_INSTRUCTION_ID => "100";\r
+use constant RTTTL_VOLUME_INSTRUCTION_ID => "101";\r
+\r
+# Note Value encoding\r
+use constant RTTTL_PAUSE => "0000";\r
+\r
+use constant RTTTL_C => "0001";\r
+\r
+use constant RTTTL_Cis => "0010";\r
+use constant RTTTL_Des => "0010";\r
+\r
+use constant RTTTL_D => "0011";\r
+\r
+use constant RTTTL_Dis => "0100";\r
+use constant RTTTL_Es => "0100";\r
+\r
+use constant RTTTL_E => "0101";\r
+\r
+use constant RTTTL_F => "0110";\r
+\r
+use constant RTTTL_Fis => "0111";\r
+use constant RTTTL_Ges => "0111";\r
+\r
+use constant RTTTL_G => "1000";\r
+\r
+use constant RTTTL_Gis => "1001";\r
+use constant RTTTL_As => "1001";\r
+\r
+use constant RTTTL_A => "1010";\r
+\r
+use constant RTTTL_Ais => "1011";\r
+use constant RTTTL_B => "1100";\r
+\r
+use constant RTTTL_H => "1100";\r
+\r
+# Note duration encoding\r
+use constant RTTTL_FULL => "000";\r
+use constant RTTTL_12 => "001";\r
+use constant RTTTL_14 => "010";\r
+use constant RTTTL_18 => "011";\r
+use constant RTTTL_116 => "100";\r
+use constant RTTTL_132 => "101";\r
+\r
+# Note duration specifier\r
+use constant RTTTL_NO_SPECIAL_DURATION => "00";\r
+use constant RTTTL_DOTTED_NOTE => "01";\r
+use constant RTTTL_DOUBLEDOTTED_NOTE => "10";\r
+use constant RTTTL_23_LENGTH => "11";\r
+\r
+# Note scale encoding\r
+use constant RTTTL_SCALE_1 => "00";\r
+use constant RTTTL_SCALE_2 => "01";\r
+use constant RTTTL_SCALE_3 => "10";\r
+use constant RTTTL_SCALE_4 => "11";\r
+\r
+# Style-value encoding\r
+use constant RTTTL_NATURAL_STYLE => "00";\r
+use constant RTTTL_CONTINUOUS_STYLE => "01";\r
+use constant RTTTL_STACCATO_STYLE => "10";\r
+\r
+# Beats per minute\r
+use constant RTTTL_BPM_25 => "00000";\r
+use constant RTTTL_BPM_28 => "00001";\r
+use constant RTTTL_BPM_31 => "00010";\r
+use constant RTTTL_BPM_35 => "00011";\r
+use constant RTTTL_BPM_40 => "00100";\r
+use constant RTTTL_BPM_45 => "00101";\r
+use constant RTTTL_BPM_50 => "00110";\r
+use constant RTTTL_BPM_56 => "00111";\r
+use constant RTTTL_BPM_63 => "01000";\r
+use constant RTTTL_BPM_70 => "01001";\r
+use constant RTTTL_BPM_80 => "01010";\r
+use constant RTTTL_BPM_90 => "01011";\r
+use constant RTTTL_BPM_100 => "01100";\r
+use constant RTTTL_BPM_112 => "01101";\r
+use constant RTTTL_BPM_125 => "01110";\r
+use constant RTTTL_BPM_140 => "01111";\r
+use constant RTTTL_BPM_160 => "10000";\r
+use constant RTTTL_BPM_180 => "10001";\r
+use constant RTTTL_BPM_200 => "10010";\r
+use constant RTTTL_BPM_225 => "10011";\r
+use constant RTTTL_BPM_250 => "10100";\r
+use constant RTTTL_BPM_285 => "10101";\r
+use constant RTTTL_BPM_320 => "10110";\r
+use constant RTTTL_BPM_355 => "10111";\r
+use constant RTTTL_BPM_400 => "11000";\r
+use constant RTTTL_BPM_450 => "11001";\r
+use constant RTTTL_BPM_500 => "11010";\r
+use constant RTTTL_BPM_565 => "11011";\r
+use constant RTTTL_BPM_635 => "11100";\r
+use constant RTTTL_BPM_715 => "11101";\r
+use constant RTTTL_BPM_800 => "11110";\r
+use constant RTTTL_BPM_900 => "11111";\r
+\r
+# Volume encoding\r
+use constant RTTTL_LEVEL_0 => "0000";\r
+use constant RTTTL_LEVEL_1 => "0001";\r
+use constant RTTTL_LEVEL_2 => "0010";\r
+use constant RTTTL_LEVEL_3 => "0011";\r
+use constant RTTTL_LEVEL_4 => "0100";\r
+use constant RTTTL_LEVEL_5 => "0101";\r
+use constant RTTTL_LEVEL_6 => "0110";\r
+use constant RTTTL_LEVEL_7 => "0111";\r
+use constant RTTTL_LEVEL_8 => "1000";\r
+use constant RTTTL_LEVEL_9 => "1001";\r
+use constant RTTTL_LEVEL_10 => "1010";\r
+use constant RTTTL_LEVEL_11 => "1011";\r
+use constant RTTTL_LEVEL_12 => "1100";\r
+use constant RTTTL_LEVEL_13 => "1101";\r
+use constant RTTTL_LEVEL_14 => "1110";\r
+use constant RTTTL_LEVEL_15 => "1111";\r
+\r
+# hash constants\r
+\r
+use constant RTTTL_TO_NOKIA_DURATIONS =>\r
+ {\r
+ "1" => RTTTL_FULL,\r
+ "2" => RTTTL_12,\r
+ "4" => RTTTL_14,\r
+ "8" => RTTTL_18,\r
+ "16" => RTTTL_116,\r
+ "32" => RTTTL_132\r
+ };\r
+\r
+use constant RTTTL_TO_NOKIA_NOTES =>\r
+ {\r
+ "P" => RTTTL_PAUSE,\r
+ "C" => RTTTL_C,\r
+ "C#" => RTTTL_Cis,\r
+ "D" => RTTTL_D,\r
+ "D#" => RTTTL_Dis,\r
+ "E" => RTTTL_E,\r
+ "F" => RTTTL_F,\r
+ "F#" => RTTTL_Fis,\r
+ "G" => RTTTL_G,\r
+ "G#" => RTTTL_Gis,\r
+ "A" => RTTTL_A,\r
+ "A#" => RTTTL_Ais,\r
+ "B" => RTTTL_B,\r
+ "H" => RTTTL_H\r
+ };\r
+\r
+use constant RTTTL_TO_NOKIA_TEMPOS =>\r
+ {\r
+ "25" => RTTTL_BPM_25,\r
+ "28" => RTTTL_BPM_28,\r
+ "31" => RTTTL_BPM_31,\r
+ "35" => RTTTL_BPM_35,\r
+ "40" => RTTTL_BPM_40,\r
+ "45" => RTTTL_BPM_45,\r
+ "50" => RTTTL_BPM_50,\r
+ "56" => RTTTL_BPM_56,\r
+ "63" => RTTTL_BPM_63,\r
+ "70" => RTTTL_BPM_70,\r
+ "80" => RTTTL_BPM_80,\r
+ "90" => RTTTL_BPM_90,\r
+ "100" => RTTTL_BPM_100,\r
+ "112" => RTTTL_BPM_112,\r
+ "125" => RTTTL_BPM_125,\r
+ "140" => RTTTL_BPM_140,\r
+ "160" => RTTTL_BPM_160,\r
+ "180" => RTTTL_BPM_180,\r
+ "200" => RTTTL_BPM_200,\r
+ "225" => RTTTL_BPM_225,\r
+ "250" => RTTTL_BPM_250,\r
+ "285" => RTTTL_BPM_285,\r
+ "320" => RTTTL_BPM_320,\r
+ "355" => RTTTL_BPM_355,\r
+ "400" => RTTTL_BPM_400,\r
+ "450" => RTTTL_BPM_450,\r
+ "500" => RTTTL_BPM_500,\r
+ "565" => RTTTL_BPM_565,\r
+ "635" => RTTTL_BPM_635,\r
+ "715" => RTTTL_BPM_715,\r
+ "800" => RTTTL_BPM_800,\r
+ "900" => RTTTL_BPM_900\r
+ };\r
+\r
+use constant RTTTL_TO_NOKIA_SCALES =>\r
+{\r
+ "4" => RTTTL_SCALE_1,\r
+ "5" => RTTTL_SCALE_2,\r
+ "6" => RTTTL_SCALE_3,\r
+ "7" => RTTTL_SCALE_4\r
+};\r
+\r
+\r
+sub OTARTTTL_check {\r
+ my ($rt) = @_;\r
+\r
+ my ($name, $defaults, $notes) = split /:/, $rt;\r
+\r
+ unless ( $name=~/[a-zA-Z0-9]/ && length($name) < 32 ) {\r
+ return "Error on name\n";\r
+ }\r
+\r
+ my %def;\r
+ map { my ($n,$v) = split /=/, $_; $def{$n} = $v; } split /,/, $defaults;\r
+\r
+ unless ( $def{"d"} =~ /\d+/ ) {\r
+ return "Error on 'd' default.\n";\r
+ }\r
+ unless ( $def{"o"} =~ /\d+/ ) {\r
+ return "Error on 'o' default.\n";\r
+ }\r
+ unless ( $def{"b"} =~ /\d+/ ) {\r
+ return "Error on 'b' default.\n";\r
+ }\r
+ $notes = _correct_dotted_durations( $notes );\r
+\r
+ my @notes = split /,/, $notes;\r
+ my $cnt = 1;\r
+ foreach my $note ( @notes ) {\r
+\r
+ my ( $d, $n, $s, $x ) = ( $note =~ /(\d*)([a-z]#?)(\d*)(\.?)/ );\r
+\r
+ unless ( $n ) {\r
+ return "Error: no note in '$note' ($cnt)\n";\r
+ }\r
+\r
+ unless ( $d =~ /\d*/ ) {\r
+ return "Error on duration in note '$note' ($cnt)\n";\r
+ }\r
+\r
+ unless ( $n =~ /([a-g]|p)#?/ ) {\r
+ return "Error on note in note '$note' ($cnt)\n";\r
+ }\r
+\r
+ unless ( $s =~ /\d*/ ) {\r
+ return "Error on scale in note '$note' ($cnt)\n";\r
+ }\r
+\r
+ unless ( $x =~ /\.?/ ) {\r
+ return "Error on dot in note '$note' ($cnt)\n";\r
+ }\r
+ $cnt++;\r
+ }\r
+ return;\r
+ }\r
+\r
+ sub OTARTTTL_makestream {\r
+ my ($rtttl) = @_;\r
+\r
+ # Split into <name>:<defaults>:<notecommands>\r
+ my ($name, $defaults, $notes) = split /:/, $rtttl;\r
+\r
+ # there seem to be two 'rtttls' around: those where\r
+ # the scale precedes the dot, and vice versa.\r
+ # we use the former, because that's what the specs seem to say\r
+ $notes = _correct_dotted_durations( $notes );\r
+\r
+ my $default_duration = ($defaults=~/d=(\d+)/ && $1) || RTTTL_DEF_DURATION;\r
+ my $default_scale = ($defaults=~/o=(\d+)/ && $1) || RTTTL_DEF_SCALE;\r
+ my $default_bpm = ($defaults=~/b=(\d+)/ && $1) || RTTTL_DEF_BPM;\r
+\r
+ my $bitstream;\r
+\r
+ # Songtitle\r
+ $bitstream .= encodeSongTitle($name);\r
+\r
+ # how many sequences? \r
+ $bitstream .= "00000001";\r
+\r
+ $bitstream .= _encode_pattern_header();\r
+\r
+ my($nstream,$count) = _encode_notes($notes, $default_duration,\r
+ $default_scale, $default_bpm);\r
+\r
+ $bitstream =~ s/X/dec2bin($count, 8)/e;\r
+\r
+ $bitstream = "00000010" . \r
+ padBits(RTTTL_RINGING_TONE_PROGRAMMING,8) . \r
+ padBits(RTTTL_SOUND . RTTTL_BASIC_SONG_TYPE . $bitstream . $nstream, 8) . \r
+ RTTTL_COMMAND_END;\r
+\r
+ my $music = bitstreamToHex($bitstream) . "\n";\r
+ return $music;\r
+ }\r
+\r
+ sub _correct_dotted_durations {\r
+ my $notes = shift;\r
+\r
+ $notes =~ s/(\.)(\d)/$2$1/g;\r
+ return $notes;\r
+ }\r
+ sub _encode_notes {\r
+ my ($notes, $default_duration, $default_scale, $default_bpm) = @_;\r
+ my $nstream;\r
+\r
+ # these two are both instructions, hence we set the count to 2\r
+ # encode scale\r
+ $nstream = encodeScale($default_scale);\r
+\r
+ # encode tempo\r
+ $nstream .= encodeBpm($default_bpm);\r
+\r
+ my $count = 2;\r
+ ############################################################\r
+\r
+ # Parse notes\r
+ my @notes = split /,\s*/s, $notes;\r
+\r
+ my $last_scale = 0;\r
+\r
+ foreach my $note (@notes) {\r
+\r
+ my ($n_duration, $n_note, $n_scale, $n_special ) = $note =~/(\d*)(\w#?)(\d*)(\.?)/;\r
+\r
+ $n_scale ||= $default_scale;\r
+\r
+ if ( $n_scale != $last_scale ) {\r
+ $nstream .= encodeScale($n_scale);\r
+ $count++;\r
+ }\r
+\r
+ $last_scale = $n_scale;\r
+\r
+ $n_duration ||= $default_duration;\r
+\r
+ $nstream .= encodeNote($n_duration, $n_note, $n_special); \r
+ $count++;\r
+ }\r
+ return ($nstream,$count);\r
+ }\r
+ sub _encode_pattern_header {\r
+ my $ph;\r
+ # encode the pattern ...\r
+ # We only assume pattern A \r
+ $ph = RTTTL_PATTERN_HEADER_ID . RTTTL_A_PART;\r
+ # loop-value => no loop\r
+ $ph .= "0000";\r
+ # length of the new pattern (we do not know that upfront?)\r
+ $ph .= "X";\r
+ return $ph;\r
+ }\r
+ sub encodeSongTitle {\r
+ my ($title) = @_;\r
+\r
+ my $bitstream = dec2bin(length($title), 4);\r
+ foreach my $char (split /|/, $title) {\r
+ $bitstream.= dec2bin( ord($char), 8 );\r
+ }\r
+ return $bitstream;\r
+ }\r
+ sub encodeScale {\r
+ my ($scale) = @_;\r
+\r
+ my $bs = RTTTL_SCALE_INSTRUCTION_ID;\r
+ $bs .= RTTTL_TO_NOKIA_SCALES->{$scale};\r
+# print STDERR "setting scale to $scale binary: $bs\n";\r
+\r
+ return $bs;\r
+ }\r
+ sub encodeBpm {\r
+ my ($bpm) = @_;\r
+\r
+ my $bs = RTTTL_TEMPO_INSTRUCTION_ID;\r
+ $bs .= RTTTL_TO_NOKIA_TEMPOS->{$bpm};\r
+ # print STDERR "setting tempo to $bpm binary: $bs\n";\r
+ return $bs;\r
+ }\r
+\r
+ sub encodeNote {\r
+ my ($d, $n, $dot) = @_;\r
+ my $bs;\r
+\r
+ # encode the scale in the for loop, that will make it easier \r
+ # to "compress" the song \r
+ $bs= RTTTL_NOTE_INSTRUCTION_ID; \r
+\r
+ my $_dot = ( $dot eq "." ) ? RTTTL_DOTTED_NOTE : RTTTL_NO_SPECIAL_DURATION;\r
+\r
+ $bs .= RTTTL_TO_NOKIA_NOTES->{ uc($n) };\r
+ $bs .= RTTTL_TO_NOKIA_DURATIONS->{$d};\r
+ $bs .=$_dot;\r
+# print STDERR "setting note as ",uc($n), " binary: note ", RTTTL_TO_NOKIA_NOTES->{ uc($n) }, " duration ", RTTTL_TO_NOKIA_DURATIONS->{$d}, "dot $_dot\n";\r
+\r
+ return $bs;\r
+ }\r
+ sub dec2bin {\r
+ my ($d, $l) = @_;\r
+ my $str = substr( unpack("B32", pack("N", $d)), 32-$l, $l);\r
+ return $str;\r
+ }\r
+ sub bitstreamToHex {\r
+ my ($bits) = @_;\r
+ my $hex;\r
+\r
+ while (length($bits)) {\r
+ my $run8 = substr($bits, 0, 8);\r
+ $bits = substr($bits, 8, length($bits)-8);\r
+ $run8.="0" x 8-length($run8) if ( length($run8)<8 );\r
+ $hex.=sprintf("%.2X", unpack("N", pack( "B32", substr("0" x 32 . $run8, -32))));\r
+ }\r
+ return $hex;\r
+ }\r
+ sub padBits {\r
+ my ($stream, $len) = @_;\r
+ $stream.= "0" x ( $len - (length($stream) % $len) ); \r
+ return $stream;\r
+ }\r
+\r
+ 1;\r
+\r
+=head1 NAME\r
+\r
+GSM::SMS::OTA::RTTTL - Convert RTTTL composed songs to Nokia Smart Messaging Specs\r
+\r
+=head1 SYNOPSIS\r
+\r
+use GSM::SMS::OTA::RTTTL;\r
+\r
+my $tone = OTARTTTL_makestream("<rtttl string>");\r
+my $port = OTARTTTL_PORT;\r
+\r
+=head1 DESCRIPTION\r
+\r
+This converts RTTTL strings into a binary format, ready to get send to a mobile\r
+phone. For the moment it assumes:\r
+\r
+=over\r
+=item 1 pattern (pattern A)\r
+=item no loop\r
+=back\r
+\r
+=head1 METHODS\r
+\r
+=head2 OTARTTTL_makestream\r
+\r
+ $stream = OTARTTTL_makestream( $rtttl_string );\r
+\r
+Create a RTTTL stream from a RTTTL syntax string.\r
+\r
+=head2 OTARTTTL_PORT\r
+\r
+NSB Port number for a RTTTL message.\r
+\r
+=head1 AUTHORS\r
+Johan Van den Brande <johan@vandenbrande.com>\r
+David Wright <david@hybyte.com> \r
--- /dev/null
+package GSM::SMS::OTA::VCard;
+use GSM::SMS::OTA::OTA;
+
+# Generic package for VCARDS
+# experimental!
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw( OTAVcard_makestream
+ OTAVcard_PORT );
+
+$VERSION = '0.1';
+
+use constant OTAVcard_PORT => 9204;
+
+
+sub OTAVcard_makestream {
+ my ($lastname, $firstname, $phone) = @_;
+
+ $lastname = encode( $lastname );
+ $firstname = encode( $firstname);
+ $phone = encode( $phone );
+
+ $vcard=<<EOT;
+BEGIN:VCARD
+VERSION:2.1
+N:$lastname,$firstname
+TEL;PREF:$phone
+END:VCARD
+EOT
+
+
+ return OTAencode_8bit($vcard);
+}
+
+sub encode {
+ my ($string) = @_;
+
+ $string=~s/([,;:])/\\$1/g;
+
+ return $string;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::OTA::VCard
+
+=head1 DESCRIPTION
+
+This package allows you to create a VCard to send an address/phone book item to a handset capable receiving it. This is only tested with a Nokia Phone (7110).
+Anyway, this module is rather experimental.
+
+=head1 METHODS
+
+=head2 OTAVcard_makestream
+
+ $stream = OTAVcard_makestream( $lastname, $firstname, $phone );
+
+Make a VCard with only name, lastname and (home)phonenumber. A lot more is possible to include, but I think this is sufficient for most uses (?) ... or until somebody motivates me to expand this ...
+
+=head2 OTAVcard_PORT
+
+NSB Port number for a VCard message.
+
+=head1 AUTHOR
+
+Joha Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::PDU;
+use strict;
+use vars qw( $VERSION );
+# (c) 1999 tektonica
+# author: Johan Van den Brande
+
+$VERSION = '0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{TPDU} = {};
+ bless($self, $class);
+ return $self;
+}
+
+sub SMSDeliver {
+ my ($self, $data) = @_;
+ my $tpdu = $self->{TPDU};
+ my @msg = split //, $data;
+
+ ###########################################################################
+ # 1) Get SERVICE CENTER ADDRESS
+ # -------------------------------------------------------------------------
+ # Structure: (n) = number of octets
+ # +-----------+-------------------+------------------+
+ # | length(1) | type of number(2) | BCD digits(0..8) |
+ # +-----------+-------------------+------------------+
+ # length :
+ # number of octets for BCD + 1 octet for type of number
+ # type of number :
+ # 81H : national number (e.g. 0495123456)
+ # 91H : international number (e.g. 32495123456 => need to prepend a '+')
+ # BCD:
+ # If the number of BCD octets is odd, the last digit shall be filled with an end
+ # mark, coded as FH (H = Hex ...)
+ # Every Octet get's splitted in 2 nibbles. Per octet we need to swap the nibbles to get
+ # the correct order.
+ # -------------------------------------------------------------------------
+ $tpdu->{'TP-SCN'} = $self->getServiceCenterAddress(\@msg);
+ ###########################################################################
+
+ ###########################################################################
+ # 2) Get PDU type
+ # -------------------------------------------------------------------------
+ # Structure: (n) = bits
+ # +--------+----------+---------+-------+-------+--------+
+ # | RP (1) | UDHI (1) | SRI (1) | X (1) | X (1) | MTI(2) |
+ # +--------+----------+---------+-------+-------+--------+
+ # RP:
+ # Reply path
+ # UDHI:
+ # User Data Header Indicator = Does the UD contains a header
+ # 0 : Only the Short Message
+ # 1 : Beginning of UD containsheader information
+ # SRI:
+ # Status Report Indication.
+ # The SME (Short Message Entity) has requested a status report.
+ # MTI:
+ # 00 for SMS-Deliver
+ #
+ # -------------------------------------------------------------------------
+ $tpdu->{'TP-PDU'} = $self->getoctet(\@msg);
+ ###########################################################################
+
+ ###########################################################################
+ # 3) Get originating address
+ # -------------------------------------------------------------------------
+ # Structure: (n) = number of octets
+ # +-----------+-------------------+------------------+
+ # | length(1) | type of number(2) | BCD digits(0..10) |
+ # +-----------+-------------------+------------------+
+ # length :
+ # number of BCD digits (This is different for the SCN!)
+ # type of number :
+ # 81H : national number (e.g. 0495123456)
+ # 91H : international number (e.g. 32495123456 => need to prepend a '+')
+ # BCD:
+ # If the number of BCD octets is odd, the last digit shall be filled with an end
+ # mark, coded as FH (H = Hex ...)
+ # Every Octet get's splitted in 2 nibbles. Per octet we need to swap the nibbles to get
+ # the correct order.
+ # -------------------------------------------------------------------------
+ $tpdu->{'TP-OA'} = $self->getOriginatingAddress(\@msg);
+
+ ###########################################################################
+ # 4) Get Protocol identifier (PID)
+ # -------------------------------------------------------------------------
+ # Structure:
+ # XXH
+ # 00H: Short Message (SMS)
+ # 41H: Replace Short Message Type1
+ # ...
+ # 47H: Replace Short Message Type7
+ # Can be used to replace previously sent SMS messgaes in the MS (Mobile Station)
+ # -------------------------------------------------------------------------
+ $tpdu->{'TP-PID'} = $self->getoctet(\@msg);
+ ###########################################################################
+
+ ###########################################################################
+ # 5) Get data coding scheme
+ # -------------------------------------------------------------------------
+ # Structure:
+ # bits 7 6 5 4 3 2 1 0
+ # +--------------+---+---+---+---+
+ # | Coding group | 0 | X | X | X |
+ # +--------------+---+---+---+---+
+ # Examples:
+ # 0 0 0 0 0 0 0 0 : 00H : 7-bit datacoding, default alphabet
+ # 1 1 1 1 0 1 1 0 : F6H : 8-bit datacoding Class 2
+ #
+ # Coding group | Alphabet indication
+ # ---------------+---------------------------------------------------------
+ # 0000 | 0000 Default alphabet
+ # | 0001 Reserved
+ # | ... " "
+ # | 1111 " "
+ # ---------------+---------------------------------------------------------
+ # 0001-1110 | Reserved coding groups
+ # ---------------+---------------------------------------------------------
+ # 1111 | bit 3 : Reserved, always 0
+ # | bit 2 : Data Coding
+ # | 0 : Default alphabet (7bit)
+ # | 1 : 8 bit encoding INTEL-ASCII
+ # | bits 1 0 : Message Class
+ # | 0 0 : Class 0, immedidate display
+ # | 0 1 : Class 1, ME specific (Mobile Equiment)
+ # | 1 0 : Class 2, SIM specific
+ # | 1 1 : Class 3, TE specific (Terminate Equipment)
+ # ---------------+---------------------------------------------------------
+ # We have 2 possible ways of interpreting this for our SMS software
+ # 7 bit default alphabet : 00000000 111100xx
+ # 8 bit intel-ascii : 111101xx
+ # x being a wild card
+ ###########################################################################
+ $tpdu->{'TP-DCS'} = $self->getoctet(\@msg);
+
+ ###########################################################################
+ # 6) Get service center timestamp
+ # -------------------------------------------------------------------------
+ # Structure:
+ # Octets: 1 1 1 1 1 1 1
+ # +------+-------+-----+------+--------+--------+-----------+
+ # | YEAR | MONTH | DAY | HOUR | MINUTE | SECOND | TIME ZONE | (2 1), means
+ # | (2 1)| (2 1) |(2 1)| (2 1)| (2 1) | (2 1) | (2 1) | nibbles need to
+ # +------+-------+-----+------+--------+--------+-----------+ be swapped for correct order
+ # The TIMEZONE indicates difference in quarters of an hour, between the
+ # local time and Greenwhich Main Time (GMT)
+ ###########################################################################
+ $tpdu->{'TP-SCTS'} = $self->getoctet(\@msg, 7, 1);
+ ###########################################################################
+
+ ###########################################################################
+ # 7) Get User Data (UDL) and decode
+ # -------------------------------------------------------------------------
+ # We need to decode according to the DCS.
+ $tpdu->{'TP-UDL'} = hex($self->getoctet(\@msg));
+
+ # We have 2 possible ways of interpreting this for our SMS software
+ # 7 bit default alphabet : 00000000 111100xx
+ # 8 bit intel-ascii : 111101xx
+ # x being a wild card
+ my $dcs = hex($tpdu->{'TP-DCS'});
+ if ($dcs == 0) {
+ # decode 7 bit
+ $tpdu->{'TP-UD'} = $self->decode_7bit(join("", @msg), $tpdu->{'TP-UDL'});
+ # translate to default alphabet
+ $tpdu->{'TP-UD'} = $self->translate($tpdu->{'TP-UD'});
+
+ # Do we have NBS with Text based headers?
+ my $ud = $tpdu->{'TP-UD'};
+ if (substr($ud, 0, 5) eq '//SCK') {
+ # print "We have a text encoded NBS\n";
+ $tpdu->{'TP-SCK'}++;
+ if ($ud=~/\/\/SCK(\w\w)(\w\w)(\w\w)(\w\w)(\w\w)\s/) {
+ # print "D: $1, S: $2, DATAGRAM: $3, MAX: $4, SQN: $5\n";
+ $tpdu->{'TP-DPORT'} = hex($1);
+ $tpdu->{'TP-SPORT'} = hex($2);
+ $tpdu->{'TP-DATAGRAM'} = hex($3);
+ $tpdu->{'TP-FRAGMAX'} = hex($4);
+ $tpdu->{'TP-FRAGSQN'} = hex($5);
+ }
+ if ($ud=~/\/\/SCKL(\w\w\w\w)(\w\w\w\w)(\w\w)(\w\w)(\w\w)\s/) {
+ # print "D: $1, S: $2, DATAGRAM: $3, MAX: $4, SQN: $5\n";
+ $tpdu->{'TP-DPORT'} = hex($1);
+ $tpdu->{'TP-SPORT'} = hex($2);
+ $tpdu->{'TP-DATAGRAM'} = hex($3);
+ $tpdu->{'TP-FRAGMAX'} = hex($4);
+ $tpdu->{'TP-FRAGSQN'} = hex($5);
+ }
+ if ($ud=~/\/\/SCK(\w\w)\s/) {
+ # print "D: $1, S: $1\n";
+ $tpdu->{'TP-DPORT'} = hex($1);
+ $tpdu->{'TP-SPORT'} = hex($1);
+ $tpdu->{'TP-DATAGRAM'} = 1;
+ $tpdu->{'TP-FRAGMAX'} = 1;
+ $tpdu->{'TP-FRAGSQN'} = 1;
+ }
+ if ($ud=~/\/\/SCKL(\w\w\w\w)\s/) {
+ # print "D: $1, S: $1\n";
+ $tpdu->{'TP-DPORT'} = hex($1);
+ $tpdu->{'TP-SPORT'} = hex($1);
+ $tpdu->{'TP-DATAGRAM'} = 1;
+ $tpdu->{'TP-FRAGMAX'} = 1;
+ $tpdu->{'TP-FRAGSQN'} = 1;
+ }
+ }
+ } elsif (($dcs & 0xF0) == 0xF0) {
+ # Do we have a UDH?
+ my $pdu = hex($tpdu->{'TP-PDU'});
+ if (($pdu & 0x40) == 0x40) {
+ my $udhl = hex($self->getoctet(\@msg));
+ my @ud = splice(@msg, 0, $udhl*2);
+ while ($#ud>-1) {
+ my $iei = $self->getoctet(\@ud);
+ my $lei = hex($self->getoctet(\@ud));
+ my @dei = splice(@ud, 0, $lei*2);
+ # print "UDHL: $udhl, IEI: $iei, LEI: $lei, DATA:".join ( "", @dei ) . "\n";
+ if (hex($iei) == 5) {
+ # 16 bit port
+ my $dport = hex( $self->getoctet(\@dei, 2) );
+ my $sport = hex( $self->getoctet(\@dei, 2) );
+ # print "16 bit @ D:$dport S:$sport\n";
+ $tpdu->{'TP-DPORT'} = $dport;
+ $tpdu->{'TP-SPORT'} = $sport;
+
+ # When receivingwe do not have necessarily the Fragment idenetifier!, so if not already defined
+ # (FI maybe! can come b4 PORTS), set them to a bogus number (1,1,1)
+ if (!$tpdu->{'TP-DATAGRAM'}) {
+ $tpdu->{'TP-DATAGRAM'} = 1;
+ $tpdu->{'TP-FRAGMAX'} = 1;
+ $tpdu->{'TP-FRAGSQN'} = 1;
+ }
+ }
+ if (hex($iei) == 0) {
+ # Fragment identifier
+ my $fdatagram = hex( $self->getoctet(\@dei) );
+ my $fmax = hex( $self->getoctet(\@dei) );
+ my $fid = hex( $self->getoctet(\@dei) );
+ # print "datagram $fdatagram fragment $fid from $fmax\n";
+ $tpdu->{'TP-DATAGRAM'} = $fdatagram;
+ $tpdu->{'TP-FRAGMAX'} = $fmax;
+ $tpdu->{'TP-FRAGSQN'} = $fid;
+ }
+ }
+ }
+ # decode 8 bit
+ pop @msg;
+ $tpdu->{'TP-UD'} = $self->decode_8bit(join("", @msg), $tpdu->{'TP-UDL'});
+ # translate to default alphabet
+ $tpdu->{'TP-UD'} = $self->translate($tpdu->{'TP-UD'});
+ } else {
+ $tpdu->{'TP-UD'} = "";
+ }
+ ###########################################################################
+ return $tpdu;
+}
+
+sub SMSSubmit {
+ my ($self, $servicecenter, $phonenumber, $data, $dcs, $vp, $udhi) = @_;
+
+ my $pdu = '';
+ my $pdutype = 0;
+
+ ###########################################################################
+ # 1) Service center address
+ # -------------------------------------------------------------------------
+ # Look at SMSDeliver for notes
+ # -------------------------------------------------------------------------
+ $pdu.=$self->encodeServiceCenterAddress($servicecenter);
+ ###########################################################################
+
+ ###########################################################################
+ # 2) PDU type
+ # -------------------------------------------------------------------------
+ # Structure : (n) = bits
+ # +--------+----------+---------+---------+--------+---------+
+ # | RP (1) | UDHI (1) | SRR (1) | VPF (2) | RD (1) | MTI (2) |
+ # +--------+----------+---------+---------+--------+---------+
+ # RP:
+ # Reply path : 0 = not set / 1 = set
+ # UDHI:
+ # User data only contains short message : 0
+ # User data contains a header : 1
+ # SRR:
+ # Status report requested : 0 = no / 1 = yes
+ # VPF:
+ # Validity period field
+ # 0 0 : Not set
+ # 0 1 : Reserved
+ # 1 0 : VP field present : relative (integer)
+ # 1 1 : VP field present : absolute (semi-octet)
+ # RD:
+ # Reject (1) or accept (0) an SMS in the SMSC with the same MR and DA from the same OA
+ # MTI:
+ # Message type
+ # 0 0 : SMS deliver SMSC -> MS
+ # 0 1 : SMS Submit MS->SMSC
+ #
+ # We default this field to: 00010001, which means
+ # Validity period in relative format if $vp
+ # SMSSubmit type of message
+ # Accept the same message in the SMSC again
+ # -------------------------------------------------------------------------
+ $pdutype=1; # SMS Submit
+ $pdutype|=0x10 if ($vp); # Vailidity period
+ $pdutype|=0x40 if ($udhi); # User data header present
+ $pdu.=sprintf("%02x", $pdutype);
+ # $pdu.='11';
+ # $pdu.='44';
+ ###########################################################################
+
+ ###########################################################################
+ # 3) Message reference
+ # -------------------------------------------------------------------------
+ # The M20 generates this himself, so we can dummy to 00H
+ # -------------------------------------------------------------------------
+ $pdu.='00';
+ ###########################################################################
+
+ ###########################################################################
+ # Destination address
+ # -------------------------------------------------------------------------
+ # See SMSDeliver for a description
+ # -------------------------------------------------------------------------
+ $pdu.=$self->encodeDestinationAddress($phonenumber);
+ ###########################################################################
+
+ ###########################################################################
+ # protocol identifier
+ # -------------------------------------------------------------------------
+ # See SMSDeliver for a description
+ # 00H : SMS
+ # -------------------------------------------------------------------------
+ $pdu.='00';
+ ###########################################################################
+
+ ###########################################################################
+ # Data coding scheme (probably need to experiment withthis one!)
+ # -------------------------------------------------------------------------
+ # See SMSDeliver for a description
+ # We use '00' for 7bit, SIM specific '7bit' (default)
+ # 'F0' for 7bit, immediate display '7biti'
+ # 'F6' for 8bit, SIM specific '8bit'
+ # 'F4' for 8bit, immediate display '8biti'
+ # 'F5' for 8bit, ME specific '8bitm'
+ # -------------------------------------------------------------------------
+ $pdu.=$self->encodeDataCodingScheme($dcs);
+ ###########################################################################
+
+ ###########################################################################
+ # Validity period
+ # -------------------------------------------------------------------------
+ # Look at encodeValidityPeriod
+ # -------------------------------------------------------------------------
+ if ($vp) {
+ # $pdu.=$self->encodeValidityPeriod($vp);
+ $pdu.='FF';
+ }
+ ###########################################################################
+
+
+ ###########################################################################
+ # Length of message (Length of user data)
+ # -------------------------------------------------------------------------
+ # $pdu.=sprintf("%.2X", length($data));
+ ###########################################################################
+
+
+ ###########################################################################
+ # Message of user data.
+ # -------------------------------------------------------------------------
+ if (($dcs eq '8bit') || ($dcs eq '8biti' || ($dcs eq '8bitm'))) {
+ $pdu.=sprintf("%.2X", length($data)/2);
+ $pdu.=$self->encode_8bit(substr($data,0,160*2));
+ } else {
+ # First to the alphabet translation on the data...
+ $pdu.=sprintf("%.2X", length($data));
+ $data = $self->inversetranslate($data);
+ $pdu.=$self->encode_7bit(substr($data,0,160));
+ }
+ ###########################################################################
+
+ return $pdu;
+}
+
+# decode a SMSSubmit message (experimental!)
+sub SMSSubmit_decode {
+ my ($self, $data) = @_;
+ my @msg = split //, $data;
+
+ # Get service center
+ my $sca = $self->getServiceCenterAddress(\@msg);
+
+ # Get PDU type
+ my $pdu = $self->getoctet(\@msg);
+
+ # message ref
+ my $mref = $self->getoctet(\@msg);
+
+ # destination address
+ my $da = $self->getOriginatingAddress(\@msg);
+
+ # protocol identifier
+ my $pi = $self->getoctet(\@msg);
+
+ # data scheme
+ my $ds = $self->getoctet(\@msg);
+
+ # vp
+ my $vp = $self->getoctet(\@msg);
+
+ # length
+ my $dl = $self->getoctet(\@msg);
+
+ my $udh;
+ my $payload;
+
+ # print join "|", @msg;
+ # print "\n";
+
+ if ($pdu=~/51/) {
+ # we have a user data header
+ my $udhl = hex($msg[0].$msg[1]);
+
+ # print "udhl ($msg[0]): $udhl\n";
+
+ $udh = $self->getoctet(\@msg, $udhl+1);
+ $payload = join("", @msg);
+ } else {
+ $payload = $self->decode_7bit( join("", @msg), 160 );
+ }
+
+ # print "da : $da\n";
+ # print "pdu type : $pdu\n";
+ # print "data scheme : $ds\n";
+ # print "length : $dl\n";
+ # print "udh : $udh\n";
+ # print "pay : $payload\n";
+
+ return ($da, $pdu, $ds, $udh, $payload);
+}
+
+# Get an Adress (OA / DA )
+sub getServiceCenterAddress {
+ my($self, $ref_msg_arr) = @_;
+ my $adr;
+
+ # First get address length
+ my $len = hex($self->getoctet($ref_msg_arr));
+ if ($len>0) {
+ # Second get Type of address
+ my $typ = $self->getoctet($ref_msg_arr);
+
+ # Third get address itself ...
+ for (my $pos=0;$pos<$len-1;$pos++) {
+ $adr.= $self->swapoctet($self->getoctet($ref_msg_arr));
+ }
+
+ # If length is odd we have a trailing F;
+ (($len) & 0x1) && chop($adr);
+
+ # Append a '+' to make a valid international number, when type is 91
+ $adr = ($typ == 91)?'+'.$adr:$adr;
+ }
+ return $adr;
+}
+
+
+# Get an Adress (OA / DA )
+sub getOriginatingAddress {
+ my($self, $ref_msg_arr) = @_;
+ my $adr;
+
+ # First get address length
+ my $len = hex($self->getoctet($ref_msg_arr));
+ # Second get Type of address
+ my $typ = $self->getoctet($ref_msg_arr);
+ # Third get address itself ...
+
+ for (my $pos=0;$pos<$len;$pos+=2) {
+ $adr.= $self->swapoctet($self->getoctet($ref_msg_arr));
+ }
+
+ # If length is odd we have a trailing F;
+ (($len) & 0x1) && chop($adr);
+
+ # Append a '+' to make a valid international number, when type is 91
+ $adr = ($typ == 91)?'+'.$adr:$adr;
+
+ return $adr;
+}
+
+# Validity period
+# For the moment, only integer relative scheme
+# IN: Validity Period in ns(econds), nm(inutes), nh(ours), nd(ays), nw(eeks)
+# n e R
+# OUT: integer representation of validity period
+sub encodeValidityPeriod {
+ my ($self, $ti) = @_;
+
+ my $vp = 0;
+
+ my %timeslice = (
+ 's' => 1,
+ 'm' => 60,
+ 'h' => 60*60,
+ 'd' => 60*60*24,
+ 'w' => 60*60*24*7
+ );
+
+ $ti =~/([\d\.]+)([smhdw])/i;
+ my $s = $1 * $timeslice{lc $2}; # So we have it in seconds
+
+ switch: {
+ $s <= 43200 && do { $vp=($s/300)-1; last switch; };
+ $s <= 86400 && do { $vp=(($s-(12*3600))/(30*60))+143; last switch; };
+ $s <= 2592000 && do { $vp=($s/(24*3600))+166; last switch; };
+ $s <= 38102400 && do { $vp=($s/(24*3600*7))+192; last switch; };
+ }
+ return sprintf("%.2X", $vp);
+}
+
+sub encodeDataCodingScheme {
+ my ($self, $dcs) = @_;
+ my $c = '00'; # default '7bit'
+ DCS: {
+ $dcs eq '7bit' && do { $c = '00'; last; };
+ $dcs eq '7biti' && do { $c = 'F0'; last; };
+ $dcs eq '8bit' && do { $c = 'F6'; last; };
+ $dcs eq '8biti' && do { $c = 'F4'; last; };
+ $dcs eq '8bitm' && do { $c = 'F5'; last; };
+ };
+ return $c;
+}
+
+sub encodeDestinationAddress {
+ my ($self, $number) = @_;
+ my $pdu;
+
+ # Find type of phonenumber
+ # no + => unknown number, + => international number
+ my $type = (substr($number,0,1) eq '+')?'91':'81';
+
+ # Delete any non digits => + etc...
+ $number =~ s/\D//g;
+
+ $pdu.= sprintf("%.2X%s",length($number),$type);
+ $number.= "F"; # For odd number of digits
+ while ($number =~ /^(.)(.)(.*)$/) { # Get pair of digits
+ $pdu.= "$2$1";
+ $number = $3;
+ }
+ return $pdu;
+}
+
+
+sub encodeServiceCenterAddress {
+ my ($self, $number) = @_;
+ my $pdu;
+
+ return '00' if ($number eq '');
+
+ # Find type of phonenumber
+ # no + => unknown number, + => international number
+ my $type = ($number=~/^\+/)?'91':'81';
+
+ # Delete any non digits => + etc...
+ $number =~ s/\D//g;
+
+ $pdu.= sprintf("%.2X%s",(length($number) >> 1)+1,$type);
+ $number.= "F"; # For odd number of digits
+ while ($number =~ /^(.)(.)(.*)$/) { # Get pair of digits
+ $pdu.= "$2$1";
+ $number = $3;
+ }
+ return $pdu;
+}
+
+sub getoctet {
+ my ($self, $ar, $len, $swap) = @_;
+
+ my $o = $ar->[0].$ar->[1];
+ $o=$self->swapoctet($o) if ($swap);
+ shift @$ar;
+ shift @$ar;
+ while (defined($len) && ($len - 1 > 0)) {
+ my $oo = $ar->[0].$ar->[1];
+ $oo=$self->swapoctet($oo) if ($swap);
+ $o.= $oo;
+ shift @$ar;
+ shift @$ar;
+ $len--;
+ }
+ return $o;
+}
+
+sub swapoctet {
+ my ($self, $o) = @_;
+ my @o = split //, $o;
+ return $o[1].$o[0];
+}
+
+sub decode_7bit {
+ my ($self, $ud, $len) = @_;
+ my ($msg,$bits);
+ my $cnt=0;
+ $ud = $ud || "";
+ $len = $len || 0;
+ $msg = "";
+ my $byte = unpack('b8', pack('H2', substr($ud, 0, 2)));
+ while (($cnt<length($ud)) && (length($msg)<$len)) {
+ $msg.= pack('b7', $byte);
+ $byte = substr($byte,7,length($byte)-7);
+ if ( (length( $byte ) < 7) ) {
+ $cnt+=2;
+ $byte = $byte.unpack('b8', pack('H2', substr($ud, $cnt, 2)));
+ }
+ }
+ return $msg;
+}
+
+sub encode_7bit {
+ my ($self, $msg) = @_;
+ my ($bits, $ud, $octet);
+
+ foreach (split(//,$msg)) {
+ $bits .= unpack('b7', $_);
+ }
+ while (defined($bits) && (length($bits)>0)) {
+ $octet = substr($bits,0,8);
+ $ud .= unpack("H2", pack("b8", substr($octet."0" x 7, 0, 8)));
+ $bits = (length($bits)>8)?substr($bits,8):"";
+ }
+ return uc $ud;
+}
+
+sub decode_8bit {
+ my ($self, $ud) = @_;
+ my $msg;
+
+ while ( length($ud) ) {
+ $msg .= pack('H2',substr($ud,0,2));
+ $ud = substr($ud,2);
+ }
+ return $msg;
+}
+
+sub encode_8bit {
+ my ($self, $ud) = @_;
+ my $msg;
+
+ #while (length($ud)) {
+ # $msg .= sprintf("%.2X", ord(substr($ud,0,1)));
+ # $ud = substr($ud,1);
+ #}
+ return $ud;
+}
+
+sub translate {
+ my ($self, $msg) = @_;
+ $msg=~ tr (\x00\x02) (\@\$);
+ $msg=~ tr (\x07\x0f\x7f\x04\x05\x1f\x5c\x7c\x5e\x7e) (iaaeeEOoUu);
+ return $msg;
+}
+
+sub inversetranslate {
+ my ($self, $msg) = @_;
+ # $msg=~ tr (\@\$) (\x00\x02);
+ # $msg=~ tr (iaaeeEOoUu) (\x07\x0f\x7f\x04\x05\x1f\x5c\x7c\x5e\x7e);
+ return $msg;
+}
+1;
+
+=head1 NAME
+
+GSM::SMS::PDU - Codec for Protocol Data Units.
+
+=head1 DESCRIPTION
+
+This module implements 2 PDUs ( Protocol Data Units ) ,SMS-DELIVER and SMS-SUBMIT, as defined in the SM-TL (Short Message Transport Layer ) specifications.
+These PDUs are defined in the GSM03.40 specification from the ETSI ( www.etsi.org ). These PDUs are sufficient to implement NBS ( Narrow Bandwidth Sockets ).
+Specification GSM07.05 explains the MMI ( Man Machine Interface ) for the AT+Cellular commands to be able to talk to a GSM modem.
+
+=head1 METHODS
+
+ use GSM::SMS::PDU;
+ my $pdu = GSM::SMS::PDU->new();
+
+=head2 SMSDeliver
+
+Decode a short message that comes from the SMSC (Short Message Service Center) to the MS (Mobile Station) (SMS-DELIVER).
+Returns itself as a hash and you can access values the following way:
+
+ my $originating_address = $pdu->{'TP-OA'};
+
+=head2 SMSSubmit
+
+Encode a short message for sending from the MS to the SMSC (SMS-SUBMIT).
+
+ my $encoded = $pdu->SMSSubmit(
+ $servicecenteraddress,
+ $phonenumber,
+ $payload, $datacodingscheme,
+ $validityperiod,
+ $userdataincluded );
+
+=head2 SMSSubmit_decode
+
+Decode a SMS-SUBMIT PDU.
+
+=head1 ISSUES
+
+No real OO design. The NBS part that filters out the port-number in the UD ( User Data ) should be migrated to a higher (abstraction) layer.
+No support for charsets.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::Spool;
+use Carp;
+# implement spool functions
+
+use Exporter;
+@ISA = ('Exporter');
+@EXPORT = qw(add_to_spool remove_from_spool create_spoolname read_from_spool);
+$VERSION = '0.1';
+
+sub add_to_spool {
+ my ($msisdn, $pdu, $dir) = @_;
+ local (*F);
+
+ my $filename = create_spoolname($msisdn, $pdu);
+ open F, ">".$dir."/".$filename;
+ print F $pdu;
+ close F;
+}
+
+
+sub remove_from_spool {
+ my ($file, $dir) = @_;
+
+ unlink( $dir."/".$file ) or die $!;
+}
+
+sub create_spoolname {
+ my ($msisdn, $pdu) = @_;
+
+ $msisdn =~ s/^\+//;
+ my $filename = $msisdn . "_" . $$ . time . substr($pdu,-32);
+ return $filename;
+}
+
+sub read_from_spool {
+ my ($dir, $n) = @_;
+ local (*DIR);
+ my ($file, $count, @arr);
+ # return array with $n==0:<all>:$n messages from spooldir
+ $count = 0;
+ opendir(DIR, $dir) or croak "Could not read directory $dir ($!)";
+ while ( defined($file = readdir(DIR)) && ( ($n && $count<$n) || !$n) ) {
+ next if $file =~ /^\.\.?$/;
+ $count++;
+ if ($file =~ /(.+?)_.+/) {
+ my $msisdn = $1;
+ # contents of file
+ local (*F);
+ open F, $dir . "/" . $file;
+ undef $/;
+ my $contents = <F>;
+ close F;
+ my $msg = {};
+ $msg->{'msisdn'} = $msisdn;
+ $msg->{'pdu'} = $contents;
+ $msg->{'file'} = $file;
+ push(@arr, $msg);
+ }
+ }
+ closedir(DIR);
+ return @arr;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::Spool
+
+=head1 DESCRIPTION
+
+Implements a simple filesystem spool mechanism to temporarily store incoming and outgoing SMS messages.
+
+=head1 METHODS
+
+=head2 add_to_spool( $msisdn, $pdu, $dir )
+
+Add a message to the spool dir.
+
+=head2 remove_from_spool( $file, $dir )
+
+Remove a message from a spool dir.
+
+=head2 create_spoolname( $msisdn, $dir )
+
+Create the filename for a spool message. Internal function.
+
+=head2 read_from_spool( $dir, $n )
+
+Read n messages from the spool.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::Support::RTTTL2MIDI;
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION $error_rtttl %rtl_props @rtl_notes $rtl_name);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(Rtttl2Midi);
+$VERSION = 0.1;
+
+$rtl_name = "";
+%rtl_props = ();
+@rtl_notes = ();
+$error_rtttl = "Yaketysax:d=4,o=5,b=125:8d.,16e,8g,8g,16e,16d,16a4,16b4,16d,16b4,";
+$error_rtttl .="8e,16d,16b4,16a4,16b4,8a4,16a4,16a#4,16b4,16d,16e,16d,g,p,16d,16e,";
+$error_rtttl .="16d,8g,8g,16e,16d,16a4,16b4,16d,16b4,8e,16d,16b4,16a4,16b4,8d,16d,";
+$error_rtttl .="16d,16f#,16a,8f,d,p,16d,16e,16d,8g,16g,16g,8g,16g,16g,8g,8g,16e,8e.,";
+$error_rtttl .="8c,8c,8c,8c,16e,16g,16a,16g,16a#,8g,16a,16b,16a#,16b,16a,16b,8d6,16a,";
+$error_rtttl .="16b,16d6,8b,8g,8d,16e6,16b,16b,16d,8a,8g,g";
+
+
+sub Rtttl2Midi {
+ my($xrtttl,$program) = @_;
+ $program = 1 unless defined $program;
+ my $status = pharse_rtttl($xrtttl);
+ if ($status == 0) {
+ $rtl_name = "";
+ %rtl_props = ();
+ @rtl_notes = ();
+
+ $xrtttl = $error_rtttl;
+ pharse_rtttl($xrtttl);
+ }
+
+ my ($head, $track_data, $track_head, $midi);
+
+ $head = mf_write_header_chunk(0,1,384);
+ $track_data = copy_right();
+ $track_data .= track_name("MIDI by RTTTL2MIDI");
+ $track_data .= volumeup();
+ $track_data .= mf_write_tempo($rtl_props{b});
+ $track_data .= add_program($program);
+ $track_data .= notes2midi();
+ $track_data .= end_track();
+ $track_head = mf_write_track_chunk($track_data);
+ $midi = $head . $track_head . $track_data;
+ return($midi);
+}
+
+sub clean_spaces {
+ my ($str) = @_;
+ $str =~ s/\s//g;
+ return($str);
+}
+
+sub pharse_rtttl {
+ my ($str) = @_;
+ my ($name,$defaults,$notes) = split /:/, $str;
+ unless($name=~/[a-zA-Z0-9]/ && length($name) < 32) { return 0; }
+ map { my($n,$v) = split /=/, $_; $rtl_props{$n} = $v; } split /,/, $defaults;
+ unless($rtl_props{d} =~ /\d+/) { return 0; }
+ unless($rtl_props{o} =~ /\d+/) { return 0; }
+ unless($rtl_props{b} =~ /\d+/) { return 0; }
+ my($dotted, $i, $r) = 0;
+ my @nts = split /,/, clean_spaces($notes);
+ for($i=0; $i < @nts; $i++) {
+ my($d,$n,$s,$x) = ($nts[$i] =~ /(\d*)([a-z]#?)(\d*)(\.?)/);
+ #duration, note, oktav, dot
+ unless($d =~ /\d*/) { return 0; }
+ unless($n =~ /[a-z]#?/) { return 0; }
+ unless($s =~ /\d*/) { return 0; }
+ unless($x =~ /\.?/) { return 0; }
+ $dotted = ($x eq ".") ? 1:0;
+ $d = $rtl_props{d} if($d == "");
+ $s = $rtl_props{o} if($s == "");
+ $rtl_notes[$i] = ([$d,$n,$s,$dotted]);
+ $r = 1;
+ }
+ return($r);
+}
+
+sub eputc {
+ my($input) = @_;
+ return(chr($input));
+}
+
+sub write32bit {
+ my ($data) = @_;
+ my $r;
+ $r .= eputc((($data >> 24) & 0xff));
+ $r .= eputc((($data >> 16) & 0xff));
+ $r .= eputc((($data >> 8 ) & 0xff));
+ $r .= eputc(($data & 0xff));
+ return($r);
+}
+
+sub write16bit {
+ my ($data) = @_;
+ my $r;
+ $r .= eputc((($data & 0xff00) >> 8));
+ $r .= eputc(($data & 0xff));
+ return($r);
+}
+
+sub mf_write_header_chunk {
+ my ($format, $ntracks, $division) = @_;
+ my $ident = 0x4d546864;
+ my $length = 6;
+ my $r;
+ $r .= write32bit($ident);
+ $r .= write32bit($length);
+ $r .= write16bit($format);
+ $r .= write16bit($ntracks);
+ $r .= write16bit($division);
+ return($r);
+}
+
+sub mf_write_track_chunk {
+ my ($track) = @_;
+ my $trkhdr = 0x4d54726b;
+ my $r;
+ $r .= write32bit($trkhdr);
+ $r .= write32bit(length($track));
+ return($r);
+}
+
+sub WriteVarLen {
+ my ($value) = @_;
+ my $buffer=0;
+ my $r;
+ $buffer = $value & 0x7f;
+ while(($value >>= 7) > 0) {
+ $buffer <<= 8;
+ $buffer |= 0x80;
+ $buffer += ($value & 0x7f);
+ }
+ while(1) {
+ $r .= eputc(($buffer & 0xff));
+ if($buffer & 0x80) {
+ $buffer >>= 8;
+ } else {
+ return($r);
+ }
+ }
+}
+
+sub mf_write_tempo {
+ my ($t) = @_;
+ my $tempo = (60000000.0 / ($t));
+ my $r;
+ $r .= eputc(0);
+ $r .= eputc(0xff);
+ $r .= eputc(0x51);
+ $r .= eputc(3);
+ $r .= eputc((0xff & ($tempo >> 16)));
+ $r .= eputc((0xff & ($tempo >> 8)));
+ $r .= eputc((0xff & $tempo));
+ return($r);
+}
+
+sub mf_write_midi_event {
+ my ($delta_time, $type, $chan, @data) = @_;
+ my $i;
+ my $c = 0;
+ my $r = WriteVarLen($delta_time);
+ $c = $type | $chan;
+ $r .= eputc($c);
+ for($i = 0; $i < @data; $i++) {
+ $r .= eputc($data[$i]);
+ }
+ return($r);
+}
+
+sub data {
+ my($p1,$p2) = @_;
+ my @r;
+ $r[0] = $p1;
+ $r[1] = $p2;
+ return @r;
+}
+
+sub data1 {
+ my($p1)=@_;
+ my @r;
+ $r[0] = $p1;
+ return @r;
+}
+
+sub end_track {
+ my $r;
+ $r .= eputc(0);
+ $r .= eputc(0xFF);
+ $r .= eputc(0x2f);
+ $r .= eputc(0);
+ return($r);
+}
+
+sub add_program {
+ my ($prg) = @_;
+ my $r;
+ $r = mf_write_midi_event(0,0xc0,0,data1($prg));
+ return($r);
+}
+
+sub note {
+ my($s, $d, $p, $td) = @_;
+ my $r;
+ $r .= mf_write_midi_event($s,0x90,0,data($p,100));
+ $r .= mf_write_midi_event($d,0x80,0,data($p,0));
+ return($r);
+}
+
+sub volume {
+ my $r = "";
+ return($r);
+}
+
+sub copy_right {
+ my $c = "Rtttl2Midi CopyRight under GPL written by sanalCell.com 2001";
+ my $r;
+ $r .= eputc(0);
+ $r .= eputc(0xff);
+ $r .= eputc(0x02);
+ $r .= eputc(length($c));
+ $r .= $c;
+ return($r);
+}
+
+sub track_name {
+ my($c) = @_;
+ my $r;
+ $r .= eputc(0);
+ $r .= eputc(0xff);
+ $r .= eputc(0x03);
+ $r .= eputc(length($c));
+ $r .= $c;
+ return($r);
+}
+
+sub volumeup() {
+ my $r;
+ $r = mf_write_midi_event(0,0xB0,0,data(0x07,127));
+ return($r);
+}
+
+sub get_pitch {
+ my($nt,$oc) = @_;
+ $nt = lc(clean_spaces($nt));
+ my $r =0;
+ my %n =("p" => -1,
+ "c" => 0,
+ "c#" => 1,
+ "d" => 2,
+ "d#" => 3,
+ "e" => 4,
+ "f" => 5,
+ "f#" => 6,
+ "g" => 7,
+ "g#" => 8,
+ "a" => 9,
+ "a#" => 10,
+ "b" => 11);
+ #h=b
+ $r = $n{$nt};
+ if($r != -1) {
+ $r = 12 + (12*$oc) + $r;
+ }
+ return($r);
+}
+
+sub get_time {
+ my($t, $isd) = @_;
+ my $r = 0;
+ my %d =("1" => 1536,
+ "2" => 768,
+ "4" => 384,
+ "8" => 192,
+ "16" => 96,
+ "32" => 48,
+ "64" => 24);
+ $r = $d{$t};
+ if($isd) {
+ $r = $r + ($r/2);
+ }
+ return($r);
+}
+
+sub notes2midi {
+ my ($r,$alldata);
+ my ($a, $pt, $tm, $rest) = 0;
+ for($a = 0; $a != @rtl_notes; $a++) {
+ $pt = get_pitch($rtl_notes[$a][1],$rtl_notes[$a][2]-1);
+ $tm = get_time($rtl_notes[$a][0],$rtl_notes[$a][3]);
+
+ if($pt == -1) {
+ $rest = $tm;
+ } else {
+ $alldata .= note($rest,$tm,$pt,$r);
+ $rest = 0;
+ }
+ }
+ return($alldata);
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::Support::RTTTL2MIDI
+
+=head1 SYNOPSIS
+
+ use GSM::SMS::Support::RTTTL2MIDI;
+
+ print "Content-type: audio/x-midi\n\n";
+ print Rtttl2Midi($rtttl_string, $piano);
+
+=head1 DESCRIPTION
+
+Converts rtttl strings to midi sound. Also you can set piano
+like Hammod Organ (17) and Grand Piano (1).
+
+=head1 METHODS
+
+=head2 Rtttl2Midi($strRTTTL, $piano)
+
+Generate a binary midi stream from $strRTTTL, using $piano as the
+instrument.
+
+=head1 AUTHOR
+
+Ethem Evlice <webmaster@tuzluk.com>
--- /dev/null
+package GSM::SMS::Transport;\r
+use strict;\r
+use vars qw( $VERSION );\r
+\r
+use Carp;\r
+use GSM::SMS::Config;\r
+use Data::Dumper;\r
+\r
+$VERSION = '0.11';\r
+\r
+# Constructo\r
+##########################################################################\r
+sub new {\r
+ my $proto = shift;\r
+ my $class = ref($proto) || $proto;\r
+ my $self = {}; \r
+ bless($self, $class); \r
+\r
+ # process constructor parameters\r
+ $self->{"__CONFIG_FILE__"} = shift;\r
+ \r
+ # initialize class parameters\r
+ # anonymous array to transports\r
+ $self->{"__TRANSPORTS__"} = [];\r
+ \r
+ # read config file\r
+ unless ( $self->{"__CONFIG__"} = read_config( $self->{"__CONFIG_FILE__"} )) {\r
+ croak("Could not load config file : " . $self->{"__CONFIG_FILE__"} . "!");\r
+ }\r
+\r
+ # print Dumper $self->{'__CONFIG__'};\r
+\r
+ # initialise transport\r
+ my $ress = $self->_init( $self->{"__CONFIG__"} );\r
+ if ( $ress == -1) {\r
+ return undef;\r
+ }\r
+ return $self;\r
+}\r
+\r
+# Send\r
+##########################################################################\r
+sub send {\r
+ my ($self, $msisdn, $pdu) = @_;\r
+\r
+ my $transport = $self->_route($msisdn);\r
+ return $transport->send($msisdn, $pdu) if $transport;\r
+ return -1;\r
+}\r
+\r
+# Receive\r
+##########################################################################\r
+sub receive {\r
+ my ($self) = @_;\r
+ my $pdu;\r
+\r
+ foreach my $transporter ( @{$self->get_transports()} ) {\r
+ if (!$transporter->receive(\$pdu)) {\r
+ return $pdu;\r
+ }\r
+ }\r
+ return $pdu;\r
+}\r
+\r
+# Get an array containing the transports\r
+##########################################################################\r
+sub get_transports {\r
+ my $self = shift;\r
+ return $self->{"__TRANSPORTS__"};\r
+}\r
+\r
+# Close\r
+# Clean up ...\r
+##########################################################################\r
+sub close {\r
+ my $self = shift;\r
+ \r
+ foreach my $transport ( @{$self->{"__TRANSPORTS__"}} ) {\r
+ $transport->close();\r
+ }\r
+}\r
+\r
+##########################################################################\r
+# P R I V A T E\r
+##########################################################################\r
+\r
+# Route\r
+# Give us the handle to the correct transport to use\r
+# Implements the routing.\r
+# Routing is now only done by the 'prefix' config parameter\r
+sub _route {\r
+ my ($self, $msisdn) = @_;\r
+ \r
+ # print "route... ";\r
+ foreach my $transport ( @{$self->{"__TRANSPORTS__"}} ) {\r
+ # print "--> $transport\n";\r
+ if ( $transport->has_valid_route($msisdn) ) {\r
+ # print "found ($transport)\n";\r
+ return $transport;\r
+ }\r
+ }\r
+ # print "END\n";\r
+ return undef;\r
+}\r
+\r
+# Init\r
+# Create the actual transports and initialize them\r
+sub _init {\r
+ my ($self, $conf) = @_;\r
+\r
+ # print Dumper $conf;\r
+\r
+ foreach my $transport ( keys %$conf ) {\r
+ next if $transport =~ /default/;\r
+\r
+ #print "T: $transport ... ";\r
+\r
+ # load transport class, using the preferences\r
+ my $transport_config = get_config($conf, $transport);\r
+ my $transport_type = $transport_config->{"type"};\r
+\r
+ # print Dumper $transport_config;\r
+ \r
+ # print "starting up $transport_type..\n";\r
+ \r
+ my $transport_instance = eval(\r
+ "use GSM::SMS::Transport::$transport_type; my \$n = GSM::SMS::Transport::$transport_type->new(\$transport_config); return \$n;"\r
+ );\r
+\r
+ # print $@;\r
+\r
+ # print "use Tektonica::iSMS::Transport::$transport_type; my \$n = Tektonica::iSMS::Transport::$transport->new(\$transport_config); return \$n;";\r
+\r
+ # If we didn't succeeded in loading the transport, there is\r
+ # sometghing wrong. better bail out now and inform user, \r
+ # otherwise he can get the impression all is fine, while not!\r
+ return -1 unless $transport_instance;\r
+ \r
+ push( @{$self->{"__TRANSPORTS__"}}, $transport_instance );\r
+ # print "\n";\r
+ }\r
+ return 0;\r
+}\r
+\r
+1;\r
+\r
+=head1 NAME\r
+\r
+GSM::SMS::Transport\r
+\r
+=head1 DESCRIPTION\r
+\r
+This can be best seen as a factory for the transports defined in the GSM::SMS::Transport::* modules.\r
+When given a config file, it dynamically loads the transports defined in that config file, and initializes them.\r
+ \r
+=head1 METHODS\r
+\r
+=head2 new( $configfile )\r
+\r
+Create a new transport layer with the settings as in the config file. Please look in the example config file for the transport specific configuration settings.\r
+\r
+=head2 send( $msisdn, $pdu )\r
+\r
+Send a PDU message to the the msisdn. The transport layer will choose a transport according to the regular expression defined in the config file. This regexp matches against the msisdn.\r
+\r
+=head2 $pdu = $t->receive()\r
+\r
+Receive a pdu message from the transport layer. Undef when no new message available.\r
+\r
+=head2 close()\r
+\r
+Shut down transport layer, calls the transport specific close method.\r
+\r
+\r
+=head1 AUTHOR\r
+\r
+Johan Van den Brande <johan@vandenbrande.com>\r
--- /dev/null
+package GSM::SMS::Transport::MCube;
+use strict;
+use vars qw( $VERSION );
+$VERSION = '0.1';
+
+#
+# HTTP access to the MCube SMS center
+#
+
+use base qw( GSM::SMS::Transport::Transport );
+
+
+use HTTP::Request::Common qw(GET);
+use LWP::UserAgent;
+use URI::URL qw(url);
+use URI::Escape qw(uri_escape);
+use GSM::SMS::PDU;
+use GSM::SMS::Log;
+use Data::Dumper;
+
+# All the parameters I need to run
+my @config_vars = qw(
+ name
+ proxy
+ userid
+ password
+ originator
+ smsserver
+ match
+ spoolout
+ log
+ );
+# constructor
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{cfg} = shift;
+
+ $self->{'__LOGGER__'} = GSM::SMS::Log->new( $self->{cfg}->{"log"} );
+
+ bless($self, $class);
+ return $self;
+}
+
+
+# Send a (PDU encoded) message
+sub send {
+ my ($self, $msisdn, $pdu) = @_;
+ my $logger = $self->{'__LOGGER__'};
+
+ $logger->logentry("send [$pdu]") if $logger;
+
+ $self->_add_to_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
+ if ( $self->_transmit($pdu, $self->{cfg}->{"smsserver"}) ) {
+ $logger->logentry( "Error sending" ) if $logger;
+ return -1;
+ }
+ $self->_remove_from_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
+ return 0;
+};
+
+# Receive a PDU encoded message
+# $ is a ref to a PDU string
+# return
+# 0 if PDU received
+# -1 if no message pending
+sub receive {
+ my ($self, $pduref) = @_;
+
+ return -1;
+};
+
+
+# Close
+sub close {
+ my ($self) = @_;
+ my $logger = $self->{'__LOGGER__'};
+
+ $logger->logentry("MCube Transport ended.") if $logger;
+}
+
+# A ping command .. just return an informative string on success
+sub ping {
+ my ($self) = @_;
+
+ return "Pong.. MCube transport ok";
+}
+
+
+# give out the needed config paramters
+sub get_config_parameters {
+ my ($self) = @_;
+
+ return @config_vars;
+}
+
+# Do we have a valid route for this msisdn
+sub has_valid_route {
+ my ($self, $msisdn) = @_;
+
+ # print "in route\n";
+ # print Dumper $self->{cfg};
+ foreach my $route ( split /,/, $self->{cfg}->{"match"} ) {
+ # print $route;
+ return -1 if $msisdn =~ /$route/;
+ }
+ return 0;
+}
+
+#####################################################################
+# transport specific
+#####################################################################
+sub _transmit {
+ my ($self, $pdustr, $server) = @_;
+
+ my $logger = $self->{'__LOGGER__'};
+
+ my $uid = $self->{cfg}->{"userid"};
+ my $pwd = $self->{cfg}->{"password"};
+ my $originator = $self->{cfg}->{"originator"};
+ my $proxy = $self->{cfg}->{"proxy"};
+ my $url = url( $server );
+ my $msg;
+ my $decoder = GSM::SMS::PDU->new();
+ my ($da, $pdutype, $dcs, $udh, $payload) = $decoder->SMSSubmit_decode($pdustr);
+
+ $da=~s/^\+//;
+
+ my $type;
+ if (defined($udh) && (length($udh) > 0)) {
+ # transfor to hexprints
+ #$udh = $self->serialize_to_hex( $decoder->decode_7bit( $udh, length($udh) ));
+ #$payload = $self->serialize_to_hex( $decoder->decode_7bit( $payload, length($payload) ) );
+
+ # $udh = $decoder->decode_7bit( $udh, length($udh));
+ # $payload = $decoder->decode_7bit( $payload, length($payload) );
+
+ $type = 3;
+ } else {
+ $type = 1;
+ $udh = "";
+ }
+
+
+print <<EOT;
+login : $uid
+password : $pwd
+togsm : $da
+data : $payload
+type : $type
+UDH : $udh
+oastring : $originator
+EOT
+
+
+ my $ua = LWP::UserAgent->new();
+ $ua->proxy( 'http', $proxy ) if ( $proxy ne "" );
+ my $urlstring = "$server"
+ .
+ "?"
+ .
+ "login=" . uri_escape( $uid )
+ .
+ "&password=" . uri_escape( $pwd )
+ .
+ "&togsm=" . uri_escape( $da )
+ .
+ "&oastring=" . uri_escape( $originator )
+ .
+ "&type=" . $type
+ .
+ "&datas=" . uri_escape( $payload )
+ .
+ "&header=" . uri_escape( $udh )
+ ;
+
+ # $urlstring = 'http://www.m3.be/scripts/httpgate1.cfm?login=vdb&password=xserd54&togsm=32475567606&oastring=MCUBE&type=1&datas=Hello+World';
+
+ print "$urlstring\n";
+
+ my $req = GET $urlstring;
+ $req->header( Host => $url->host );
+
+ my $res = $ua->request($req);
+
+ print "#" x 80 . "\n";
+ print $res->content;
+ print "#" x 80 . "\n";
+
+ if ($res->is_success) {
+ my $content = $res->content;
+ $logger->logentry( "return: $content" ) if $logger;
+ return 0 if ($content=~/01/);
+ return -1;
+ } else {
+ $logger->logentry( "error!" ) if $logger;
+ $logger->logentry( $res->error_as_HTML ) if $logger;
+ return -1;
+ }
+}
+
+sub serialize_to_hex {
+ my ($self, $ud) = @_;
+ my $msg;
+
+ while (length($ud)) {
+ $msg .= sprintf("%.2X", ord(substr($ud,0,1)));
+ $ud = substr($ud,1);
+ }
+ return $msg;
+}
+
+sub _add_to_spool {
+ my ($self, $msisdn, $pdu, $dir) = @_;
+ local *F;
+
+ my $filename = $self->_create_spoolname($msisdn, $pdu);
+ open F, ">".$dir."/".$filename;
+ print F $pdu;
+ CORE::close F;
+}
+
+
+sub _remove_from_spool {
+ my ($self, $msisdn, $pdu, $dir) = @_;
+
+ my $filename = $self->_create_spoolname($msisdn, $pdu);
+ unlink( $dir."/".$filename );
+}
+
+sub _create_spoolname {
+ my ($self, $msisdn, $pdu) = @_;
+
+ $msisdn =~ s/^\+//;
+ my $filename = $msisdn . "_" . $$ . time . substr($pdu,-32);
+ return $filename;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::Transport::MCube
+
+=head1 DESCRIPTION
+
+Implements a ( send-only ) transport for the MCube ss7 SMS gateway.
+Please visit www.mcube.be for getting an account.
+
+Also can do PDU messages and as such can be used to send NBS messages.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
+
+
--- /dev/null
+package GSM::SMS::Transport::NovelSoft;
+
+#
+# HTTP access to the NovelSoft (sms-wap.com) SMS center
+#
+
+use GSM::SMS::Transport::Transport;
+@ISA = qw(GSM::SMS::Transport::Transport);
+
+$VERSION = '0.1';
+
+use HTTP::Request::Common qw(POST);
+use LWP::UserAgent;
+use URI::URL qw(url);
+use GSM::SMS::PDU;
+use GSM::SMS::Log;
+use Data::Dumper;
+
+# All the parameters I need to run
+my @config_vars = qw(
+ name
+ proxy
+ userid
+ password
+ originator
+ smsserver
+ backupsmsserver
+ match
+ spoolout
+ );
+
+# constructor
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{cfg} = shift;
+
+ $self->{'__LOGGER__'} = GSM::SMS::Log->new( $self->{cfg}->{"log"} );
+
+ bless($self, $class);
+ return $self;
+}
+
+
+# Send a (PDU encoded) message
+sub send {
+ my ($self, $msisdn, $pdu) = @_;
+ my $logger = $self->{'__LOGGER__'};
+
+ $logger->logentry("send [$pdu]") if $logger;
+
+ $self->_add_to_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
+ if ( $self->_transmit($pdu, $self->{cfg}->{"smsserver"}) ) {
+ # trying backup
+ if ( $self->_transmit($pdu, $self->{cfg}->{"backupsmsserver"}) ) {
+ $logger->logentry( "Error sending" ) if $logger;
+ return -1;
+ }
+ }
+ $self->_remove_from_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
+ return 0;
+};
+
+# Receive a PDU encoded message
+# $ is a ref to a PDU string
+# return
+# 0 if PDU received
+# -1 if no message pending
+sub receive {
+ my ($self, $pduref) = @_;
+
+ return -1;
+};
+
+
+# Close
+sub close {
+ my ($self) = @_;
+ my $logger = $self->{'__LOGGER__'};
+
+ $logger->logentry("NovelSoft Transport ended.") if $logger;
+}
+
+# A ping command .. just return an informative string on success
+sub ping {
+ my ($self) = @_;
+
+ return "Pong.. NovelSoft transport ok";
+}
+
+
+# give out the needed config paramters
+sub get_config_parameters {
+ my ($self) = @_;
+
+ return @config_vars;
+}
+
+# Do we have a valid route for this msisdn
+sub has_valid_route {
+ my ($self, $msisdn) = @_;
+
+ # print "in route\n";
+ # print Dumper $self->{cfg};
+ foreach my $route ( split /,/, $self->{cfg}->{"match"} ) {
+ # print $route;
+ return -1 if $msisdn =~ /$route/;
+ }
+ return 0;
+}
+
+#####################################################################
+# transport specific
+#####################################################################
+sub _transmit {
+ my ($self, $pdustr, $server) = @_;
+
+ my $logger = $self->{'__LOGGER__'};
+
+ my $uid = $self->{cfg}->{"userid"};
+ my $pwd = $self->{cfg}->{"password"};
+ my $originator = $self->{cfg}->{"originator"};
+ my $proxy = $self->{cfg}->{"proxy"};
+ my $url = url( $server );
+ my $msg;
+ my $decoder = GSM::SMS::PDU->new();
+ my ($da, $pdutype, $dcs, $udh, $payload) = $decoder->SMSSubmit_decode($pdustr);
+
+ $da=~s/^\+//;
+
+ if (length($udh) > 0) {
+ $udh = '01' . sprintf("%02X", int(length($udh)/2)) . $udh;
+ $msg="|$udh|$payload";
+ } else {
+ $msg=$payload;
+ }
+
+ my $ua = LWP::UserAgent->new();
+ $ua->proxy( 'http', $proxy ) if ( $proxy ne "" );
+ my $req = POST "$server",
+ [
+ UID => $uid,
+ PW => $pwd,
+ N => $da,
+ O => $originator,
+ M => $msg
+ ];
+
+ $req->header( Host => $url->host );
+
+ my $res = $ua->request($req);
+
+ # print "#" x 80 . "\n";
+ # print $res->content;
+ # print "#" x 80 . "\n";
+
+ if ($res->is_success) {
+ my $content = $res->content;
+ $logger->logentry( "return: $content" ) if $logger;
+ return 0 if ($content=~/01/);
+ return -1;
+ } else {
+ $logger->logentry( "error!" ) if $logger;
+ $logger->logentry( $res->error_as_HTML ) if $logger;
+ return -1;
+ }
+}
+
+sub _add_to_spool {
+ my ($self, $msisdn, $pdu, $dir) = @_;
+ local *F;
+
+ my $filename = $self->_create_spoolname($msisdn, $pdu);
+ open F, ">".$dir."/".$filename;
+ print F $pdu;
+ CORE::close( F );
+}
+
+
+sub _remove_from_spool {
+ my ($self, $msisdn, $pdu, $dir) = @_;
+
+ my $filename = $self->_create_spoolname($msisdn, $pdu);
+ unlink( $dir."/".$filename );
+}
+
+sub _create_spoolname {
+ my ($self, $msisdn, $pdu) = @_;
+
+ $msisdn =~ s/^\+//;
+ my $filename = $msisdn . "_" . $$ . time . substr($pdu,-32);
+ return $filename;
+}
+
+1;
+
+=head1 NAME
+
+GSM::SMS::Transport::NovelSoft
+
+=head1 DESCRIPTION
+
+Implements a ( send-only ) transport for the www.sms-wap.com http based sms center. This is a swiss company and they provide a very nice service. A pity that all, but one, GSM operator stopped roaming with Swiss. this way it is not possible anymore for us ( Belgium ) to use this service ... But they have still more then 1 hundred countries served!
+
+Also can do PDU messages and as such can be used to send NBS messages.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
+
+
--- /dev/null
+package GSM::SMS::Transport::Serial;
+
+#
+# SMS transport layer for serial GSM modems
+#
+
+use GSM::SMS::Transport::Transport;
+@ISA = qw(GSM::SMS::Transport::Transport);
+
+$VERSION = '0.1';
+
+use Device::SerialPort;
+use GSM::SMS::Log;
+use GSM::SMS::Spool;
+
+# All the parameters I need to run ...
+my @config_vars = qw(
+ name
+ match
+ serial-port
+ baud-rate
+ heartbeat
+ pin-code
+ csca
+ spoolout
+ spoolin
+ );
+
+my $__TO = 200;
+
+# constructor
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{cfg} = shift;
+
+ $self->{'__LOGGER__'} = GSM::SMS::Log->new( $self->{cfg}->{"log"} );
+
+ bless($self, $class);
+ my $success = $self->init( $self->{cfg} );
+ return undef if $success == -1;
+ return $self;
+}
+
+# Send a PDU encoded message
+sub send {
+ my($self, $msisdn, $p) = @_;
+ my $logger = $self->{'__LOGGER__'};
+ chomp($p);
+
+ # print "MSISDN : $msisdn\n";
+ # print "MSG: $p\n";
+
+ # calculate length of message
+ my $len = length($p)/2 - 1;
+ $len-=hex( substr($p, 0, 2) );
+
+ # $self->_at("ATE0\r", $__TO);
+ $self->_at("AT+CMGF=0\r", $__TO);
+ $self->_at("AT+CMGS=$len\r", $__TO, ">");
+ my $res = $self->_at("$p\cz", $__TO);
+
+ # print "## $res\n";
+
+ if ($res=~/OK/) {
+ $logger->logentry("send [$p]") if $logger;
+ return 0;
+ } else {
+ $logger->logentry("error sending [$p]") if $logger;
+ return -1;
+ }
+}
+
+
+# Receive a PDU encoded message
+# Will return a PDU string in $pduref from the modem IF we have a message pending
+# return
+# 0 if PDU received
+# -1 if no message pending
+sub receive {
+ my ($self, $pduref) = @_;
+
+ my $ar = $self->{MSGARRAY};
+ my $msg = shift (@$ar); # shift because we want to delete lower index first (problem with modem)
+ if (!$msg) {
+
+ # Read in pending messages
+ my $msgarr = $self->_getSMS();
+ foreach my $msg (@$msgarr) {
+ push @$ar, $msg;
+ }
+ $msg = shift (@$ar); # shift same reason as above
+ }
+ if ($msg) {
+ $$pduref = $msg->{MSG};
+ if ($msg->{LENGTH}) {
+ $self->_delete($msg->{ID});
+ }
+ return 0;
+ }
+ return -1;
+}
+
+
+# Initialise this transport layer$
+# No init file -> default initfile for transport
+sub init {
+ my ($self, $config) = @_;
+
+ my $ress = $self->_init($config);
+ if ( $ress ) {
+ return -1;
+ }
+
+ $self->{MSGARRAY} = [];
+
+ return 0;
+}
+
+
+
+# Close the init file
+sub close {
+ my ($self) =@_;
+
+ my $logger = $self->{'__LOGGER__'};
+
+ my $l = $self->{log};
+ undef $self->{port};
+ $logger->logentry("Serialtransport stopped") if $logger;
+}
+
+
+# A ping command .. just return an informative string on success
+sub ping {
+ my ($self) = @_;
+
+ return $self->_getSQ();
+}
+
+# give out the needed config paramters
+sub get_config_parameters {
+ my ($self) = @_;
+
+ return @config_vars;
+}
+
+# Do we have a valid route for this msisdn
+sub has_valid_route {
+ my ($self, $msisdn) = @_;
+
+ # print "in route\n";
+ # print Dumper $self->{cfg};
+ foreach my $route ( split /,/, $self->{cfg}->{"match"} ) {
+ # print $route;
+ return -1 if $msisdn =~ /$route/;
+ }
+ return 0;
+}
+
+sub get_name {
+ my ($self) = @_;
+
+ return $self->{cfg}->{name};
+}
+
+###############################################################################
+# Transport layer specific functions
+#
+sub _init {
+ my ($self, $cfg) = @_;
+
+ my $logger = $self->{'__LOGGER__'};
+
+ # print Dumper $cfg;
+
+
+ # Start of log ...
+ $logger->logentry('Starting Serial Transport for '.$cfg->{"name"}) if $logger;
+
+ # Get configuration from config file
+
+
+
+ $self->{cfg} = $cfg;
+
+ my $port = $cfg->{"serial-port"} || return -1;
+ my $br = $cfg->{"baud-rate"} || return -1;
+ my $pc = $cfg->{"pin-code"} || return -1;
+ my $csca = $cfg->{"csca"} || return -1;
+ my $modem = $cfg->{"name"};
+
+ # Start up serial port
+ $self->{port} = Device::SerialPort->new ($port);
+ $self->{port}->baudrate($br);
+ $self->{port}->parity("none");
+ $self->{port}->databits(8);
+ $self->{port}->stopbits(1);
+
+ # Try to communicate to the port
+ $self->_at("ATZ\r", $__TO);
+ $self->_at("ATE0\r", $__TO);
+ my $res = $self->_at("AT\r", $__TO);
+
+ unless ($res =~/OK/is) {
+ $logger->logentry('Could not communicate to '.$port.'.') if $logger;
+ return -1;
+ }
+
+ # Check the modem status (PIN, CSCA and network connection)
+ return -1 unless ( $self->_register );
+
+ $logger->logentry("Modem is alive! (SQ=".$self->_getSQ()."dBm)") if $logger;
+ return 0;
+}
+
+
+
+sub _getSMS {
+ my ($self) = @_;
+ my $result = [];
+ my $msgcount=0;
+
+ # to pdu mode
+ $self->_at("AT+CMGF=0\r", $__TO);
+
+ # loop from 1 to cfg->memorylimit to get messages
+ my $limit = $self->{cfg}->{"memorylimit"} || 10;
+ for (my $i=1; $i<=$limit; $i++) {
+ my $res = $self->_at( "AT+CMGR=$i\r", $__TO );
+
+ next if ($res=~/ERROR/ig);
+
+ # find +CMGR: ..,..,..
+ my $cmgr_start = index( $res, "+CMGR:" );
+ my $cmgr_stop = index( $res, "\r", $cmgr_start );
+ my $cmgr = substr($res, $cmgr_start, $cmgr_stop - $cmgr_start);
+
+ # find PDU string
+ my $pdu_start = $cmgr_stop + 2;
+ my $pdu_stop = index( $res, "\r", $pdu_start );
+ my $pdu = substr($res, $pdu_start, $pdu_stop - $pdu_start);
+
+ # message settings
+ $cmgr=~/\+CMGR:\s+(\d*),(\d*),(\d*)/;
+
+ my $msg = $result->[$msgcount++] = {};
+ $msg->{'ID'} = $i;
+ $msg->{'STAT'} = $1;
+ $msg->{'LENGTH'} = $3;
+ $msg->{'MSG'}.=$pdu;
+ }
+ return $result;
+}
+
+
+sub _delete {
+ my ($self, $id) = @_;
+
+ my $l=$self->{log};
+
+ $self->_at("AT+CMGF=1\r", $__TO);
+ my $res = $self->_at("AT+CMGD=".$id."\r", $__TO);
+ # my $res="OK";
+
+ # print "DELETE $res\n";
+
+ if ($res=~/OK/) {
+ } else {
+ exit(0);
+ }
+}
+
+
+sub _at {
+ my ($self, $at, $timeout, $expect) = @_;
+
+ my $ob = $self->{port};
+
+ $ob->purge_all;
+ $ob->write("$at");
+ $ob->write_drain;
+
+ my $in = "";
+ my $max = 500;
+ my $count = 0;
+ my $found = 0;
+ my $to_read;
+ my $readcount;
+ my $input;
+ my $counter=0;
+
+ # print "$at\n";
+
+ do {
+ select(undef,undef,undef, 0.1);
+ $to_read = $max - $count;
+
+ ($readcount, $input) = $ob->read($to_read);
+ $in.=$input;
+ $count+=$readcount;
+
+ if ( ($in=~/OK\r\n/) || ($in=~/ERROR\r\n/) ) {
+ $found=1;
+ }
+
+ if ( $expect ne "" ) {
+ if ( index($in, $expect) > -1 ) {
+ $found=1;
+ }
+ }
+ $counter++;
+
+
+ } while ( ($found==0) && ($counter<$timeout) );
+
+ select(undef,undef,undef, 0.1);
+
+ $to_read=$max-$count;
+ ($readcount, $input) = $ob->read($to_read);
+
+ $in.=$input;
+
+ # print "# $in #\n";
+
+ return $in;
+}
+
+sub _getSQ {
+ my ($self) = @_;
+ my $res = $self->_at("AT+CSQ\r", $__TO);
+ $res=~/\+CSQ:\s+(\d+),(\d+)/igs;
+ $res=$1;
+
+ my $dbm;
+
+ # transform into dBm
+ $dbm = -113 if ($res == 0);
+ $dbm = -111 if ($res == 1);
+ $dbm = -109 + 2*($res-2) if (($res >= 2) && ($res <=30));
+ $dbm = 0 if ($res == 99);
+
+ return $dbm;
+}
+
+# Register modem: PIN, CSCA, Wait for network connectivity for a certain period
+sub _register {
+ my ($self) = @_;
+ my $res;
+
+ my $logger = $self->{'__LOGGER__'};
+
+ my $cfg = $self->{cfg};
+
+ my $pc = $cfg->{"pin-code"};
+ my $csca = $cfg->{"csca"};
+
+ $logger->logentry( "Checking if modem ready .." ) if $logger;
+
+ # I should speed this 'registering' up ...
+ # ... actually I should have a command that tells me
+ # ready to send|receive ...
+ #
+ # $res = $self->_at("AT+MAGIC?\r", $__TO);
+ # return -1 if ( $res=~/OK/ );
+
+ # 1. Do we need to give in the PIN ?
+ $res = $self->_at("AT+CPIN?\r", $__TO, "+CPIN:");
+
+ if ( $res=~/\+CPIN: SIM PIN/i ) {
+ # Put PIN
+ $logger->logentry("Modem needs PIN ...") if $logger;
+ $self->_at("AT+CPIN=\"$pc\"\r", $__TO);
+
+ # Check PIN
+ $res = $self->_at("AT+CPIN?\r", $__TO , "+CPIN:");
+ if( $res!~/\+CPIN: READY/i ) {
+ # somethings wrong here!
+ $logger->logentry("Modem did not accept PIN!") if $logger;
+ return 0;
+ }
+ }
+
+ # 2. Set the CSCA
+ $res = $self->_at("AT+CSCA=\"$csca\"\r", $__TO);
+ $res = $self->_at("AT+CSCA=\"$csca\"\r", $__TO);
+
+ # 3. Wait for registration on network
+ my $registered = 0;
+ my $stime = time;
+ do {
+ $res = $self->_at("AT+CREG?\r", $__TO , "+CREG");
+ if ( $res=~/1/i ) {
+ $registered++;
+ }
+ }
+ until ( $registered || ((time - $stime) > 10 ) );
+
+ if( $registered==0 ) {
+ $logger->logentry("Modem could not register on network!") if $logger;
+ return 0;
+ }
+
+ # 4. Wait until SIM chip is ready (give it 3 mins) - by checking +cmgf
+ my $simReady = 0;
+ $stime = time;
+ do {
+ $res = $self->_at("AT+CMGF=0\r", $__TO , "+CMGF");
+ if ( $res=~/OK/i ) {
+ $simReady++;
+ } else {
+ sleep 1;
+ }
+ }
+ until ( $simReady || ((time - $stime) > 180 ) );
+
+ if( $simReady==0 ) {
+ $logger->logentry("SIM will not respond!") if $logger;
+ return 0;
+ }
+
+ # All went fine!
+
+ return -1;
+}
+1;
+
+=head1 NAME
+
+GSM::SMS::Transport::Serial
+
+=head1 DESCRIPTION
+
+This class implements a serial transport. It uses Device::SerialPort to communicate to the modem. At the moment the modem that I recommend is the WAVECOM modem. This module is in fact the root of the complete package, as the project started as a simple perl script that talked to a Nokia6110 connected via a software modem ( as that model did not implement standard AT ) on a WINNT machine, using Win32::SerialPort and Activestate perl. Also tested with the M20 modem module from SIEMENS.
+
+I first used the Nokia6110, then moved to the Falcom A1 GSM modem, then moved to the SIEMENS M20 and then moved to the WAVECOM series. Both M20 and WAVECOM worked best, but I could crash the firmware in the M20 by sending some fake PDU messages.
+
+=head1 ISSUES
+
+The Device::SerialPort puts a big load on your system (active polling).
+
+The initialisation does not always work well and sometimes you have to
+initialize your modem manually using minicom or something like that.
+
+ >minicom -s
+ AT
+ AT+CPIN?
+ AT+CPIN="nnn"
+ AT+CSCA?
+ AT+CSCA="+32475161616"
+
++CPIN puts the pin-code in the modem; Be carefull, only 3 tries and then you have to provide the PUK code etc ...
+
++CSCA sets the service center address
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::Transport::Transport;
+
+$VERSION = '0.1';
+
+# Abstract class defines the methods a transport interface must implement
+##########################################################################
+
+# constructor
+sub new($$) {
+
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+ $self->{cfg} = shift;
+
+ bless($self, $class);
+ return $self;
+}
+
+# abstract method definitions
+#
+
+# Send a (PDU encoded) message
+sub send($$) {};
+
+# Receive a PDU encoded message
+# $ is a ref to a PDU string
+# return
+# 0 if PDU received
+# -1 if no message pending
+sub receive($) {};
+
+# Close
+sub close() {};
+
+# A ping command .. just return an informative string on success
+sub ping() {};
+
+# get_config_parameters ... return the config parameters I expect here.
+sub get_config_parameters() {};
+
+# can we send to the following number?
+sub has_valid_route($) {};
+
+1;
+
+=head1 NAME
+
+GSM::SMS::Transport::Transport
+
+Abstract class for the transport modules. Transport modules inherit from this class.
+
+=head1 AUTHOR
+
+Johan Van den Brande <johan@vandenbrande.com>
--- /dev/null
+package GSM::SMS::Transport::XmlRpc;
+
+#
+# HTTP for Remote Serial modem
+#
+
+use GSM::SMS::Transport::Transport;
+@ISA = qw(GSM::SMS::Transport::Transport);
+
+$VERSION = '0.1';
+
+# All the parameters I need to run
+my @config_vars = qw(
+ name
+ match
+ spoolout
+ );
+
+# Send a (PDU encoded) message
+sub send {
+ my ($self, $msisdn, $pdu) = @_;
+
+ # print "send...";
+ $self->_add_to_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
+ # print "\n";
+ return 0;
+};
+
+# Receive a PDU encoded message
+# $ is a ref to a PDU string
+# return
+# 0 if PDU received
+# -1 if no message pending
+sub receive {
+ my ($self, $pduref) = @_;
+
+ return -1;
+};
+
+
+# Close
+sub close {
+ my ($self) = @_;
+}
+
+# A ping command .. just return an informative string on success
+sub ping {
+ my ($self) = @_;
+
+ return "Pong.. XmlRpc transport ok";
+}
+
+
+# give out the needed config paramters
+sub get_config_parameters {
+ my ($self) = @_;
+
+ return @config_vars;
+}
+
+# Do we have a valid route for this msisdn
+sub has_valid_route {
+ my ($self, $msisdn) = @_;
+
+ # print "route";
+
+ foreach my $route ( split /,/, $self->{cfg}->{"match"} ) {
+ # print "($route)";
+ return -1 if $msisdn =~ /$route/;
+ }
+ return 0;
+}
+
+#####################################################################
+# transport specific
+#####################################################################
+sub _add_to_spool {
+ my ($self, $msisdn, $pdu, $dir) = @_;
+ local (*F);
+
+ my $filename = $self->_create_spoolname($msisdn, $pdu);
+
+ # print ">".$dir."/".$filename."\n";
+
+ open F, ">".$dir."/".$filename;
+ print F $pdu;
+ close F;
+}
+
+
+sub _remove_from_spool {
+ my ($self, $msisdn, $pdu, $dir) = @_;
+
+ my $filename = $self->_create_spoolname($msisdn, $pdu);
+ unlink( $dir."/".$filename );
+}
+
+sub _create_spoolname {
+ my ($self, $msisdn, $pdu) = @_;
+
+ $msisdn =~ s/^\+//;
+ my $filename = $msisdn . "_" . $$ . time . substr($pdu,-32);
+ return $filename;
+}
+
+1;
--- /dev/null
+ SMS Slashdot headlines
+ ~~~~~~~~~~~~~~~~~~~~~~
+WHAT
+
+Get your slashdot headlines on your phone.
+Just send a message containing sd to the GSM modem and you
+will receive 1 or more sms messages with the headlines.
--- /dev/null
+#!/usr/bin/perl
+
+
+use lib '../../../..';
+
+
+
+#
+# Use modules
+use LWP::Simple;
+use File::stat;
+use Getopt::Long;
+use GSM::SMS::NBS;
+
+
+#
+# No output buffering
+$|++;
+
+#
+# Get arguments
+my $ARG_TRANSPORTCFG;
+my $ARG_VERBOSE;
+my $ARG_CACHEFILE;
+my $ARG_ACL;
+GetOptions(
+ "transport=s" => \$ARG_TRANSPORTCFG,
+ "verbose" => \$ARG_VERBOSE,
+ "cachefile=s" => \$ARG_CACHEFILE,
+ "acl=s" => \$ARG_ACL
+ );
+
+unless ( $ARG_CACHEFILE && $ARG_ACL && $ARG_TRANSPORTCFG ) {
+print <<EOT;
+Usage: $0 --transport=<file with transport config> --cachefile=<file to keep cache> --acl=<comma seperated msisdn regexs> [--verbose]
+
+ transport File that contains the transport configuration.
+
+ cachefile File to keep latest headlines. Slashdot asks only to hit
+ the server 1 time in an hour, so we obey.
+
+ acl Comma seperated list of regular expression of msisdn
+ to allow the service.
+ e.g.:
+ --acl=".*" : allow everybody
+ --acl="^\+32475,^\+32478" : allow these prefixes
+ --acl="^\+32475000000" : allow this number
+
+ verbose Print out info.
+
+ To access /. through a proxy ( bash ):
+ export http_proxy=http://proxy:port
+
+
+EOT
+exit(1);
+}
+
+
+#
+# Configuration
+my $CFG_TIMEOUT = 60*60; # 60 minutes, as asked by slashdot ...
+my @CFG_ACL = split /,/, $ARG_ACL;
+
+
+#
+# Let's go
+verb( join( " ", split( //, "SLASHDOT HEADLINES") ) . "\n\n" );
+
+#
+# Start server
+
+my $nbs = GSM::SMS::NBS->new( $ARG_TRANSPORTCFG );
+
+my $message;
+my $timestamp;
+my $transportname;
+my $port;
+
+while (1) {
+ verb( "waiting for message ..." );
+ # blocking receive
+ $nbs->receive( \$msisdn,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ 1 );
+
+ verb(<<EOT
+
+received a message:
+msisdn: $msisdn
+timestamp: $timestamp
+transport: $transportname
+port: $port
+--------------------------------------------------------------------------
+$message
+--------------------------------------------------------------------------
+EOT
+);
+ # only text messages
+ unless ( $port ) {
+ # acl check
+ if ( grep { $msisdn =~ /$_/ } @CFG_ACL ) {
+ verb( "acl pass\n" );
+ # check for code word
+ if ( $message =~ /^sld/i ) {
+
+ $stats = stat($ARG_CACHEFILE);
+
+ unless ($stats && (time - $stats->mtime) < $CFG_TIMEOUT) {
+ verb( "Getting new SLASHDOT headlines\n" );
+ getstore('http://www.slashdot.org/slashdot.xml', $ARG_CACHEFILE);
+ }
+
+ open XML,$ARG_CACHEFILE or die("Cannot open $ARG_CACHEFILE for read: $!");
+ my $data = join "", <XML>;
+ close XML;
+ my $msg="";
+ my @msg;
+ while ($data =~ m#<title>(.*?)<\/title>#gsi) {
+ my $line = "*".$1."\n";
+ if (length($msg.$line)>160 || $msg eq "") {
+ if ($msg ne "") {
+ push @msg, $msg;
+ }
+ $msg="SLASHDOT #pa/#fr\n\n";
+ }
+ $msg.=$line;
+ }
+ push @msg, $msg;
+
+ my $from = sprintf("%02d",$#msg+1);
+ for($i=0;$i<=$#msg;$i++) {
+ my $page = sprintf("%02d",$i+1);
+ $msg[$i]=~s/#pa/$page/;
+ $msg[$i]=~s/#fr/$from/;
+ verb( "=" x 75 . "\n" );
+ verb( $msg[$i] );
+ verb( "." x 75 . "\n\n");
+ $nbs->sendSMSTextMessage( $msisdn, $msg[$i] );
+ }
+ }
+ }
+ }
+}
+exit(0);
+
+#
+# Verbose function
+sub verb {
+ print shift if $ARG_VERBOSE;
+}
--- /dev/null
+##########################################################################
+#
+# example transport config file
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Configure the different transports here.
+# Use this as an example file
+#
+#
+# (c) 1999-2001 Tektonica bvba. Johan Van den Brande
+[Serial]
+ type = Serial
+
+ name = SerialTest
+ pin-code = 6023
+ csca = +32475161616
+ serial-port = /dev/ttyS0
+ baud-rate = 9600
+
+ originator = moboid.com
+
+ match = .*
+ spoolout = /tmp/serial/out
+ spoolin = /tmp/serial/in
+ log = /tmp/theseriallogger.txt
--- /dev/null
+ Example
+ SMART MESSAGING SERVER
+
+INTRODUCTION
+
+Today I see in every magazine, targetted to the average person, advertisements for ringing tones and logo downloads. You have to call a telephone number (0900-principle) and then by acting upon a voice menu you can download a certain ringing tone or graphic. Because this package does not implements a voice box we will use an SMS message to 'order' a ringing tone or groupgraphic. Anyway, if you are interested in implementing such a service using this package, you can look at the Modem::VBox module.
+
+Of course, this is just intented as a demo for the GSM::SMS package. As such, the implementation can be a bit crude. But it should be functional anyway...
+
+To receive a message, you have to send a SMS message that contains which ringing tone or graphic you want to receive. Such command messages consist of a 6 number string. Thge first 2 numbers indicate the type of resource you want to receive; 10 for a group graphic 20 for a ringing tone. The next 4 digits tell the server which file you actually want to receive.
+
+The program maps the first 2 numbers to a directory, inside this directory we find files with a filename like:
+
+nnnn.rtttl
+or
+nnnn.gif
+
+Just as you thought, thse 'nnnn' are the 4 last digits in the incoming command message.
+
+The program picks up the file and sends it back to the commands message originating address.
+
+USAGE
+
+./sms --config=<config file>
+
+CONFIG FILE FORMAT
+
+The following directives can be used in the config file.
+
+access=^\+32475,^\+32478
+ comma seperated access list. The incoming phone number must match
+ one of these regular expressions to be allowed access.
+
+rtttldir=./media/rtttl
+ directory where to find ringing tones.
+
+rtttlprefix=20
+ prefix to use in the 6 digit number to map a command to a ringing tone.
+
+groupgraphicdir=./media/groupgraphics
+ directory where to find group graphics
+
+groupgraphicprefix=10
+ prefix to use in the 6 digit number to map a command to a group graphic.
+
+transportconfig=./transport.conf
+ transport configuration file to use
+
+log=./log.txt
+ log file to keep date, time, originating phonenumber and file requested. Can be used to keep accountancy.
--- /dev/null
+AxelF:d=4,o=5,b=125:32p,8g,8p,16a#.,8p,16g,16p,16g,8c6,8g,8f,8g,8p,16d.6,8p,16g,16p,16g,8d#6,8d6,8a#,8g,8d6,8g6,16g,16f,16p,16f,8d,8a#,2g,p,16f6,8d6,8c6,8a#,g,8a#.,16g,16p,16g,8c6,8g,8f,g,8d.6,16g,16p,16g,8d#6,8d6,8a#,8g,8d6,8g6,16g,16f,16p,16f,8d,8a#,2g
--- /dev/null
+Bolero:d=4,o=5,b=80:c6,8c6,16b,16c6,16d6,16c6,16b,16a,8c6,16c6,16a,c6,8c6,16b,16c6,16a,16g,16e,16f,2g,16g,16f,16e,16d,16e,16f,16g,16a,g,g,16g,16a,16b,16a,16g,16f,16e,16d,16e,16d,8c,8c,16c,16d,8e,8f,d,2g
--- /dev/null
+Halloween:d=4,o=5,b=180:8d6,8g,8g,8d6,8g,8g,8d6,8g,8d#6,8g,8d6,8g,8g,8d6,8g,8g,8d6,8g,8d#6,8g,8c#6,8f#,8f#,8c#6,8f#,8f#,8c#6,8f#,8d6,8f#,8c#6,8f#,8f#,8c#6,8f#,8f#,8c#6,8f#,8d6,8f#
--- /dev/null
+#!/usr/bin/perl
+
+use lib '../../../..';
+
+#
+# Load some modules
+use GSM::SMS::Log;
+use GSM::SMS::Config;
+use GSM::SMS::NBS;
+use Getopt::Long;
+
+#
+# No output buffering
+$|++;
+
+
+
+#
+# Arguments
+my $ARG_CONFIG;
+my $ARG_VERBOSE;
+GetOptions(
+ "config:s" => \$ARG_CONFIG,
+ "verbose" => \$ARG_VERBOSE
+ );
+
+unless ( $ARG_CONFIG ) {
+print <<EOT;
+Usage: $0 --config=<config file> [--verbose]
+EOT
+exit(1);
+}
+
+
+
+#
+# Read sms config file
+my $CONFIG;
+die "Can't read sms config file: $ARG_CONFIG!\n"
+ unless ($CONFIG = read_config( $ARG_CONFIG ));
+
+
+
+#
+# Get parameters
+my $config = get_config($CONFIG, 'default');
+my $CFG_CONFIG = $config->{"transportconfig"};
+my $CFG_LOG = $config->{"log"};
+my $CFG_GROUPGFXDIR = $config->{"groupgraphicdir"};
+my $CFG_GROUPGFXPREFIX = $config->{"groupgraphicprefix"};
+my $CFG_RTTTLDIR = $config->{"rtttldir"};
+my $CFG_RTTTLPREFIX = $config->{"rtttlprefix"};
+my $CFG_ACL = $config->{"access"};
+my @CFG_ACL = split /,/, $CFG_ACL;
+
+verb(<<EOT
+SMART MESSAGING SERVER
+
+coming up with settings:
+ transportconfig $CFG_CONFIG
+ log $CFG_LOG
+ groupgraphicdir $CFG_GROUPGFXDIR
+ groupgraphicprefix $CFG_GROUPGFXPREFIX
+ rtttldir $CFG_RTTTLDIR
+ rtttlprefix $CFG_RTTTLPREFIX
+ acl $CFG_ACL
+
+EOT
+);
+
+
+
+#
+# Initialize
+my $nbs = GSM::SMS::NBS->new( $CFG_CONFIG );
+
+my $msisdn;
+my $message;
+my $timestamp;
+my $transportname;
+my $port;
+
+my $logger = GSM::SMS::Log->new( $CFG_LOG );
+
+
+
+#
+# Start server ...
+while (1) {
+ verb( "waiting for message ..." );
+ # blocking receive
+ $nbs->receive( \$msisdn,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ 1 );
+
+ verb(<<EOT
+
+received a message:
+msisdn: $msisdn
+timestamp: $timestamp
+transport: $transportname
+port: $port
+--------------------------------------------------------------------------
+$message
+--------------------------------------------------------------------------
+EOT
+);
+ # only text messages
+ unless ( $port ) {
+ # acl check
+ if ( grep { $msisdn =~ /$_/ } @CFG_ACL ) {
+ verb( "acl pass\n" );
+ $message =~ /(\d{2})(\d{4})/;
+ my $prefix = $1;
+ my $resource = $2;
+
+ # handle ringing tones
+ if ( $prefix eq $CFG_RTTTLPREFIX ) {
+ verb( "rtttl\n" );
+ my $file = $CFG_RTTTLDIR . '/' . $resource . '.rtttl';
+ verb( "file $file " );
+ if ( -e $file ) {
+ verb( "is a valid resource!\n" );
+ local (*F);
+ open F, $file;
+ my $rtttl_string = join "", <F>;
+
+ close F;
+ $nbs->sendRTTTL( $msisdn, $rtttl_string );
+ $logger->logentry( sprintf("\"$message\"\t\"$msisdn\"") );
+ }
+ }
+
+ # handle group graphics
+ if ( $prefix eq $CFG_GROUPGFXPREFIX ) {
+ verb( "groupgfx\n" );
+ my $file = $CFG_GROUPGFXDIR . '/' . $resource . '.gif';
+ verb( "file $file " );
+ if ( -e $file ) {
+ verb( "is a valid resource!\n" );
+ $nbs->sendGroupGraphic_file( $msisdn, $file );
+ $logger->logentry( sprintf("\"$message\"\t\"$msisdn\"") );
+ }
+ }
+ }
+ }
+ verb( "\n" );
+}
+exit(0);
+
+#
+# Verbose function
+sub verb {
+ print shift if $ARG_VERBOSE;
+}
--- /dev/null
+##########################################################################
+#
+# example sms config file
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# (c) 1999-2001 Johan Van den Brande
+
+
+ # Comma seperated access list. The incoming phone number must match
+ # one of these regular expressions to be allowed access.
+ access=^\+32475567606
+
+ # Directory where to find ringing tones.
+ rtttldir=./media/rtttl
+
+ # Prefix to use in the 6 digit number to map a command to a ringing tone.
+ rtttlprefix=20
+
+ # Directory where to find group graphics
+ groupgraphicdir=./media/groupgraphics
+
+ # Prefix to use in the 6 digit number to map a command to a group graphic.
+ groupgraphicprefix=10
+
+ # Transport configuration file to use
+ transportconfig=./transport.conf
+ # Log file to keep date, time, originating phonenumber and file requested.
+ # Can be used to keep accountancy.
+ log=./log.txt
--- /dev/null
+##########################################################################
+#
+# example transport config file
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Configure the different transports here.
+# Use this as an example file
+#
+#
+# (c) 1999-2001 Tektonica bvba. Johan Van den Brande
+[Serial]
+ type = Serial
+
+ name = SerialTest
+ pin-code = 6023
+ csca = +32475161616
+ serial-port = /dev/ttyS0
+ baud-rate = 9600
+
+ originator = moboid.com
+
+ match = .*
+ spoolout = /tmp/serial/out
+ spoolin = /tmp/serial/in
+ log = /tmp/theseriallogger.txt
--- /dev/null
+* Write up more tests in /t/
+ - Each transport
+ - PDU
+ - OTA stuff
+
+* Automate configuration when installing (PIN-code, port etc ...)
+* Automate the test in /t/ also in function of choosing the config parameters
+* Clean up and refine the logging. COnsolidate this in one logfile for the
+ complete system
+
+ - Log::Agent: Need to investigate
+
+* Try to investigate the possibility to build in a QUEUE ( cache?)
+
+ - Transport Spool would be mandatory ( super class transport )
+ - Use Cache::File ??? -> probably Cache::Cache!
+ - When system crashes, should be able to pick them up
+
+* MCube support and Clickatel support
+* Delivery report support (message status)
+ - How to give a message an ID (possible link to caching here)
+ - How to communicate the message ID back? Probably need to
+ change NBS.pm interface, because a message ID must be brought back
+ - Probably Message.pm class that has a ->body, ->status method?
+ - SMS-SUBMIT-REPORT, SMS-DELIVER-REPORT PDU types
+ !! OBJECTIFY PDU.pm !!
+
+* Refactor Transport.pm -> error message needs to be included in which
+ stack fails!
+ - Look at cache and ID ... integrate closer!
+
+* EMS ( Enhanced Message System )
+ - Specs
+ - Forms possible?
--- /dev/null
+Country;Operator/Network;Country code;Network code
+Albania;Albanian Mobile Comms;276;01
+Algeria;Albanian Mobile Comms;603;01
+Andorra;S.T.A. MobilAnd;213;03
+Armenia;ArmenTel;283;01
+Australia;Telstra Mobile Comms;505;01
+Australia;Cable + Wireless Optus;505;02
+Australia;Vodafone;505;03
+Austria;MobilKom Austria A1;232;01
+Austria;max.mobil.Telekoms Service;232;03
+Austria;Connect Austria One;232;05
+Azerbaijan;Azercell Telekom B.M.;400;01
+Azerbaijan;J.V.Bakcell GSM 2000;400;02
+Bahrain;Batelco;426;01
+Bangladesh;Grameen Phone;470;01
+Bangladesh;Sheba Telecom;470;19
+Belgium;Belgacom Mobile Proximus;206;01
+Belgium;KPN Orange;206;20
+Belgium;Mobistar;206;10
+Bosnia Herzegovina;Cronet;218;01
+Bosnia Herzegovina;PTT Bosnia;218;19
+Bosnia Herzegovina;PE PTT BIH;218;90
+Botswana;Mascom Wireless;652;01
+Brunei Darussalam;Jabatan Telekom;528;01
+Brunei Darussalam;DST Communications;528;11
+Bulgaria;MobilTel AD;284;01
+Cambodia;CamGSM;456;01
+Cambodia;Cambodia Samart Comms;456;02
+Cameroon;PTT Cameroon Cellnet;624;01
+Canada;Microcell Connexions Inc;302;37
+Cape Verde;Cabo Verde Telecom;625;01
+Chile;Entel Telefonia Movil;730;01
+Chile;Entel PCS Telecom.;730;10
+China;China Telecom GSM;460;00
+China;China Unicom GSM;460;01
+China;Liaoning PPTA;460;02
+Cote d'Ivoire;Comstar Cellular Network;612;01
+Cote d'Ivoire;Telecel;612;02
+Cote d'Ivoire;S.I.M Ivoiris;612;03
+Cote d'Ivoire;Loteny Telecom Telecel;612;05
+Croatia;Croatian Telecoms Cronet;219;01
+Croatia;Vipnet;219;10
+Cyprus;Cyprus Telecoms Authority;280;01
+Czech Republic;RadioMobil;230;01
+Czech Republic;EuroTel Praha;230;02
+Czech Republic;SPT Telecom;230;03
+Denmark;Tele-Danmark Mobil;238;01
+Denmark;Sonofon;238;02
+Denmark;Telia Denmark;238;20
+Denmark;Mobilix;238;30
+Egypt;MobiNil;602;01
+Egypt;Misrfone Telecom. Click;602;02
+Estonia;Estonian Mobile Telephone;248;01
+Estonia;Radiolinja Eesti;248;02
+Estonia;Q GSM;248;03
+Ethiopia;Ethiopian Telecoms Auth.;636;01
+Fiji;Vodafone Fiji;542;01
+Finland;Telia Finland;244;03
+Finland;Radiolinja;244;05
+Finland;Alands Mobiltelefon;244;05
+Finland;Finnet Group;244;09
+Finland;Sonera Corporation;244;91
+France;France Telecom Itineris;208;01
+France;SFR;208;10
+France;Bouygues Telecom;208;20
+French Polynesia;Tikiphone;547;20
+French West Indies;France Caraibe Ameris;340;01
+Georgia;Geocell Limited;282;01
+Georgia;Magti GSM;282;02
+Germany;D1 DeTe Mobil;262;01
+Germany;D2 Mannesmann Mobilfunk;262;02
+Germany;E-Plus Mobilfunk;262;03
+Germany;Viag Interkom;262;07
+Ghana;ScanCom;620;01
+Gibraltar;Gibraltar Telecoms Gibtel;266;01
+Greece;Cosmote;202;01
+Greece;Panafon;202;05
+Greece;Telestet;202;10
+Greenland;Tele Greenland;290;01
+Guinea;Sotelgui Lagui;611;02
+Hong Kong;Hong Kong Telecom CSL;454;00
+Hong Kong;Hutchison Telecom;454;04
+Hong Kong;SmarTone Mobile Comms;454;06
+Hong Kong;New World PCS;454;10
+Hong Kong;Peoples Telephone;454;12
+Hong Kong;Mandarin Com. Sunday;454;16
+Hong Kong;Pacific Link;454;18
+Hong Kong;P Plus Comm;454;22
+Hungary;Pannon GSM;216;01
+Hungary;Westel 900 GSM Mobile;216;30
+Iceland;Iceland Telecom Siminn;274;01
+Iceland;TAL hf;274;02
+India;TATA Cellular;404;07
+India;Bharti Cellular Telecom Airtel;404;10
+India;Sterling Cellular Essar;404;11
+India;Escotel Mobile Comms;404;12
+India;Modi Telstra Modicom;404;14
+India;Aircel Digilink Essar Cellph.;404;15
+India;Hutchison Max Touch;404;20
+India;BPL Mobile;404;21
+India;BPL USWest Cellular;404;27
+India;Usha Martin Tel. Command;404;30
+India;Mobilenet;404;31
+India;SkyCell Communications;404;40
+India;RPG MAA;404;41
+India;Srinivas Cellcom;404;42
+Indonesia;PT. Satelindo;510;01
+Indonesia;Telkomsel;510;10
+Indonesia;PT. Excelcomindo Excelcom;510;11
+Iran;TCI;432;11
+Iraq;Iraq Telecom;418;01
+Ireland;Eircell;272;01
+Ireland;Esat Digifone;272;02
+Ireland;Meteor;272;03
+Israel;Partner Communications;425;01
+Italy;Telecom Italia Mobile TIM;222;01
+Italy;Omnitel Pronto;222;10
+Italy;Wind Telecomunicazioni;222;88
+Jordan;J.M.T.S Fastlink;416;01
+Kuwait;Mobile Telecoms MTCNet;419;02
+Kyrgyz Republic;Bitel;437;01
+Lao;Lao Shinawatra Telecom;457;01
+Latvia;Latvian Mobile Tel.;247;01
+Latvia;BALTCOM GSM;247;02
+Lebanon;FTML Cellis;415;01
+Lebanon;LibanCell;415;03
+Lesotho;Vodacom;651;01
+Liberia;Omega Communications;618;01
+Lithuania;Omnitel;246;01
+Lithuania;UAB Bite GSM;246;02
+Luxembourg;P+T LUXGSM;270;01
+Luxembourg;Millicom Tango GSM;270;77
+Macau;C.T.M. TELEMOVEL+;455;01
+Macedonia;Macedonian Tel. MobiMak;294;01
+Madagascar;Madacom;646;01
+Madagascar;SMM Antaris;646;02
+Madagascar;Sacel;646;03
+Malawi;Telekom Network Callpoint;650;01
+Malaysia;My BSB;502;02
+Malaysia;Binariang;502;03
+Malaysia;Binariang Comms. Maxis;502;12
+Malaysia;Telekom Cellular TM Touch;502;13
+Malaysia;DiGi Telecommunications;502;16
+Malaysia;Time Wireless Adam;502;17
+Malaysia;Celcom;502;19
+Malta;Vodafone;278;01
+Mauritius;Cellplus Mobile Comms;617;01
+Moldova;Voxtel;259;01
+Morocco;Itissalat Al-Maghrib IAM;604;01
+Mozambique;Telecom de Mocambique;634;01
+Namibia;MTC;649;01
+Netherlands;Libertel;204;04
+Netherlands;KPN Telecom;204;08
+Netherlands;Telfort;204;12
+Netherlands;Ben;204;16
+Netherlands;Dutchtone;204;20
+New Caledonia;OPT Mobilis;546;01
+New Zealand;Vodafone;530;01
+New Zealand;Telecom NZ;530;03
+New Zealand;Telstra;530;04
+Norway;Telenor Mobil;242;01
+Norway;NetCom GSM;242;02
+Oman;General Telecoms;422;02
+Pakistan;Mobilink;410;01
+Papua New Guinea;Pacific Mobile Comms;310;01
+Philippines;Isla Comms;515;01
+Philippines;Globe Telecom;515;02
+Philippines;Smart Communications;515;03
+Poland;Polkomtel PLUS GSM;260;01
+Poland;ERA GSM;260;02
+Poland;IDEA Centertel;260;03
+Portugal;Telecel Communicacoes;268;01
+Portugal;Optimus Telecom.;268;03
+Portugal;Telecom Moveis Nac. TMN;268;06
+Qatar;Q-Tel QATARNET;427;01
+Reunion;Societe Reunionnaise SRR;647;10
+Romania;MobiFon CONNEX GSM;226;01
+Romania;Mobil Rom DIALOG;226;10
+Russia;MTS Moscow;250;01
+Russia;North-West GSM;250;02
+Russia;Siberian Cellular;250;05
+Russia;Zao Smarts;250;07
+Russia;Don Telecom;250;10
+Russia;New Telephone Company;250;12
+Russia;Far-Eastern Cellular;250;12
+Russia;Kuban GSM;250;13
+Russia;Uratel;250;39
+Russia;North Caucasian GSM;250;44
+Russia;KB Impuls BeeLine;250;99
+Rwanda;Rwandacell;635;10
+Saudi Arabia;Ministry of PTT Al Jawal;420;01
+Saudi Arabia;Electronics App' Est. EAE;420;07
+Senegal;Sonatel ALIZE;608;01
+Seychelles;Seychelles Cellular Services;633;01
+Seychelles;Telecom AIRTEL;633;10
+Singapore;Singapore Tel. GSM 900;525;01
+Singapore;Singapore Tel. GSM 1800;525;02
+Singapore;MobileOne Asia;525;03
+Slovak Republic;Globtel GSM;231;01
+Slovak Republic;EuroTel GSM;231;02
+Slovenia;Si.mobil;293;40
+Slovenia;Mobitel;293;41
+South Africa;Vodacom;655;01
+South Africa;MTN;655;10
+Spain;Airtel Movil;214;01
+Spain;Retevision Movil;214;03
+Spain;Telefonica Moviles Movistar;214;07
+Sri Lanka;MTN Networks Dialog GSM;413;02
+Sudan;Mobile Telephone Company;634;01
+Sweden;Telia Mobitel;240;01
+Sweden;Comviq GSM;240;07
+Sweden;Europolitan;240;08
+Switzerland;Swisscom NATEL;228;01
+Switzerland;diAx Mobile;228;02
+Switzerland;Orange;228;03
+Syria;Syrian Telecom Est. MOBILE;417;09
+Taiwan;Far EasTone Telecoms;466;01
+Taiwan;TUNTEX Telecom;466;06
+Taiwan;KG Telecom;466;88
+Taiwan;Chunghwa Telecom;466;92
+Taiwan;Mobitai Communications;466;93
+Taiwan;Pacific Cellular TWNGSM;466;97
+Taiwan;TransAsia Telecoms;466;99
+Tanzania;Tritel;640;01
+Thailand;Advanced Info Service AIS;520;01
+Thailand;WCS IQ;520;10
+Thailand;Total Access Worldphone;520;18
+Thailand;Digital Phone HELLO;520;23
+Togo;Togo Telecom TOGO CELL;615;01
+Tunisia;Tunisie Telecom Tunicell;605;02
+Turkey;Turk Telekom Turkcell;286;01
+Turkey;TELSIM Mobil Telekom.;286;02
+U.S.A.;APC Sprint Spectrum;310;02
+U.S.A.;Wireless 2000 Telephone;310;11
+U.S.A.;BellSouth Mobility DCS;310;15
+U.S.A.;Omnipoint Communications;310;16
+U.S.A.;Pacific Bell Wireless;310;17
+U.S.A.;Western Wireless Voicestream;310;26
+U.S.A.;Powertel;310;27
+U.S.A.;Aerial Communications;310;31
+U.S.A.;Iowa Wireless Services;310;77
+Uganda;Celtel Cellular;641;01
+Uganda;MTN Uganda;641;10
+Ukraine;Ukrainian Mobile Comms;255;01
+Ukraine;Ukrainian Radio Systems;255;02
+Ukraine;Kyivstar GSM;255;03
+Ukraine;Golden Telecom;255;05
+United Arab Emirates;UAE ETISALAT-G1;424;01
+United Arab Emirates;UAE ETISALAT-G2;424;02
+United Kingdom;Cellnet;234;10
+United Kingdom;Vodafone;234;15
+United Kingdom;One 2 One;234;30
+United Kingdom;Orange;234;33
+United Kingdom;Jersey Telecom GSM;234;50
+United Kingdom;Guernsey Telecoms GSM;234;55
+United Kingdom;Manx Telecom Pronto GSM;234;58
+Uzbekistan;Buztel;434;01
+Uzbekistan;Daewoo Unitel;434;04
+Uzbekistan;Coscom;434;05
+Venezuela;Infonet;734;01
+Vietnam;MTSC;452;01
+Vietnam;DGPT;452;02
+Yugoslavia;MOBTEL;220;01
+Yugoslavia;ProMonte GSM;220;02
+Zambia;Zamcell;645;01
+Zimbabwe;NET*ONE;648;01
+Zimbabwe;Telecel;648;03
--- /dev/null
+ SMS Slashdot headlines
+ ~~~~~~~~~~~~~~~~~~~~~~
+WHAT
+
+Get your slashdot headlines on your phone.
+Just send a message containing sd to the GSM modem and you
+will receive 1 or more sms messages with the headlines.
--- /dev/null
+#!/usr/bin/perl
+
+#
+# Use modules
+use LWP::Simple;
+use File::stat;
+use Getopt::Long;
+use GSM::SMS::NBS;
+
+
+#
+# No output buffering
+$|++;
+
+#
+# Get arguments
+my $ARG_TRANSPORTCFG;
+my $ARG_VERBOSE;
+my $ARG_CACHEFILE;
+my $ARG_ACL;
+GetOptions(
+ "transport=s" => \$ARG_TRANSPORTCFG,
+ "verbose" => \$ARG_VERBOSE,
+ "cachefile=s" => \$ARG_CACHEFILE,
+ "acl=s" => \$ARG_ACL
+ );
+
+unless ( $ARG_CACHEFILE && $ARG_ACL && $ARG_TRANSPORTCFG ) {
+print <<EOT;
+Usage: $0 --transport=<file with transport config> --cachefile=<file to keep cache> --acl=<comma seperated msisdn regexs> [--verbose]
+
+ transport File that contains the transport configuration.
+
+ cachefile File to keep latest headlines. Slashdot asks only to hit
+ the server 1 time in an hour, so we obey.
+
+ acl Comma seperated list of regular expression of msisdn
+ to allow the service.
+ e.g.:
+ --acl=".*" : allow everybody
+ --acl="^\+32475,^\+32478" : allow these prefixes
+ --acl="^\+32475000000" : allow this number
+
+ verbose Print out info.
+
+ To access /. through a proxy ( bash ):
+ export http_proxy=http://proxy:port
+
+
+EOT
+exit(1);
+}
+
+
+#
+# Configuration
+my $CFG_TIMEOUT = 60*60; # 60 minutes, as asked by slashdot ...
+my @CFG_ACL = split /,/, $ARG_ACL;
+
+
+#
+# Let's go
+verb( join( " ", split( //, "SLASHDOT HEADLINES") ) . "\n\n" );
+
+#
+# Start server
+
+my $nbs = GSM::SMS::NBS->new( $ARG_TRANSPORTCFG );
+
+die "Sorry ... could not activate NBS stack ($!) ... check transport logfiles\n"
+ unless $nbs;
+
+my $message;
+my $timestamp;
+my $transportname;
+my $port;
+
+while (1) {
+ verb( "waiting for message ..." );
+ # blocking receive
+ $nbs->receive( \$msisdn,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ 1 );
+
+ verb(<<EOT
+
+received a message:
+msisdn: $msisdn
+timestamp: $timestamp
+transport: $transportname
+port: $port
+--------------------------------------------------------------------------
+$message
+--------------------------------------------------------------------------
+EOT
+);
+ # only text messages
+ unless ( $port ) {
+ # acl check
+ if ( grep { $msisdn =~ /$_/ } @CFG_ACL ) {
+ verb( "acl pass\n" );
+ # check for code word
+ if ( $message =~ /^sld/i ) {
+
+ $stats = stat($ARG_CACHEFILE);
+
+ unless ($stats && (time - $stats->mtime) < $CFG_TIMEOUT) {
+ verb( "Getting new SLASHDOT headlines\n" );
+ getstore('http://www.slashdot.org/slashdot.xml', $ARG_CACHEFILE);
+ }
+
+ open XML,$ARG_CACHEFILE or die("Cannot open $ARG_CACHEFILE for read: $!");
+ my $data = join "", <XML>;
+ close XML;
+ my $msg="";
+ my @msg;
+ while ($data =~ m#<title>(.*?)<\/title>#gsi) {
+ my $line = "*".$1."\n";
+ if (length($msg.$line)>160 || $msg eq "") {
+ if ($msg ne "") {
+ push @msg, $msg;
+ }
+ $msg="SLASHDOT #pa/#fr\n\n";
+ }
+ $msg.=$line;
+ }
+ push @msg, $msg;
+
+ my $from = sprintf("%02d",$#msg+1);
+ for($i=0;$i<=$#msg;$i++) {
+ my $page = sprintf("%02d",$i+1);
+ $msg[$i]=~s/#pa/$page/;
+ $msg[$i]=~s/#fr/$from/;
+ verb( "=" x 75 . "\n" );
+ verb( $msg[$i] );
+ verb( "." x 75 . "\n\n");
+ if ($nbs->sendSMSTextMessage( $msisdn, $msg[$i] )) {
+ verb("!ERROR SENDING! *check logfile*\n");
+ }
+ }
+ }
+ }
+ }
+}
+exit(0);
+
+#
+# Verbose function
+sub verb {
+ print shift if $ARG_VERBOSE;
+}
--- /dev/null
+##########################################################################
+#
+# example transport config file
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Configure the different transports here.
+# Use this as an example file
+#
+#
+# (c) 1999-2001 Tektonica bvba. Johan Van den Brande
+[Serial]
+ type = Serial
+
+ name = SerialTest
+ pin-code = 6023
+ csca = +32475161616
+ serial-port = /dev/ttyS0
+ baud-rate = 9600
+
+ originator = moboid.com
+
+ match = .*
+ spoolout = /tmp/serial/out
+ spoolin = /tmp/serial/in
+ log = /tmp/theseriallogger.txt
+
+ # 10 for Wavecom | 15 for Siemens C25
+ memorylimit = 10
+
+#[NovelSoft]
+# type = NovelSoft
+#
+# proxy = http://proxy.telenet.be:8080
+# userid = <get your own at http://www.sms-wap.com>
+# password = <get your own at http://www.sms-wap.com>
+# originator = moboid.com
+# smsserver = http://clients.sms-wap.com:80/cgi/csend.cgi
+# backupsmsserver = http://clients.sms-wap.com:80/cgi/csend.cgi
+#
+# match = .*
+#
+# spoolout = /tmp/novelsoft
--- /dev/null
+ Example
+ SMART MESSAGING SERVER
+
+INTRODUCTION
+
+Today I see in every magazine, targetted to the average person, advertisements for ringing tones and logo downloads. You have to call a telephone number (0900-principle) and then by acting upon a voice menu you can download a certain ringing tone or graphic. Because this package does not implements a voice box we will use an SMS message to 'order' a ringing tone or groupgraphic. Anyway, if you are interested in implementing such a service using this package, you can look at the Modem::VBox module.
+
+Of course, this is just intented as a demo for the GSM::SMS package. As such, the implementation can be a bit crude. But it should be functional anyway...
+
+To receive a message, you have to send a SMS message that contains which ringing tone or graphic you want to receive. Such command messages consist of a 6 number string. Thge first 2 numbers indicate the type of resource you want to receive; 10 for a group graphic 20 for a ringing tone. The next 4 digits tell the server which file you actually want to receive.
+
+The program maps the first 2 numbers to a directory, inside this directory we find files with a filename like:
+
+nnnn.rtttl
+or
+nnnn.gif
+
+Just as you thought, thse 'nnnn' are the 4 last digits in the incoming command message.
+
+The program picks up the file and sends it back to the commands message originating address.
+
+USAGE
+
+./sms --config=<config file>
+
+CONFIG FILE FORMAT
+
+The following directives can be used in the config file.
+
+access=^\+32475,^\+32478
+ comma seperated access list. The incoming phone number must match
+ one of these regular expressions to be allowed access.
+
+rtttldir=./media/rtttl
+ directory where to find ringing tones.
+
+rtttlprefix=20
+ prefix to use in the 6 digit number to map a command to a ringing tone.
+
+groupgraphicdir=./media/groupgraphics
+ directory where to find group graphics
+
+groupgraphicprefix=10
+ prefix to use in the 6 digit number to map a command to a group graphic.
+
+transportconfig=./transport.conf
+ transport configuration file to use
+
+log=./log.txt
+ log file to keep date, time, originating phonenumber and file requested. Can be used to keep accountancy.
--- /dev/null
+AxelF:d=4,o=5,b=125:32p,8g,8p,16a#.,8p,16g,16p,16g,8c6,8g,8f,8g,8p,16d.6,8p,16g,16p,16g,8d#6,8d6,8a#,8g,8d6,8g6,16g,16f,16p,16f,8d,8a#,2g,p,16f6,8d6,8c6,8a#,g,8a#.,16g,16p,16g,8c6,8g,8f,g,8d.6,16g,16p,16g,8d#6,8d6,8a#,8g,8d6,8g6,16g,16f,16p,16f,8d,8a#,2g
--- /dev/null
+Bolero:d=4,o=5,b=80:c6,8c6,16b,16c6,16d6,16c6,16b,16a,8c6,16c6,16a,c6,8c6,16b,16c6,16a,16g,16e,16f,2g,16g,16f,16e,16d,16e,16f,16g,16a,g,g,16g,16a,16b,16a,16g,16f,16e,16d,16e,16d,8c,8c,16c,16d,8e,8f,d,2g
--- /dev/null
+Halloween:d=4,o=5,b=180:8d6,8g,8g,8d6,8g,8g,8d6,8g,8d#6,8g,8d6,8g,8g,8d6,8g,8g,8d6,8g,8d#6,8g,8c#6,8f#,8f#,8c#6,8f#,8f#,8c#6,8f#,8d6,8f#,8c#6,8f#,8f#,8c#6,8f#,8f#,8c#6,8f#,8d6,8f#
--- /dev/null
+#!/usr/bin/perl
+
+#
+# Load some modules
+use GSM::SMS::Log;
+use GSM::SMS::Config;
+use GSM::SMS::NBS;
+use Getopt::Long;
+
+#
+# No output buffering
+$|++;
+
+
+
+#
+# Arguments
+my $ARG_CONFIG;
+my $ARG_VERBOSE;
+GetOptions(
+ "config:s" => \$ARG_CONFIG,
+ "verbose" => \$ARG_VERBOSE
+ );
+
+unless ( $ARG_CONFIG ) {
+print <<EOT;
+Usage: $0 --config=<config file> [--verbose]
+EOT
+exit(1);
+}
+
+
+
+#
+# Read sms config file
+my $CONFIG;
+die "Can't read sms config file: $ARG_CONFIG!\n"
+ unless ($CONFIG = read_config( $ARG_CONFIG ));
+
+
+
+#
+# Get parameters
+my $config = get_config($CONFIG, 'default');
+my $CFG_CONFIG = $config->{"transportconfig"};
+my $CFG_LOG = $config->{"log"};
+my $CFG_GROUPGFXDIR = $config->{"groupgraphicdir"};
+my $CFG_GROUPGFXPREFIX = $config->{"groupgraphicprefix"};
+my $CFG_RTTTLDIR = $config->{"rtttldir"};
+my $CFG_RTTTLPREFIX = $config->{"rtttlprefix"};
+my $CFG_ACL = $config->{"access"};
+my @CFG_ACL = split /,/, $CFG_ACL;
+
+verb(<<EOT
+SMART MESSAGING SERVER
+
+coming up with settings:
+ transportconfig $CFG_CONFIG
+ log $CFG_LOG
+ groupgraphicdir $CFG_GROUPGFXDIR
+ groupgraphicprefix $CFG_GROUPGFXPREFIX
+ rtttldir $CFG_RTTTLDIR
+ rtttlprefix $CFG_RTTTLPREFIX
+ acl $CFG_ACL
+
+EOT
+);
+
+
+
+#
+# Initialize
+my $nbs = GSM::SMS::NBS->new( $CFG_CONFIG );
+
+my $msisdn;
+my $message;
+my $timestamp;
+my $transportname;
+my $port;
+
+my $logger = GSM::SMS::Log->new( $CFG_LOG );
+
+
+
+#
+# Start server ...
+while (1) {
+ verb( "waiting for message ..." );
+ # blocking receive
+ $nbs->receive( \$msisdn,
+ \$message,
+ \$timestamp,
+ \$transportname,
+ \$port,
+ 1 );
+
+ verb(<<EOT
+
+received a message:
+msisdn: $msisdn
+timestamp: $timestamp
+transport: $transportname
+port: $port
+--------------------------------------------------------------------------
+$message
+--------------------------------------------------------------------------
+EOT
+);
+ # only text messages
+ unless ( $port ) {
+ # acl check
+ if ( grep { $msisdn =~ /$_/ } @CFG_ACL ) {
+ verb( "acl pass\n" );
+ $message =~ /(\d{2})(\d{4})/;
+ my $prefix = $1;
+ my $resource = $2;
+
+ # handle ringing tones
+ if ( $prefix eq $CFG_RTTTLPREFIX ) {
+ verb( "rtttl\n" );
+ my $file = $CFG_RTTTLDIR . '/' . $resource . '.rtttl';
+ verb( "file $file " );
+ if ( -e $file ) {
+ verb( "is a valid resource!\n" );
+ local (*F);
+ open F, $file;
+ my $rtttl_string = join "", <F>;
+
+ close F;
+ $nbs->sendRTTTL( $msisdn, $rtttl_string );
+ $logger->logentry( sprintf("\"$message\"\t\"$msisdn\"") );
+ }
+ }
+
+ # handle group graphics
+ if ( $prefix eq $CFG_GROUPGFXPREFIX ) {
+ verb( "groupgfx\n" );
+ my $file = $CFG_GROUPGFXDIR . '/' . $resource . '.gif';
+ verb( "file $file " );
+ if ( -e $file ) {
+ verb( "is a valid resource!\n" );
+ $nbs->sendGroupGraphic_file( $msisdn, $file );
+ $logger->logentry( sprintf("\"$message\"\t\"$msisdn\"") );
+ }
+ }
+ }
+ }
+ verb( "\n" );
+}
+exit(0);
+
+#
+# Verbose function
+sub verb {
+ print shift if $ARG_VERBOSE;
+}
--- /dev/null
+##########################################################################
+#
+# example sms config file
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# (c) 1999-2001 Johan Van den Brande
+
+
+ # Comma seperated access list. The incoming phone number must match
+ # one of these regular expressions to be allowed access.
+ access=^\+32475567606
+
+ # Directory where to find ringing tones.
+ rtttldir=./media/rtttl
+
+ # Prefix to use in the 6 digit number to map a command to a ringing tone.
+ rtttlprefix=20
+
+ # Directory where to find group graphics
+ groupgraphicdir=./media/groupgraphics
+
+ # Prefix to use in the 6 digit number to map a command to a group graphic.
+ groupgraphicprefix=10
+
+ # Transport configuration file to use
+ transportconfig=./transport.conf
+ # Log file to keep date, time, originating phonenumber and file requested.
+ # Can be used to keep accountancy.
+ log=./log.txt
--- /dev/null
+##########################################################################
+#
+# example transport config file
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Configure the different transports here.
+# Use this as an example file
+#
+#
+# (c) 1999-2001 Tektonica bvba. Johan Van den Brande
+[Serial]
+ type = Serial
+
+ name = SerialTest
+ pin-code = 6023
+ csca = +32475161616
+ serial-port = /dev/ttyS1
+ baud-rate = 9600
+
+ originator = moboid.com
+
+ match = .*
+ spoolout = /tmp/serial/out
+ spoolin = /tmp/serial/in
+ log = /tmp/theseriallogger.txt
+
+ # 10 for Wavecom | 15 for Siemens.
+ memorylimit = 10
+
+#[NovelSoft]
+# type = NovelSoft
+#
+# proxy = http://proxy.telenet.be:8080
+# userid = <get your own at http://www.sms-wap.com>
+# password = <get your own at http://www.sms-wap.com>
+# originator = moboid.com
+# smsserver = http://clients.sms-wap.com:80/cgi/csend.cgi
+# backupsmsserver = http://clients.sms-wap.com:80/cgi/csend.cgi
+#
+# match = .*
+#
+# spoolout = /tmp/novelsoft
--- /dev/null
+# example transport for NovelSoft SMSC
+# ------------------------------------
+
+# To obtain an account for NovelSoft, please visit http://www.sms-wap.com
+#
+# The config parameters ...
+# proxy :
+# proxy to connect through
+# http://hostname:port
+# userid/password :
+# login credentials you will get when
+# you get an account at novelsoft.
+# originator:
+# the number ( or text ) the message comes from.
+# smsserver/backupserver :
+# gateway URL and fallback
+# match:
+# regexp for message routing. If regexp matches,
+# this transport will handle it.
+# spoolout :
+# directory in which to place temp. files for this transport.
+
+[NovelSoft]
+ type = NovelSoft
+
+ proxy =
+ userid = provideyourown
+ password = provideyourown
+ originator = moboid.com
+ smsserver = http://clients.sms-wap.com:80/cgi/csend.cgi
+ backupsmsserver = http://clients.sms-wap.com:80/cgi/csend.cgi
+
+ match = ^\+3248
+
+ spoolout = /tmp/spool/novelsoft/out
--- /dev/null
+;\r
+; Ringing Tones text transfer language (RTTTL)\r
+;\r
+; Version 1.0 / 29-July-1998\r
+; - First version by John Mostelo\r
+; \r
+; http://members.tripod.com/~ringtones/note_syntax.txt\r
+;\r
+\r
+<ringing-tones-text-transfer-language> :=\r
+ <name> <sep> [<defaults>] <sep> <note-command>+\r
+\r
+<name> := <char>+ ; maximum name length 10 characters\r
+\r
+<sep> := ":"\r
+\r
+<defaults> := \r
+ <def-note-duration> |\r
+ <def-note-scale> |\r
+ <def-beats> \r
+\r
+<def-note-duration> := "d=" <duration>\r
+\r
+<def-note-scale> := "o=" <scale> \r
+\r
+<def-beats> := "b=" <beats-per-minute>\r
+\r
+<beats-per-minute> := 25,28,...,900 ; decimal value\r
+\r
+; If not specified, defaults are\r
+;\r
+; 4 = duration\r
+; 6 = scale \r
+; 63 = beats-per-minute\r
+\r
+\r
+<note-command> :=\r
+ [<duration>] <note> [<scale>] [<special-duration>] <delimiter>\r
+\r
+\r
+<duration> :=\r
+ "1" | ; Full 1/1 note\r
+ "2" | ; 1/2 note\r
+ "4" | ; 1/4 note\r
+ "8" | ; 1/8 note\r
+ "16" | ; 1/16 note\r
+ "32" | ; 1/32 note\r
+ \r
+<note> :=\r
+ "P" | ; pause\r
+ "C" |\r
+ "C#" |\r
+ "D" |\r
+ "D#" |\r
+ "E" |\r
+ "F" |\r
+ "F#" |\r
+ "G" |\r
+ "G#" |\r
+ "A" |\r
+ "A#" |\r
+ "H" \r
+\r
+<scale> :=\r
+ "5" | ; Note A is 440Hz\r
+ "6" | ; Note A is 880Hz\r
+ "7" | ; Note A is 1.76 kHz\r
+ "8" ; Note A is 3.52 kHz\r
+\r
+<special-duration> :=\r
+ "." ; Dotted note\r
+\r
+<delimiter> := ","\r
+\r
+; End of specification\r
--- /dev/null
+use strict;
+use Test::More tests => 13;
+
+BEGIN {
+ use_ok( 'GSM::SMS::NBS');
+ use_ok( 'GSM::SMS::PDU');
+ use_ok( 'GSM::SMS::Transport');
+ use_ok( 'GSM::SMS::Log');
+ use_ok( 'GSM::SMS::Spool');
+ use_ok( 'GSM::SMS::Config');
+ use_ok( 'GSM::SMS::NBS::Frame');
+ use_ok( 'GSM::SMS::NBS::Message');
+ use_ok( 'GSM::SMS::NBS::Stack');
+ use_ok( 'GSM::SMS::Transport::Transport');
+ use_ok( 'GSM::SMS::Transport::Serial');
+ use_ok( 'GSM::SMS::Transport::NovelSoft');
+ use_ok( 'GSM::SMS::Transport::MCube' );
+}
--- /dev/null
+use strict;
+use Test::More 'no_plan';
+
+# Testing the MCube support.
+
+use GSM::SMS::NBS;
+use constant _CONFIG => '/tmp/gsmperl/GSM/t/mcube.conf';
+use constant _TESTGSM => '+32475567606';
+use constant _TESTMSG => 'Hello world from GSM::SMS';
+use constant _TESTIMG => '/tmp/gsmperl/GSM/examples/smartmessagingserver/media/groupgraphics/0001.gif';
+my $nbs = GSM::SMS::NBS->new( _CONFIG );
+
+ok($nbs, 'constructor');
+
+ok( $nbs->sendSMSTextMessage( _TESTGSM, _TESTMSG ) != 0, 'sending a test text message');
+
+ok( $nbs->sendGroupGraphic_file( _TESTGSM, _TESTIMG ) != 0, 'sending group graphic');
--- /dev/null
+[MCube]
+ type = MCube
+
+ proxy = http://proxy.telenet.be:8080
+ userid = vdb
+ password = xserd54
+ originator = GSMSMS
+ smsserver = http://www.m3.be/scripts/httpgate1.cfm
+
+ match = .*
+
+ spoolout = /tmp/mcube
git://git.jankratochvil.net / gsmperl.git / commitdiff
