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