From 8d352b5a47a12e042ff22eb68e9f674d3d7df3d5 Mon Sep 17 00:00:00 2001 From: Lubomir Rintel Date: Mon, 30 Sep 2019 16:02:08 +0200 Subject: contrib: add a Bluetooth DUN modem emulator Useful for quickly testing Bluetooth DUN support. Duplicates some modemu.pl logic, but hey... https://gitlab.freedesktop.org/NetworkManager/NetworkManager/merge_requests/297 --- contrib/test/btmodem.pl | 291 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 291 insertions(+) create mode 100644 contrib/test/btmodem.pl (limited to 'contrib') diff --git a/contrib/test/btmodem.pl b/contrib/test/btmodem.pl new file mode 100644 index 0000000000..7e05233e07 --- /dev/null +++ b/contrib/test/btmodem.pl @@ -0,0 +1,291 @@ +#!/usr/bin/env perl +# SPDX-License-Identifier: GPL-2.0+ + +# Copyright 2019 Red Hat, Inc. + +# $ perldoc btmodem.pl if you'd like to read the manual, poor you: + +=head1 NAME + +btmodem.pl - emulate a bluetooth DUN modem + +=head1 SYNOPSIS + +btmodem.pl [] [-- ...] + +=head1 DESCRIPTION + +B registers a Bluetooth DUN profile with Bluez, accepts incoming +connections and pretends there's modem there. + +It answers a basic subset of AT commands, sufficient making ModemManager +recognize it as a 3GPP capable modem registered to a network. + +Upon receiving the dial (ATD) command, it spawns C so that +NetworkManager can establish a connection. + +=head1 OPTIONS + +=over 4 + +=item B<< >> + +Create a service on this particular HCI. + +Defaults to I. + +=item B<< >> + +Specifies extra arguments to be prepended before C to the default +set of I. + +Defaults to I. + +=back + +=cut + +use strict; +use warnings; + +use IO::Handle; +use Net::DBus; +use Net::DBus::Reactor; + +# Parse command line arguments +my $hci_name; +my @pppd = qw/pppd noauth dump debug 172.31.82.1:172.31.82.2/; +while (@ARGV) { + $_ = shift @ARGV; + if ($_ eq '--') { + @pppd = @ARGV; + last; + } else { + die "Extra argument: '$_'" if $hci_name; + $hci_name = $_; + } +}; +$hci_name ||= 'hci0'; + +sub modemu +{ + my $fh = shift; + + while (<$fh>) { + chomp; + + if (/^AT$/ or /^ATE0$/ or /^ATV1$/ or /^AT\+CMEE=1$/ or /^ATX4$/ or /^AT&C1$/ or /^ATZ$/) { + # Standard Hayes commands that are basically used to + # ensure the modem is in a known state. Accept them all. + print $fh "\r\n"; + print $fh "OK\r\n"; + + } elsif (/^AT\+CPIN\?$/) { + # PIN unlocked. Required. + print $fh "\r\n"; + print $fh "+CPIN:READY\r\n"; + print $fh "\r\n"; + print $fh "OK\r\n"; + + } elsif (/^AT\+COPS=0$/) { + # Select access technology (we just accept 0=automatic) + print $fh "\r\n"; + print $fh "OK\r\n"; + + } elsif (/^AT\+CGREG\?$/) { + # 3GPP Registration status. + print $fh "\r\n"; + print $fh "+CGREG: 0,1\r\n"; + print $fh "\r\n"; + print $fh "OK\r\n"; + + } elsif (/^AT\+CGDCONT=\?$/) { + # Get supported PDP contexts + print $fh "\r\n"; + print $fh "+CGDCONT: (1-10),(\"IP\"),,,(0-1),(0-1)\r\n"; + print $fh "+CGDCONT: (1-10),(\"IPV6\"),,,(0-1),(0-1)\r\n"; + print $fh "OK\r\n"; + + } elsif (/^AT\+CGACT=0,1$/) { + # Activate a PDP context + print $fh "\r\n"; + print $fh "OK\r\n"; + + } elsif (/^AT\+CGDCONT=1,"(.*)","(.*)"$/) { + # Set PDP context. We accept any. + print $fh "\r\n"; + print $fh "OK\r\n"; + + } elsif (/^ATD/) { + print $fh "\r\n"; + print $fh "CONNECT 28800000\r\n"; + + my $ppp = fork; + die "Can't fork: $!" unless defined $ppp; + if ($ppp == 0) { + close STDIN; + close STDOUT; + open STDIN, '<&', $fh or die "Can't dup pty to a pppd stdin: $!"; + open STDOUT, '>&', $fh or die "Can't dup pty to a pppd stdout: $!"; + close $fh; + exec @pppd, qw/nodetach notty local logfd 2 nopersist/; + die "Can't exec pppd: $!"; + } + waitpid $ppp, 0; + } else { + print $fh "\r\n"; + print $fh "ERROR\r\n"; + } + } +} + +my $bus = Net::DBus->system; + +$bus->get_connection->register_object_path("/", sub { + my $bus = shift; + my $call = shift; + + # We only support the NewConnection call + next unless $call->get_type eq &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_CALL; + if ( $call->get_interface ne 'org.bluez.Profile1' + or $call->get_path ne '/' + or $call->get_member ne 'NewConnection' + or $call->get_signature ne 'oha{sv}') { + + $bus->send ($bus->make_error_message ( + replyto => $call, + name => ' org.freedesktop.DBus.Error.Failed', + description => "Forgive me caller for I don't know what to do")); + next; + } + + my ($path, $fd, $args) = $call->get_args_list; + open (my $fh, "+>&=", $fd) or die $!; + + my $pid = fork; + die unless defined $pid; + + if ($pid == 0) { + # This allows us to use buffered read for lines from ModemManager + # despite not ending with \n + IO::Handle->input_record_separator ("\r"); + $fh->autoflush (1); + $fh->blocking (1); + modemu ($fh); + exit 0; + die; + } + + $bus->send ($bus->make_method_return_message ($call)) + unless $call->get_no_reply; +}); + +my $bluez = $bus->get_service ('org.bluez'); +my $profile_manager = $bluez->get_object ('/org/bluez', 'org.bluez.ProfileManager1'); + +$profile_manager->RegisterProfile('/', '00001103-0000-1000-8000-00805f9b34fb', {}); + +Net::DBus::Reactor->main->run; + +=head1 SETTING UP BLUETOOTH + +In order for this script useful, you need to have two Bluetooth interfaces +paired together. It's somewhat easier if you've got two machines to test. + +The pairing can be done withing the C shell. Launch it after +you started C, so that the right profile UUIDs are discovered +by the client. These commands come in handy: + +=over + +=item [bluetooth]# B + +This makes C ask for pairing PIN in the shell session. That is +useful if you're ssh-ing into a machine instead of using a desktop shell with +its own agent. Run this on both machines. + +=item [bluetooth]# B + +Broadcast the server service. You don't need to run this on the client. + +=item [bluetooth]# B + +Turn on discovery of the devices. You need to don't run this on the server. + +After you've turned the discovery on, wait for a minute or so for your +server to get discovered. + +=item [bluetooth]# B + +List the known devices, both those who've been discovered and those that have +been paired with. + +=item [bluetooth]# B + +Initiate the pairing. Run it from the machine that has scanning enabled. +Assumes your server is C<00:AA:01:00:00:23> -- check your real address with the +C command. + +After a short while, you should see the pairing confirmation prompt on both machines. + +=item [bluetooth]# B + +Allow incoming connections from C<00:AA:01:00:00:24>. Run this on the server. + +=item B + +If everything went right, you can now connect. + +=back + +=head1 EXAMPLES + +=over + +=item B + +Just emulate a DUN modem on I, with the default PPP arguments. + +=item B + +Same as above, just on the I interface. + +=item B + +Avoid polluting the namespace with the modem end of PPP connection. + +=item B + +Override the C parameters: no debug logging and different set of +addresses. + +=item B + +Same as above, with a modem name different from default. + +=back + +=head1 BUGS + +Haha. You tell me. + +=head1 SEE ALSO + +L, L, C + +=head1 COPYRIGHT + +Copyright 2019 Lubomir Rintel + +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 2 of the License, or +(at your option) any later version. + +=head1 AUTHOR + +Lubomir Rintel C + +Like, it's me who wrote it, but if you're running it it's your problem. + +=cut -- cgit v1.2.1