GSM/SMS/Transport/MCube.pm

   1 package GSM::SMS::Transport::MCube;
   2 use strict;
   3 use vars qw( $VERSION );
   4 $VERSION = '0.1';
   5
   6 #
   7 # HTTP access to the MCube SMS center
   8 #
   9
  10 use base qw( GSM::SMS::Transport::Transport );
  11
  12
  13 use HTTP::Request::Common qw(GET);
  14 use LWP::UserAgent;
  15 use URI::URL qw(url);
  16 use URI::Escape qw(uri_escape);
  17 use GSM::SMS::PDU;
  18 use GSM::SMS::Log;
  19 use Data::Dumper;
  20
  21 # All the parameters I need to run
  22 my @config_vars = qw(
  23         name
  24         proxy
  25         userid
  26         password
  27         originator
  28         smsserver
  29         match
  30         spoolout
  31         log
  32                                         );
  33 # constructor
  34 sub new {
  35         my $proto = shift;
  36         my $class = ref($proto) || $proto;
  37
  38         my $self = {};
  39         $self->{cfg} = shift;
  40
  41         $self->{'__LOGGER__'} = GSM::SMS::Log->new( $self->{cfg}->{"log"} );
  42
  43         bless($self, $class);
  44         return $self;
  45 }
  46
  47
  48 # Send a (PDU encoded) message
  49 sub send        {
  50         my ($self, $msisdn, $pdu) = @_;
  51         my $logger = $self->{'__LOGGER__'};
  52
  53         $logger->logentry("send [$pdu]") if $logger;
  54
  55         $self->_add_to_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
  56         if ( $self->_transmit($pdu, $self->{cfg}->{"smsserver"}) ) {
  57                 $logger->logentry( "Error sending" ) if $logger;
  58                 return -1;
  59         }
  60         $self->_remove_from_spool( $msisdn, $pdu, $self->{cfg}->{"spoolout"} );
  61         return 0;
  62 };
  63
  64 # Receive a PDU encoded message
  65 #       $ is a ref to a PDU string
  66 #       return
  67 #       0 if PDU received
  68 #       -1 if no message pending
  69 sub receive     {
  70         my ($self, $pduref) = @_;
  71
  72         return -1;
  73 };
  74
  75
  76 # Close
  77 sub close        {
  78         my ($self) = @_;
  79         my $logger = $self->{'__LOGGER__'};
  80
  81         $logger->logentry("MCube Transport ended.") if $logger;
  82 }
  83
  84 # A ping command .. just return an informative string on success
  85 sub ping {
  86         my ($self) = @_;
  87
  88         return "Pong.. MCube transport ok";
  89 }
  90
  91
  92 # give out the needed config paramters
  93 sub get_config_parameters {
  94         my ($self) = @_;
  95
  96         return @config_vars;
  97 }
  98
  99 # Do we have a valid route for this msisdn
 100 sub has_valid_route {
 101         my ($self, $msisdn) = @_;
 102
 103         # print "in route\n";
 104         # print Dumper $self->{cfg};
 105         foreach my $route ( split /,/, $self->{cfg}->{"match"} ) {
 106                 # print $route;
 107                 return -1 if $msisdn =~ /$route/;
 108         }
 109         return 0;
 110 }
 111
 112 #####################################################################
 113 # transport specific
 114 #####################################################################
 115 sub _transmit {
 116         my ($self, $pdustr, $server) = @_;
 117
 118         my $logger = $self->{'__LOGGER__'};
 119
 120         my $uid = $self->{cfg}->{"userid"};
 121         my $pwd = $self->{cfg}->{"password"};
 122         my $originator = $self->{cfg}->{"originator"};
 123         my $proxy = $self->{cfg}->{"proxy"};
 124         my $url = url( $server );
 125         my $msg;
 126         my $decoder = GSM::SMS::PDU->new();
 127         my ($da, $pdutype, $dcs, $udh, $payload) = $decoder->SMSSubmit_decode($pdustr);
 128
 129         $da=~s/^\+//;
 130
 131         my $type;
 132         if (defined($udh) && (length($udh) > 0)) {
 133                 # transfor to hexprints
 134                 #$udh = $self->serialize_to_hex( $decoder->decode_7bit( $udh, length($udh) ));
 135                 #$payload = $self->serialize_to_hex( $decoder->decode_7bit( $payload, length($payload) ) );
 136
 137                 # $udh = $decoder->decode_7bit( $udh, length($udh));
 138                 # $payload = $decoder->decode_7bit( $payload, length($payload) );
 139
 140                 $type = 3;
 141         } else {
 142                 $type = 1;
 143                 $udh = "";
 144         }
 145
 146
 147 print <<EOT;
 148 login :         $uid
 149 password :      $pwd
 150 togsm :         $da
 151 data :          $payload
 152 type :          $type
 153 UDH  :  $udh
 154 oastring :      $originator
 155 EOT
 156
 157
 158         my $ua = LWP::UserAgent->new();
 159         $ua->proxy( 'http', $proxy ) if ( $proxy ne "" );
 160         my $urlstring = "$server"
 161                                         .
 162                                         "?"
 163                                         .
 164                                         "login=" . uri_escape( $uid )
 165                                         .
 166                                         "&password=" . uri_escape( $pwd )
 167                                         .
 168                                         "&togsm=" . uri_escape( $da )
 169                                         .
 170                                         "&oastring=" . uri_escape( $originator )
 171                                         .
 172                                         "&type=" . $type
 173                                         .
 174                                         "&datas=" . uri_escape( $payload )
 175                                         .
 176                                         "&header=" . uri_escape( $udh )
 177                                         ;
 178
 179         # $urlstring = 'http://www.m3.be/scripts/httpgate1.cfm?login=vdb&password=xserd54&togsm=32475567606&oastring=MCUBE&type=1&datas=Hello+World';
 180
 181         print "$urlstring\n";
 182
 183         my $req = GET $urlstring;
 184         $req->header( Host => $url->host );
 185
 186         my $res = $ua->request($req);
 187
 188         print "#" x 80 . "\n";
 189         print $res->content;
 190         print "#" x 80 . "\n";
 191
 192         if ($res->is_success) {
 193                 my $content = $res->content;
 194                 $logger->logentry( "return: $content" ) if $logger;
 195                 return 0 if ($content=~/01/);
 196                 return -1;
 197         } else {
 198                 $logger->logentry( "error!" ) if $logger;
 199                 $logger->logentry( $res->error_as_HTML ) if $logger;
 200                 return -1;
 201         }
 202 }
 203
 204 sub serialize_to_hex {
 205     my ($self, $ud) = @_;
 206         my $msg;
 207
 208     while (length($ud)) {
 209        $msg .= sprintf("%.2X", ord(substr($ud,0,1)));
 210        $ud = substr($ud,1);
 211     }
 212     return $msg;
 213 }
 214
 215 sub _add_to_spool {
 216         my ($self, $msisdn, $pdu, $dir) = @_;
 217         local *F;
 218
 219         my $filename = $self->_create_spoolname($msisdn, $pdu);
 220         open F, ">".$dir."/".$filename;
 221         print F $pdu;
 222         CORE::close F;
 223 }
 224
 225
 226 sub _remove_from_spool {
 227         my ($self, $msisdn, $pdu, $dir) = @_;
 228
 229         my $filename =  $self->_create_spoolname($msisdn, $pdu);
 230         unlink( $dir."/".$filename );
 231 }
 232
 233 sub _create_spoolname {
 234         my ($self, $msisdn, $pdu) = @_;
 235
 236         $msisdn =~ s/^\+//;
 237         my $filename = $msisdn . "_" . $$ . time . substr($pdu,-32);
 238         return $filename;
 239 }
 240
 241 1;
 242
 243 =head1 NAME
 244
 245 GSM::SMS::Transport::MCube
 246
 247 =head1 DESCRIPTION
 248
 249 Implements a ( send-only ) transport for the MCube ss7 SMS gateway.
 250 Please visit www.mcube.be for getting an account.
 251
 252 Also can do PDU messages and as such can be used to send NBS messages.
 253
 254 =head1 AUTHOR
 255
 256 Johan Van den Brande <johan@vandenbrande.com>
 257
 258