mirror of
https://github.com/vincentmli/bpfire.git
synced 2026-04-28 11:43:25 +02:00
Add modem status page.
On this page, much useful information is displayed about the hardware and the status of an LTE/3G or other kinds of modems that respond to AT commands.
This commit is contained in:
Michael Tremer
276
config/cfgroot/modem-lib.pl
Normal file
276
config/cfgroot/modem-lib.pl
Normal file
@@ -0,0 +1,276 @@
|
||||
#!/usr/bin/perl
|
||||
###############################################################################
|
||||
# #
|
||||
# IPFire.org - A linux based firewall #
|
||||
# Copyright (C) 2014 IPFire Team <info@ipfire.org> #
|
||||
# #
|
||||
# This program is free software: you can redistribute it and/or modify #
|
||||
# it under the terms of the GNU General Public License as published by #
|
||||
# the Free Software Foundation, either version 3 of the License, or #
|
||||
# (at your option) any later version. #
|
||||
# #
|
||||
# This program is distributed in the hope that it will be useful, #
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
|
||||
# GNU General Public License for more details. #
|
||||
# #
|
||||
# You should have received a copy of the GNU General Public License #
|
||||
# along with this program. If not, see <http://www.gnu.org/licenses/>. #
|
||||
# #
|
||||
###############################################################################
|
||||
|
||||
use Device::Modem;
|
||||
|
||||
package Modem;
|
||||
|
||||
sub new() {
|
||||
my $class = shift;
|
||||
|
||||
my $port = shift;
|
||||
my $baud = shift;
|
||||
|
||||
my $self = {};
|
||||
bless $self, $class;
|
||||
|
||||
# Initialize the connetion to the modem.
|
||||
$self->_initialize($port, $baud);
|
||||
|
||||
if ($self->_is_working()) {
|
||||
return $self;
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub DESTROY() {
|
||||
my $self = shift;
|
||||
|
||||
# Close connection to modem.
|
||||
if ($self->{modem}) {
|
||||
$self->{modem}->close();
|
||||
}
|
||||
}
|
||||
|
||||
sub _initialize() {
|
||||
my ($self, $port, $baud) = @_;
|
||||
|
||||
# Establish connection to the modem.
|
||||
$self->{modem} = new Device::Modem(port => $port);
|
||||
$self->{modem}->connect(baudrate => $baud);
|
||||
}
|
||||
|
||||
sub _is_working() {
|
||||
my $self = shift;
|
||||
|
||||
# Check if the modem responds to AT commands.
|
||||
$self->{modem}->atsend("AT\r\n");
|
||||
|
||||
my $response = $self->{modem}->answer();
|
||||
return ($response eq "OK");
|
||||
}
|
||||
|
||||
sub _command() {
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
# Terminate the AT command with newline.
|
||||
$cmd .= "\r\n";
|
||||
|
||||
$self->{modem}->atsend($cmd);
|
||||
|
||||
my $response = $self->{modem}->answer();
|
||||
my @response = split(/\n/, $response);
|
||||
|
||||
# Trim leading and trailing spaces.
|
||||
foreach my $line (@response) {
|
||||
$line =~ s/^\s+|\s+$//g;
|
||||
chomp($line);
|
||||
}
|
||||
|
||||
my $last_element = pop(@response);
|
||||
unless ($last_element eq "OK") {
|
||||
push(@response, $last_element);
|
||||
}
|
||||
|
||||
$response = join("\n", @response);
|
||||
|
||||
return $self->_trim($response);
|
||||
}
|
||||
|
||||
sub _trim() {
|
||||
my $self = shift;
|
||||
my $input = shift;
|
||||
|
||||
my $first_char = substr($input, 0, 1);
|
||||
if ($first_char eq "+") {
|
||||
my @output = split(/:/, $input);
|
||||
if ($#output == 1) {
|
||||
return $output[1];
|
||||
}
|
||||
}
|
||||
|
||||
return $input;
|
||||
}
|
||||
|
||||
sub get_vendor() {
|
||||
my $self = shift;
|
||||
|
||||
return $self->_command("AT+GMI");
|
||||
}
|
||||
|
||||
sub get_model() {
|
||||
my $self = shift;
|
||||
|
||||
return $self->_command("AT+GMM");
|
||||
}
|
||||
|
||||
sub get_software_version() {
|
||||
my $self = shift;
|
||||
|
||||
return $self->_command("AT+GMR");
|
||||
}
|
||||
|
||||
sub get_imei() {
|
||||
my $self = shift;
|
||||
|
||||
return $self->_command("AT+GSN");
|
||||
}
|
||||
|
||||
sub get_capabilities() {
|
||||
my $self = shift;
|
||||
|
||||
my $output = $self->_command("AT+GCAP");
|
||||
return split(/,/, $output);
|
||||
}
|
||||
|
||||
sub is_sim_unlocked() {
|
||||
my $self = shift;
|
||||
|
||||
# TODO
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub get_sim_imsi() {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->is_sim_unlocked()) {
|
||||
return $self->_command("AT+CIMI");
|
||||
}
|
||||
}
|
||||
|
||||
sub get_network_registration() {
|
||||
my $self = shift;
|
||||
|
||||
my @elements;
|
||||
foreach my $i ([0, 1]) {
|
||||
my $output = $self->_command("AT+CREG?");
|
||||
|
||||
@elements = split(/,/, $output);
|
||||
if ($#elements != 2) {
|
||||
# Output in wrong format. Resetting.
|
||||
$self->_command("AT+CREG=0");
|
||||
}
|
||||
}
|
||||
|
||||
if ($elements[0] == 0) {
|
||||
if ($elements[1] == 0) {
|
||||
return "NOT REGISTERED, NOT SEARCHING";
|
||||
} elsif ($elements[1] == 1) {
|
||||
return "REGISTERED TO HOME NETWORK";
|
||||
} elsif ($elements[1] == 2) {
|
||||
return "NOT REGISTERED, SEARCHING";
|
||||
} elsif ($elements[1] == 3) {
|
||||
return "REGISTRATION DENIED";
|
||||
} elsif ($elements[1] == 5) {
|
||||
return "REGISTERED, ROAMING";
|
||||
} else {
|
||||
return "UNKNOWN";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub _get_network_operator() {
|
||||
my $self = shift;
|
||||
|
||||
my $output = $self->_command("AT+COPS?");
|
||||
$output =~ s/\"//g;
|
||||
|
||||
my @elements = split(/,/, $output);
|
||||
if ($#elements == 3) {
|
||||
return @elements;
|
||||
}
|
||||
}
|
||||
|
||||
sub get_network_operator() {
|
||||
my $self = shift;
|
||||
|
||||
my ($mode, $format, $operator, $act) = $self->_get_network_operator();
|
||||
|
||||
return $operator;
|
||||
}
|
||||
|
||||
sub get_network_mode() {
|
||||
my $self = shift;
|
||||
|
||||
my ($mode, $format, $operator, $act) = $self->_get_network_operator();
|
||||
|
||||
if ($act == 0) {
|
||||
return "GSM";
|
||||
} elsif ($act == 1) {
|
||||
return "Compact GSM";
|
||||
} elsif ($act == 2) {
|
||||
return "UMTS";
|
||||
} elsif ($act == 3) {
|
||||
return "GSM WITH EGPRS";
|
||||
} elsif ($act == 4) {
|
||||
return "UMTS WITH HSDPA";
|
||||
} elsif ($act == 5) {
|
||||
return "UMTS WITH HSUPA";
|
||||
} elsif ($act == 6) {
|
||||
return "UMTS WITH HSDPA+HSUPA";
|
||||
} elsif ($act == 7) {
|
||||
return "LTE";
|
||||
} else {
|
||||
return "UNKNOWN ($act)";
|
||||
}
|
||||
}
|
||||
|
||||
sub _get_signal_quality() {
|
||||
my $self = shift;
|
||||
|
||||
my $output = $self->_command("AT+CSQ");
|
||||
|
||||
my @elements = split(/,/, $output);
|
||||
if ($#elements == 1) {
|
||||
return @elements;
|
||||
}
|
||||
}
|
||||
|
||||
sub get_signal_quality() {
|
||||
my $self = shift;
|
||||
|
||||
my ($rssi, $ber) = $self->_get_signal_quality();
|
||||
|
||||
# 99 equals unknown.
|
||||
unless ($rssi == 99) {
|
||||
my $dbm = ($rssi * 2) - 113;
|
||||
return $dbm;
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub get_bit_error_rate() {
|
||||
my $self = shift;
|
||||
|
||||
my ($rssi, $ber) = $self->_get_signal_quality();
|
||||
|
||||
# 99 indicates unknown.
|
||||
unless ($ber == 99) {
|
||||
return $ber;
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user