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->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->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->phonenum ne $old->phonenum ) {
  66     my @command = (
  67       'MOD ISDN',
  68       ISDN    => '"'.$old->phonenum.'"',
  69       NEWISDN => '"'.$new->phonenum.'"',
  70     );
  71     my $err_or_queue = $self->queue_command($new->svcnum, @command);
  72     return $err_or_queue unless ref $err_or_queue;
  73     if ( $depend_jobnum ) {
  74       my $error = $err_or_queue->depend_insert($depend_jobnum);
  75       return $error if $error;
  76     }
  77   }
  78   # no other svc_phone changes need to be exported
  79   '';
  80 }
  81
  82 sub _export_suspend {
  83   my( $self, $svc_phone ) = (shift, shift);
  84   $self->_export_lock($svc_phone, 'TRUE');
  85 }
  86
  87 sub _export_unsuspend {
  88   my( $self, $svc_phone ) = (shift, shift);
  89   $self->_export_lock($svc_phone, 'FALSE');
  90 }
  91
  92 sub _export_lock {
  93   my ($self, $svc_phone, $lockstate) = @_;
  94   # XXX I'm not sure this actually suspends.  Need to test it.
  95   my @command = (
  96     'MOD LCK',
  97     IMSI    => '"'.$svc_phone->sim_imsi.'"',
  98     ISDN    => '"'.$svc_phone->phonenum.'"',
  99     IC      => $lockstate,
 100     OC      => $lockstate,
 101     GPRSLOCK=> $lockstate,
 102   );
 103   my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
 104   ref($err_or_queue) ? '' : $err_or_queue;
 105 }
 106
 107 sub _export_delete {
 108   my( $self, $svc_phone ) = (shift, shift);
 109   my @command = (
 110     'RMV SUB',
 111     #IMSI    => '"'.$svc_phone->sim_imsi.'"',
 112     ISDN    => '"'.$svc_phone->phonenum.'"',
 113   );
 114   my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
 115   ref($err_or_queue) ? '' : $err_or_queue;
 116 }
 117
 118 sub queue_command {
 119   my ($self, $svcnum, @command) = @_;
 120   my $queue = FS::queue->new({
 121       svcnum  => $svcnum,
 122       job     => 'FS::part_export::huawei_hlr::run_command',
 123   });
 124   $queue->insert($self->exportnum, @command) || $queue;
 125 }
 126
 127 sub run_command {
 128   my ($exportnum, @command) = @_;
 129   my $self = FS::part_export->by_key($exportnum);
 130   my $socket = $self->login;
 131   my $result = $self->command($socket, @command);
 132   $self->logout($socket);
 133   $socket->close;
 134   die $result->{error} if $result->{error};
 135   '';
 136 }
 137
 138 sub login {
 139   my $self = shift;
 140   local $DEBUG = $self->option('debug') || 0;
 141   # Send a command to the SMU.
 142   # The caller is responsible for quoting string parameters.
 143   my %socket_param = (
 144     PeerAddr  => $self->machine,
 145     PeerPort  => 7777,
 146     Proto     => 'tcp',
 147     Timeout   => ($self->option('timeout') || 30),
 148   );
 149   warn "Connecting to ".$self->machine."...\n" if $DEBUG;
 150   warn Dumper(\%socket_param) if $DEBUG;
 151   my $socket = IO::Socket::INET->new(%socket_param)
 152     or die "Failed to connect: $!\n";
 153
 154   warn 'Logging in as "'.$self->option('opname').".\"\n" if $DEBUG;
 155   my @login_param = (
 156     OPNAME => '"'.$self->option('opname').'"',
 157     PWD    => '"'.$self->option('pwd').'"',
 158   );
 159   if ($self->option('HLRSN')) {
 160     unshift @login_param, 'HLRSN', $self->option('HLRSN');
 161   }
 162   my $login_result = $self->command($socket, 'LGI', @login_param);
 163   die $login_result->{error} if $login_result->{error};
 164   return $socket;
 165 }
 166
 167 sub logout {
 168   warn "Logging out.\n" if $DEBUG;
 169   my $self = shift;
 170   my ($socket) = @_;
 171   $self->command($socket, 'LGO');
 172   $socket->close;
 173 }
 174
 175 sub command {
 176   my $self = shift;
 177   my ($socket, $command, @param) = @_;
 178   my $string = $command . ':';
 179   while (@param) {
 180     $string .= shift(@param) . '=' . shift(@param);
 181     $string .= ',' if @param;
 182   }
 183   $string .= "\n;";
 184   my @result;
 185   eval { # timeout
 186     local $SIG{ALRM} = sub { die "timeout\n" };
 187     alarm ($self->option('timeout') || 120);
 188     warn "Sending to server:\n$string\n\n" if $DEBUG;
 189     $socket->print($string);
 190     warn "Received:\n";
 191     my $line;
 192     local $/ = "\r\n";
 193     do {
 194       $line = $socket->getline();
 195       warn $line if $DEBUG;
 196       chomp $line;
 197       push @result, $line if length($line);
 198     } until ( $line =~ /^---\s*END$/ or $socket->eof );
 199     alarm 0;
 200   };
 201   my %return;
 202   if ( $@ eq "timeout\n" ) {
 203     return { error => 'request timed out' };
 204   } elsif ( $@ ) {
 205     return { error => $@ };
 206   } else {
 207     #+++    HLR9820        <date> <time>\n
 208     my $header = shift(@result);
 209     $header =~ /(\+\+\+.*)/
 210       or return { error => 'malformed response: '.$header };
 211     $return{header} = $1;
 212     #SMU    #<serial number>\n
 213     $return{smu} = shift(@result);
 214     #%%<command string>%%\n
 215     $return{echo} = shift(@result); # should match the input
 216     #<message code>: <message description>\n
 217     my $message = shift(@result);
 218     if ($message =~ /^SUCCESS/) {
 219       $return{success} = $message;
 220     } else { #/^ERR/
 221       $return{error} = $message;
 222     }
 223     $return{trailer} = pop(@result);
 224     $return{details} = join("\n",@result,'');
 225   }
 226   \%return;
 227 }
 228
 229 1;