[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

[MacPerl] MacPerl SMS server



Hi,

Firstly, apologies for posting a script in a message, but, I thought I
should share this MacPerl SMS (Mobile Messaging) Script with you all as an
cool example of what can be done with MacPerl, with the consent of the
author here it is.

REGARDS
Paul

#!perl
############################################################################
#######
#
# SMS Server - a simple perl script to send and receive SMS messages on the
Mac
#               this should not be read as a good example of perl coding
#               merely an example of what one could do on a wet Sunday
#               afternoon with bits and pieces lying around the junk room.
#               The code can also be used to serve WAP "cards" over an SMS
#               bearer. This feature does not work with the Nokia 9000
#               The software also sends out SMS messages dumped in a folder
#               see the outsms subroutine for details.
#               There are still lots of diagnostic print statements in the
code
#               remove them when you are happy it works...
#               
#
# Author      - David Aselford (if you call this authoring)
#
# Date        - April 2, 2000
#
# Assistance  - Paul Schaap, Jim Kotoulas
#
# Needs       - A GSM handset with NORMAL serial port (Nokia, Siemens or
similar)
#               The handset must allow you to use the extended AT commands
for
#               SMS sending, for WAP support you need to be able to set the
UDHI bit.
#               SMS MO & MT enabled on the phone (network feature)
#               A GSM phone network
#
#
#
# WARNING WARNING WARNING this software is not guaranteed to do anything use
it at your own risk
#
# 1. You start this script in the normal way but stopping it requires you to
send the stop command from a
# specified mobile phone or hold down the mouse button for a long time.
# If you stop it from MacPerl you will keep the serial port open and have to
restart
# your Mac. Obviously you can change the code if you want. The number is
specified way down near the end.
#
# 2. MacPerl seems to have a slight memory leak when calling an XCMD so the
polling loops have been
# slowed down to ensure that you can run for 24 hours without a problem. So
shut the server down once a day
# quit MacPerl then fire it up again. Increase the memory allocated to
MacPerl to about 11MB.
#
# To run this script you will need ...
#
# Mac, running an OS that has the comms toolbox installed including the
"serial tool"
#
# GSM phone that can be connected to a Mac via a serial cable and appear
like a modem
# this code was tested with a Nokia 9000 but should work with Nokia 9110,
some Siemens phones etc.
# There are no guarantees that this software will work.
#
# The main bit of code supports the Nokia TTML web browsers (8110i, 6110,
8810, 9110 etc.)
#
# A text file of suffix ttml needs to reside in the ttml folder specified in
the script
# for each ttml page you have, the menu items must have the same name as the
file with spaces changed to _ in the file name
# ttml files must be prefixed with SMS then have the raw ttml code as
defined in the Nokia Smart Messaging
# Specification Revision 2 available from the Nokia web site, the Service
Developers Guide for the 8110i
# is also a useful reference from the same site
# you can use BBEDIT to create the files, save them as generic text files
with unix line breaks and it's easy
#
# here is a sample, in the real file you do NOT precede each line with a #
space
#
# SMS..Telephony menu
# Telephony menu
# >.Choose an item
# .>*Bill status
# .>*Service list
# .>*Product list
# ><R
#
# you can also serve up text files if they start 'db' (change it if you
want)
# these files are in the same folder but have the suffix '.menu' as they are
normally used for setting up
# menus in the phones. Still start the text with SMS then over to you, again
check the Smat Messaging spec for details.
#
# NOTE: SMS messages are limited to 160 characters so keep your text below
about 130 characters so you leave space for headers
# etc. With WAP messages this is 140 and 120 respectively.
#
# For WAP support you will need the WAP cards to be stored in the WAP
folder. These files contain the
# tokenised wml code in the normal wmlc format EXCEPT the bytes are unpacked
to ease transmission, for
# example the linefeed character 12 octal ( 0a hex ) is represented as two
bytes 0A (hex 30 then 41).
# You can pre-process the files using the perl unpack command if you have a
wmlc creation program
# that creates the single byte binary versions.
# 
# Information on WAP is readily available from the web.
# 
# Some phones need you to specify the SMS service centre address via the
serial port this can be achieved
# using a terminal program or adding it to the code the command is
at+csca="+01234567" just replace +01234567 with
# your service centre number, the quotes are required.
# 
############################################################################
#############################

