config/cfgroot/modem-lib.pl

   1 #!/usr/bin/perl
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2014 IPFire Team  <info@ipfire.org>                           #
   6 #                                                                             #
   7 # This program is free software: you can redistribute it and/or modify        #
   8 # it under the terms of the GNU General Public License as published by        #
   9 # the Free Software Foundation, either version 3 of the License, or           #
  10 # (at your option) any later version.                                         #
  11 #                                                                             #
  12 # This program is distributed in the hope that it will be useful,             #
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of              #
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
  15 # GNU General Public License for more details.                                #
  16 #                                                                             #
  17 # You should have received a copy of the GNU General Public License           #
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
  19 #                                                                             #
  20 ###############################################################################
  21
  22 use Device::Modem;
  23
  24 package Modem;
  25
  26 sub new() {
  27         my $class = shift;
  28
  29         my $port = shift;
  30         my $baud = shift;
  31
  32         my $self = {};
  33         bless $self, $class;
  34
  35         # Initialize the connetion to the modem.
  36         my $ret = $self->_initialize($port, $baud);
  37         if ($ret) {
  38                 return undef;
  39         }
  40
  41         if ($self->_is_working()) {
  42                 return $self;
  43         }
  44
  45         return undef;
  46 }
  47
  48 sub DESTROY() {
  49         my $self = shift;
  50
  51         # Close connection to modem.
  52         if ($self->{modem}) {
  53                 $self->{modem}->close();
  54         }
  55 }
  56
  57 sub _initialize() {
  58         my ($self, $port, $baud) = @_;
  59
  60         # Check if the character device actually exists.
  61         if (! -c $port) {
  62                 return 1;
  63         }
  64
  65         # Establish connection to the modem.
  66         $self->{modem} = new Device::Modem(port => $port);
  67         $self->{modem}->connect(baudrate => $baud);
  68
  69         return 0;
  70 }
  71
  72 sub _is_working() {
  73         my $self = shift;
  74
  75         # Check if the modem responds to AT commands.
  76         $self->{modem}->atsend("AT\r\n");
  77
  78         my $response = $self->{modem}->answer();
  79         return ($response eq "OK");
  80 }
  81
  82 sub _command() {
  83         my $self = shift;
  84         my $cmd  = shift;
  85
  86         # Terminate the AT command with newline.
  87         $cmd .= "\r\n";
  88
  89         $self->{modem}->atsend($cmd);
  90
  91         my $response = $self->{modem}->answer();
  92         my @response = split(/\n/, $response);
  93
  94         # Trim leading and trailing spaces.
  95         foreach my $line (@response) {
  96                 $line =~ s/^\s+|\s+$//g;
  97                 chomp($line);
  98         }
  99
 100         my $last_element = pop(@response);
 101         unless ($last_element eq "OK") {
 102                 push(@response, $last_element);
 103         }
 104
 105         $response = join("\n", @response);
 106
 107         return $self->_trim($response);
 108 }
 109
 110 sub _trim() {
 111         my $self = shift;
 112         my $input = shift;
 113
 114         my $first_char = substr($input, 0, 1);
 115         if ($first_char eq "+") {
 116                 my @output = split(/:/, $input);
 117                 if ($#output == 1) {
 118                         return $output[1];
 119                 }
 120         }
 121
 122         return $input;
 123 }
 124
 125 sub get_vendor() {
 126         my $self = shift;
 127
 128         return $self->_command("AT+GMI");
 129 }
 130
 131 sub get_model() {
 132         my $self = shift;
 133
 134         return $self->_command("AT+GMM");
 135 }
 136
 137 sub get_software_version() {
 138         my $self = shift;
 139
 140         return $self->_command("AT+GMR");
 141 }
 142
 143 sub get_imei() {
 144         my $self = shift;
 145
 146         return $self->_command("AT+GSN");
 147 }
 148
 149 sub get_capabilities() {
 150         my $self = shift;
 151
 152         my $output = $self->_command("AT+GCAP");
 153         return split(/,/, $output);
 154 }
 155
 156 sub is_sim_unlocked() {
 157         my $self = shift;
 158
 159         # TODO
 160         return 1;
 161 }
 162
 163 sub get_sim_imsi() {
 164         my $self = shift;
 165
 166         if ($self->is_sim_unlocked()) {
 167                 return $self->_command("AT+CIMI");
 168         }
 169 }
 170
 171 sub get_network_registration() {
 172         my $self = shift;
 173
 174         my @elements;
 175         foreach my $i ([0, 1]) {
 176                 my $output = $self->_command("AT+CREG?");
 177
 178                 @elements = split(/,/, $output);
 179                 if ($#elements != 2) {
 180                         # Output in wrong format. Resetting.
 181                         $self->_command("AT+CREG=0");
 182                 }
 183         }
 184
 185         if ($elements[0] == 0) {
 186                 if ($elements[1] == 0) {
 187                         return "NOT REGISTERED, NOT SEARCHING";
 188                 } elsif ($elements[1] == 1) {
 189                         return "REGISTERED TO HOME NETWORK";
 190                 } elsif ($elements[1] == 2) {
 191                         return "NOT REGISTERED, SEARCHING";
 192                 } elsif ($elements[1] == 3) {
 193                         return "REGISTRATION DENIED";
 194                 } elsif ($elements[1] == 5) {
 195                         return "REGISTERED, ROAMING";
 196                 } else {
 197                         return "UNKNOWN";
 198                 }
 199         }
 200 }
 201
 202 sub _get_network_operator() {
 203         my $self = shift;
 204
 205         my $output = $self->_command("AT+COPS?");
 206         $output =~ s/\"//g;
 207
 208         my @elements = split(/,/, $output);
 209         if ($#elements == 3) {
 210                 return @elements;
 211         }
 212 }
 213
 214 sub get_network_operator() {
 215         my $self = shift;
 216
 217         my ($mode, $format, $operator, $act) = $self->_get_network_operator();
 218
 219         return $operator;
 220 }
 221
 222 sub get_network_mode() {
 223         my $self = shift;
 224
 225         my ($mode, $format, $operator, $act) = $self->_get_network_operator();
 226
 227         if ($act == 0) {
 228                 return "GSM";
 229         } elsif ($act == 1) {
 230                 return "Compact GSM";
 231         } elsif ($act == 2) {
 232                 return "UMTS";
 233         } elsif ($act == 3) {
 234                 return "GSM WITH EGPRS";
 235         } elsif ($act == 4) {
 236                 return "UMTS WITH HSDPA";
 237         } elsif ($act == 5) {
 238                 return "UMTS WITH HSUPA";
 239         } elsif ($act == 6) {
 240                 return "UMTS WITH HSDPA+HSUPA";
 241         } elsif ($act == 7) {
 242                 return "LTE";
 243         } else {
 244                 return "UNKNOWN ($act)";
 245         }
 246 }
 247
 248 sub _get_signal_quality() {
 249         my $self = shift;
 250
 251         my $output = $self->_command("AT+CSQ");
 252
 253         my @elements = split(/,/, $output);
 254         if ($#elements == 1) {
 255                 return @elements;
 256         }
 257 }
 258
 259 sub get_signal_quality() {
 260         my $self = shift;
 261
 262         my ($rssi, $ber) = $self->_get_signal_quality();
 263
 264         # 99 equals unknown.
 265         unless ($rssi == 99) {
 266                 my $dbm = ($rssi * 2) - 113;
 267                 return $dbm;
 268         }
 269
 270         return undef;
 271 }
 272
 273 sub get_bit_error_rate() {
 274         my $self = shift;
 275
 276         my ($rssi, $ber) = $self->_get_signal_quality();
 277
 278         # 99 indicates unknown.
 279         unless ($ber == 99) {
 280                 return $ber;
 281         }
 282
 283         return undef;
 284 }
 285
 286 1;