FS/FS/part_export/huawei_hlr.pm

   1 package FS::part_export::huawei_hlr;
   2
   3 use vars qw(@ISA %info $DEBUG $CACHE);
   4 use Tie::IxHash;
   5 use FS::Record qw(qsearch qsearchs dbh);
   6 use FS::part_export;
   7 use FS::svc_phone;
   8 use IO::Socket::INET;
   9 use Data::Dumper;
  10
  11 use strict;
  12
  13 $DEBUG = 0;
  14 @ISA = qw(FS::part_export);
  15
  16 tie my %options, 'Tie::IxHash',
  17   'opname'    => { label=>'Operator login' },
  18   'pwd'       => { label=>'Operator password' },
  19   'tplid'     => { label=>'Template number' },
  20   'hlrsn'     => { label=>'HLR serial number' },
  21   'timeout'   => { label=>'Timeout (seconds)', default => 120 },
  22   'debug'     => { label=>'Enable debugging', type=>'checkbox' },
  23 ;
  24
  25 %info = (
  26   'svc'     => 'svc_phone',
  27   'desc'    => 'Provision mobile phone service to Huawei HLR9820',
  28   'options' => \%options,
  29   'notes'   => <<'END'
  30 Connects to a Huawei Subscriber Management Unit via TCP and configures mobile
  31 phone services according to a template.  The <i>sim_imsi</i> field must be
  32 set on the service, and the template must exist.
  33 END
  34 );
  35
  36 sub _export_insert {
  37   my( $self, $svc_phone ) = (shift, shift);
  38   # svc_phone::check should ensure phonenum and sim_imsi are numeric
  39   my @command = (
  40     IMSI   => '"'.$svc_phone->sim_imsi.'"',
  41     ISDN   => '"'.$svc_phone->countrycode.$svc_phone->phonenum.'"',
  42     TPLID  => $self->option('tplid'),
  43   );
  44   unshift @command, 'HLRSN', $self->option('hlrsn')
  45     if $self->option('hlrsn');
  46   unshift @command, 'ADD TPLSUB';
  47   my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
  48   ref($err_or_queue) ? '' : $err_or_queue;
  49 }
  50
  51 sub _export_replace  {
  52   my( $self, $new, $old ) = @_;
  53   my $depend_jobnum;
  54   if ( $new->sim_imsi ne $old->sim_imsi ) {
  55     my @command = (
  56       'MOD IMSI',
  57       ISDN    => '"'.$old->countrycode.$old->phonenum.'"',
  58       IMSI    => '"'.$old->sim_imsi.'"',
  59       NEWIMSI => '"'.$new->sim_imsi.'"',
  60     );
  61     my $err_or_queue = $self->queue_command($new->svcnum, @command);
  62     return $err_or_queue unless ref $err_or_queue;
  63     $depend_jobnum = $err_or_queue->jobnum;
  64   }
  65   if ( $new->countrycode ne $old->countrycode or
  66        $new->phonenum ne $old->phonenum ) {
  67     my @command = (
  68       'MOD ISDN',
  69       ISDN    => '"'.$old->countrycode.$old->phonenum.'"',
  70       NEWISDN => '"'.$new->countrycode.$new->phonenum.'"',
  71     );
  72     my $err_or_queue = $self->queue_command($new->svcnum, @command);
  73     return $err_or_queue unless ref $err_or_queue;
  74     if ( $depend_jobnum ) {
  75       my $error = $err_or_queue->depend_insert($depend_jobnum);
  76       return $error if $error;
  77     }
  78   }
  79   # no other svc_phone changes need to be exported
  80   '';
  81 }
  82
  83 sub _export_suspend {
  84   my( $self, $svc_phone ) = (shift, shift);
  85   $self->_export_lock($svc_phone, 'TRUE');
  86 }
  87
  88 sub _export_unsuspend {
  89   my( $self, $svc_phone ) = (shift, shift);
  90   $self->_export_lock($svc_phone, 'FALSE');
  91 }
  92
  93 sub _export_lock {
  94   my ($self, $svc_phone, $lockstate) = @_;
  95   # XXX I'm not sure this actually suspends.  Need to test it.
  96   my @command = (
  97     'MOD LCK',
  98     IMSI    => '"'.$svc_phone->sim_imsi.'"',
  99     ISDN    => '"'.$svc_phone->countrycode.$svc_phone->phonenum.'"',
 100     IC      => $lockstate,
 101     OC      => $lockstate,
 102     GPRSLOCK=> $lockstate,
 103   );
 104   my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
 105   ref($err_or_queue) ? '' : $err_or_queue;
 106 }
 107
 108 sub _export_delete {
 109   my( $self, $svc_phone ) = (shift, shift);
 110   my @command = (
 111     'RMV SUB',
 112     #IMSI    => '"'.$svc_phone->sim_imsi.'"',
 113     ISDN    => '"'.$svc_phone->countrycode.$svc_phone->phonenum.'"',
 114   );
 115   my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
 116   ref($err_or_queue) ? '' : $err_or_queue;
 117 }
 118
 119 sub queue_command {
 120   my ($self, $svcnum, @command) = @_;
 121   my $queue = FS::queue->new({
 122       svcnum  => $svcnum,
 123       job     => 'FS::part_export::huawei_hlr::run_command',
 124   });
 125   $queue->insert($self->exportnum, @command) || $queue;
 126 }
 127
 128 sub run_command {
 129   my ($exportnum, @command) = @_;
 130   my $self = FS::part_export->by_key($exportnum);
 131   my $socket = $self->login;
 132   my $result = $self->command($socket, @command);
 133   $self->logout($socket);
 134   $socket->close;
 135   die $result->{error} if $result->{error};
 136   '';
 137 }
 138
 139 sub login {
 140   my $self = shift;
 141   local $DEBUG = $self->option('debug') || 0;
 142   # Send a command to the SMU.
 143   # The caller is responsible for quoting string parameters.
 144   my %socket_param = (
 145     PeerAddr  => $self->machine,
 146     PeerPort  => 7777,
 147     Proto     => 'tcp',
 148     Timeout   => ($self->option('timeout') || 30),
 149   );
 150   warn "Connecting to ".$self->machine."...\n" if $DEBUG;
 151   warn Dumper(\%socket_param) if $DEBUG;
 152   my $socket = IO::Socket::INET->new(%socket_param)
 153     or die "Failed to connect: $!\n";
 154
 155   warn 'Logging in as "'.$self->option('opname').".\"\n" if $DEBUG;
 156   my @login_param = (
 157     OPNAME => '"'.$self->option('opname').'"',
 158     PWD    => '"'.$self->option('pwd').'"',
 159   );
 160   if ($self->option('HLRSN')) {
 161     unshift @login_param, 'HLRSN', $self->option('HLRSN');
 162   }
 163   my $login_result = $self->command($socket, 'LGI', @login_param);
 164   die $login_result->{error} if $login_result->{error};
 165   return $socket;
 166 }
 167
 168 sub logout {
 169   warn "Logging out.\n" if $DEBUG;
 170   my $self = shift;
 171   my ($socket) = @_;
 172   $self->command($socket, 'LGO');
 173   $socket->close;
 174 }
 175
 176 sub command {
 177   my $self = shift;
 178   my ($socket, $command, @param) = @_;
 179   my $string = $command . ':';
 180   while (@param) {
 181     $string .= shift(@param) . '=' . shift(@param);
 182     $string .= ',' if @param;
 183   }
 184   $string .= "\n;";
 185   my @result;
 186   eval { # timeout
 187     local $SIG{ALRM} = sub { die "timeout\n" };
 188     alarm ($self->option('timeout') || 120);
 189     warn "Sending to server:\n$string\n\n" if $DEBUG;
 190     $socket->print($string);
 191     warn "Received:\n";
 192     my $line;
 193     local $/ = "\r\n";
 194     do {
 195       $line = $socket->getline();
 196       warn $line if $DEBUG;
 197       chomp $line;
 198       push @result, $line if length($line);
 199     } until ( $line =~ /^---\s*END$/ or $socket->eof );
 200     alarm 0;
 201   };
 202   my %return;
 203   if ( $@ eq "timeout\n" ) {
 204     return { error => 'request timed out' };
 205   } elsif ( $@ ) {
 206     return { error => $@ };
 207   } else {
 208     #+++    HLR9820        <date> <time>\n
 209     my $header = shift(@result);
 210     $header =~ /(\+\+\+.*)/
 211       or return { error => 'malformed response: '.$header };
 212     $return{header} = $1;
 213     #SMU    #<serial number>\n
 214     $return{smu} = shift(@result);
 215     #%%<command string>%%\n
 216     $return{echo} = shift(@result); # should match the input
 217     #<message code>: <message description>\n
 218     my $message = shift(@result);
 219     if ($message =~ /^SUCCESS/) {
 220       $return{success} = $message;
 221     } else { #/^ERR/
 222       $return{error} = $message;
 223     }
 224     $return{trailer} = pop(@result);
 225     $return{details} = join("\n",@result,'');
 226   }
 227   \%return;
 228 }
 229
 230 1;