# the Commconnect libraries allow us to talk to the comms toolbox tools
# warning - this bit is Mac specific

use strict;
use Mac::Events;
require "CommConnect.pl";

my($i, $k, $j, $alldata, $data, $status, $destno,
   $destmsg, $smsdata, @smsfull, @smsheader, $gsmcommand,
   @temp1, $smsnumber, $endflag, $ttmldata, $text, $log);
   
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

sub outsms {} # defined later

# closelink subroutine
# this closes the link when we have finished, must be called on
# program exit otherwise you cannot access the serial port
# until after a restart
# warning - this bit is Mac specific

sub closelink
{
   &CommConnect'CloseConnection();
   &CommConnect'Cleanup();
} # end closelink

# waitCR subroutine
# short routine to wait 10 seconds for the carriage return from the phone

sub waitCR
{
# now we wait for the echo....
# print "Waiting for response\n";
# set a timeout of ten seconds
   &CommConnect'Idle();
   $i = time();
   $k = $i;
   $j = $i + 9;
   $alldata = "";
   $data = "";
   do {
      $data = &CommConnect'Receive();
      if ($data) {$alldata .= $data; };
   
# next bit stops the polling for a second so we do not run out of memory
      do { $i = time(); } until ($i > $k); $k = $i;
      }
   until ($alldata =~ /\015/) || ($i > $j || Button());
   if ($i > $j) { closelink; die("No response.\n");}
   
} # end waitCR


# waitOKCR subroutine
# short routine to wait 10 seconds for the OK and carriage return from the
phone

sub waitOKCR
{
# now we wait for the echo....
# print "Waiting for response\n";
# set a timeout of ten seconds
   &CommConnect'Idle();
   $i = time();
   $k = $i;
   $j = $i + 9;
   $alldata = "";
   $data = "";
   do {
      $data = &CommConnect'Receive();
      if ($data) {$alldata .= $data; };
   
# next bit stops the polling for a second so we do not run out of memory
      do { $i = time(); } until ($i > $k); $k = $i;
      }
   until ($alldata =~ /OK\015/) || ($i > $j || Button());
   if ($i > $j) { closelink; die("No response.\n");}

} # end waitOKCR



# sendGSMcommand(command) subroutine
# sends command to GSM phone

sub sendGSMcommand
{
# print $command;
   ($gsmcommand) = @_;
   $status = &CommConnect'Send($gsmcommand);
   if ($status) { closelink; die($status, "  Exiting program.\n"); }

} # end sendGSMcommand



# openlink subroutine
# this opens the link to the phone
# warning - this bit is Mac specific

sub openlink {

# select the serial tool
   print &CommConnect'Prepare("Serial Tool"), "\n";

# now allow the user to choose the port, baud rate etc. by showing dialog
   print &CommConnect'Choose(), "\n";

# open the connection specified
   $status = &CommConnect'OpenConnection();
   if ($status) { die($status, "  Exiting program.\n"); }

# send a command to test the link is there

# write the command, explicitly declare the CR and LF characters to make
sure
   sendGSMcommand("\015\012at\015\012");

   waitOKCR;

# print "returned value", $alldata, "x\n";
   print "Link is active\n";
   $alldata = "";

# now we are talking ask the phone to send all received SMS messages to the
computer

# write a command to say we get the SMS messages rather than the phone
   sendGSMcommand("AT+CNMI=1,2\015\012");
   waitOKCR;
   $alldata = "";

# write a command to say we want text mode
   sendGSMcommand("AT+CSMP=17,167,0,0\015\012");
   waitOKCR;
   $alldata = "";

} # end of openlink



# sendmessage(number, message) subroutine
# sends message to phone number, number should be in international format
# e.g. +61412xxxxxx

sub sendmessage {
    my ($position);
 print "sending test message\n";
   ($destno, $destmsg) = @_;

    sendGSMcommand("at+cmgs=\"$destno\"");

    sendGSMcommand("\015");
  print "$destno\n";
  print "waiting for text entry\n";
 # set a timeout of ten seconds
   $i = time();
   $k = $i;
   &CommConnect'Idle();
   $j = $i + 9;
   do {
      $data = &CommConnect'Receive();
      if ($data) {$alldata .= $data;};
   
# next bit stops the polling for a second so we do not run out of memory
      do { $i = time(); } until ($i > $k); $k = $i;
      }
   until ($alldata =~ />/) || ($i > $j || Button());
   if ($i > $j) { closelink; die("No response.\n");}
   $alldata = "";

   sendGSMcommand("$destmsg\032");
 
# get a timestamp for the logfile

   ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime();
   $year = $year + 1900;
   $mon = $mon + 1;

   
   waitCR;
   if ($alldata =~ /OK/)
     {
      print LOG ( "Sent", '|', $destno, '|', "$year.$mon.$mday", '|',
"$hour:$min:$sec", '|0|', $destmsg, "\n");
      print "sent message\n";
     }
   if ($alldata =~ /ERROR/)
     {
      $position = index($alldata, 'ERROR');
      $alldata = substr($alldata,$position,10);
      print LOG ( "Send error", '|', $destno, '|', "$year.$mon.$mday", '|',
"$hour:$min:$sec", '|', $alldata, '|', $destmsg, "\n");
      print "sending error - $alldata\n";
     }
   
   $alldata = "";
} # end sendmessage



# waitformsg subroutine
# waits for incoming messages from phone

sub waitformsg {
   print "Waiting for incoming message\n";
   &CommConnect'Idle();
   $alldata = "";
   $data = "";
   $i = time();
   $k = $i;
   do { 
       
# check the outbox for any outgoing messages and send them if required
      outsms;
      
      $data = &CommConnect'Receive();
      if ($data) {$alldata .= $data; print ".";};
    
# next bit stops the polling for a while so we do not run out of memory
# the waitnextevent is needed so you can leave this running in the
background and still use the Mac

      do { WaitNextEvent(); $i = time(); } until ($i > $k ); $k = $i;
      }
    until ($alldata =~ /CMT:/) || Button();
    $i = time();
    $j = $i;
    do { $i = time(); } until ($i > $j);
   do {
      $data = &CommConnect'Receive();
      if ($data) {$alldata .= $data;};
      $i = time();
      }
    until ($i > $j) || Button();
    print "$alldata\n";
    @smsfull = split(/\015/, $alldata);
    @smsheader = split(/,/,$smsfull[0]);
    @temp1 = split(/\"/,$smsheader[0]);
    $smsnumber = $temp1[1];
    $smsdata = substr($smsfull[1],1);
    print "\n$smsnumber\n$alldata\n";
    
# get a timestamp for the logfile

    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime();
    $year = $year + 1900;
    $mon = $mon + 1;

    print LOG ( "Received", '|', $smsnumber, '|', "$year.$mon.$mday", '|',
"$hour:$min:$sec", '|0|', $alldata, "\n");

} # end waitformsg 


# sub parsedb handles db prefixed requests, loads relevant file and replies
# an SMS message received starting with db is assumed to be a request to
# serve a particular SMS message from the ttml folder

sub parsedb   {
    my ($filename, $filetype);
    ($filename) = @_;
    $filename = $filename.'.menu';
    if (open(IN, ":ttml:$filename"))
      { 
        $text = <IN>;
        close(IN);
        $filetype = substr($text,0,3);
        $text = substr($text,3);
      }
      else
      {
        $text = "Option not available";
      };
    print ($text,"\n");
    if ($filetype =~ /WAP/)
      {
    print ("Wap mode entered\n");
    $text =~ s/\012//;
    $text =~ s/\015//;
    
# write a command to say we want 8 bit mode
# we also need to set the UDHI flag in the SMS header otherwise the WAP
stuff is ignored
# this WILL fail on some older phones that do not fully support the command
for example 
# the Nokia 9000

       sendGSMcommand("AT+CSMP= 81,167,0,245\015\012");
       waitOKCR;
       $alldata = "";
      }

    sendmessage($smsnumber,$text);


# write a command to switch back to text mode
   sendGSMcommand("AT+CSMP=17,167,0,0\015\012");
   waitOKCR;
   $alldata = "";

} # end sub parsedb

#sub sendwap - sends out wap data to requestor

sub sendwap {
    
# write a command to say we want 8 bit mode
# we also need to set the UDHI flag in the SMS header otherwise the WAP
stuff is ignored
# this WILL fail on some older phones that do not fully support the command
for example 
# the Nokia 9000

   print "entering wap mode\n";
            
   sendGSMcommand("AT+CSMP= 81,167,0,245\015\012");
   waitOKCR;
   $alldata = "";
   sendmessage($smsnumber,$smsdata);
# write a command to switch back to text mode
   sendGSMcommand("AT+CSMP=17,167,0,0\015\012");
   waitOKCR;
   $alldata = "";
} # end sendwap


# sub parsettml - handles the decoding of a ttml message, loads message and
replies

sub parsettml {
   my (@reply, $filetype);
   print "parseing\n";

   $ttmldata = substr($smsdata,11);
   if ($ttmldata =~ /\.>/) # reply message
     {
     @reply = split(/>/,$ttmldata);
     $ttmldata = substr($reply[2],0,(length($reply[2])-1));
     };
  # is it the home page
     $ttmldata =~ tr/ /_/;
     print ($ttmldata, "\n");
     if ($ttmldata =~ /<</) # confirmation message indicator
       {
        $ttmldata = "confirmation";
       };
     if ($ttmldata =~ /\*#\*#\*#/)
       { $ttmldata = "home.ttml"; }
     else
       { $ttmldata = $ttmldata.".ttml";};
     print $ttmldata,"\n";
     if (open(IN, ":ttml:$ttmldata"))

       { 
        $text = <IN>;
        close(IN);
        $filetype = substr($text,0,3);

        if ($filetype eq 'SMS')
        {
          $text = substr($text,3);
        } else
        {
          $text = "..Command type not supported\012Command type not
supported\012";
        }
      }
      else
      {
        $text = "..Topic not Found\012Unfortunately the topic you selected
is not available on this service\012";
      };

    $text = "//SCKL15CC15CC010101 ".$text;
    print $smsnumber, $text;
    sendmessage($smsnumber,$text);

} # end parsettml

# sub parsewap parsews wap requests

sub parsewap {
    
    my($inport, $outport, $urllen, $url, $reqtype, $msgnum, $count);
    
    $inport = substr($smsdata, 6,4); # the incoming port address usually
23F0
    $outport = substr($smsdata,10,4);
    $msgnum = substr($smsdata, 14,2);
    $reqtype = substr($smsdata, 16,2);
    
    if ($reqtype eq '40') {  # wap get command
        
 $urllen = hex(substr($smsdata, 18,2));
 $urllen = $urllen - 7;
  # remove http://
 $url = '';
 $count = 34;
    
 while ($urllen > 0) {
        
     $url .= chr(hex(substr($smsdata, $count,2)));
     $count = $count + 2; 
     $urllen = $urllen - 1;
 }
 if (open(IN, ":wap:$url"))
 {
     $text = <IN>;
     close(IN);
 }
 else
 {
     (open(IN, ":wap:error"));
     
     $text = <IN>;
     close(IN);
 }
 chomp ($text);
 
 $smsdata = '060504';
 $smsdata .= $outport;
 $smsdata .= $inport;
# $smsdata .= '0003010101'; 
 $smsdata .= $msgnum;
 $smsdata .= '042003948C99'; # reply, OK, wmlc, english
 $smsdata .= $text;
 print "$smsnumber, $smsdata \n";
     
 sendwap; 
    }
}

 
    

# sub parsemsg - handles the decoding of the incoming message and passing to
handler routine

sub parsemsg {

   my($lower, $header);

   print "received message\n";

# first we check for ttml requests
   if ($smsdata =~ /\/\/SCKL15CC/) { parsettml; $smsdata = ""; }; # this is
the ttml header

# we should check for others here later

   if ($smsdata =~ /06050423F0/) { parsewap; $smsdata = "";}; # handle wap
commands

# if we get here it may be a dingo blue specific one

   (($lower = $smsdata) =~ tr/A-Z/a-z/);
   $header = substr($lower,0,2);
   if ($header =~ /db/) {  parsedb($lower);};

  } # end parsemsg

  
  
# sub outsms - polls the outbox directory and sends valid messages out
# this can be used to make the software act as an SMS server so that you
# just dump the outgoing message in a folder, it gets sent and the file
deleted
# file format is 
# number,type,message
# where number is the destination phone number, type is SMS or WAP, message
is the text of the message
# note whilst this sends out WAP messages the feature is only supported on
WAP 1.2 compliant phones
# of which none are available at this time

sub outsms
{
my ($dirflag, @files, $flag, $file, $line, @temp, $reqtype);
$dirflag = 0;
opendir(DIR,'outbox') or $dirflag = 1;
if ($dirflag == 0)
  {
   @files = readdir(DIR);
   closedir(DIR);
   foreach $file(@files)
     {
      $flag = 0;
      open (IN, ":outbox:$file") or $flag = 1;
      if ($flag == 0)
        {
         $line = <IN>;
         close(IN);
         chomp($line);
         @temp=split(/,/,$line);
         $smsnumber = $temp[0];
         $reqtype = $temp[1];
         ($reqtype =~ tr/A-Z/a-z/);
         $smsdata = $temp[2];
         print "$smsnumber\n$reqtype\n$smsdata\n";
  
         if ($reqtype eq 'sms')
           {
     print "got to $smsdata\n$smsnumber\n";
     
            sendmessage($smsnumber,$smsdata);
     print "finished sendmessage\n";
     
           }
         if ($reqtype eq 'wap')
           {
        sendwap;
        
           } # end message sending
        } # end open loop
        unlink (":outbox:$file");
     } # end foreach loop
   } # end opendir
} # end outsms


#################################
#
# main code starts here
#
#################################

 print "SMS Control starting up...\n";

# all pages kept on ttml folder
# insert here the path to the ttml files folder
#         xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
#   chdir('Video Strea:Desktop folder:WAP folder:SMS Server folder') or
die("Unable to find ttml files");

# get a timestamp for the logfile

   ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime();
   $year = $year + 1900;
   $mon = $mon + 1;

   open(LOG, '>>message.logfile');
   open(LOG2, '>>server.logfile');
   print LOG2 ( "Server started $hour:$min:$sec $mday.$mon.$year\n");

# open connection to GSM network


   openlink;


   $endflag = 0;
   do {

       waitformsg;
       if ( Button()) {$endflag = 1;};

# the bit of code below stops the server you will need to send an SMS
message to the
# server with the word 'stop' in it from a phone with the number in the if
statement below
#                          xxxxxxxx
       if (($smsnumber =~ /14126797/) && ($smsdata =~ /stop/)) { $endflag =
1;};
       if ( $endflag == 0 )
         {
          parsemsg;
         }
       }

   until ($endflag == 1);



# get a timestamp for the logfile

   ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime();
   $year = $year + 1900;
   $mon = $mon + 1;

   print LOG2 ("Server stopped $hour:$min:$sec $mday.$mon.$year\n");
   close(LOG);
   close(LOG2);

# disconnect from GSM network

   closelink;
   print "done\n";
   exit(0);




# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org