Не помню, кто так сказал, но если за день Вы не узнали что-то новое — значит день прошел зря. В моем случае таких дней достаточно много, но сегодня он стал исключением:) Каким образом я решил попробовать написать что-то для Bluetooth уже не вспомню, скорее всего взгляд упал на телефон жены, а потом на индикатор на ноутбуке:) Сразу возник вопрос — а можно ли достучаться до телефона через Bluetooth из Perl?

Краткое гугление дало мне некоторые результаты, которыми я и хочу поделиться.

Сразу оговорюсь, что все нижесказанное было отработано на Linux(Fedora 7) и на Win работать не будет.

В Linux существует единая официальная библиотека для работы с Bluetooth-совместимыми устройствами — BlueZ(http://www.bluez.org/). Можно найти огромное количество разнообразных HOWTO, посвященных магии конфигурации, используя которые можно настроить практически все:)

Но не будем заострять внимание на настройке и перейдем к программированию. Поиск на CPAN изначально привел меня к модулю Net::Bluetooth. Он обеспечивает набор низкоуровневых функций, позволяющих провести сканирование для обнаружения устройств в радиусе действия, получить список поддерживаемых сервисов для указанного устройства. Кроме того, можно устанавливать соединение со службами на удаленном устройстве посредством открытия сокета.

Начал я с написания небольшой программы, проводящей сканирование.

use Net::Bluetooth; 
my $device_ref = get_remote_devices();
foreach my $addr (keys %$device_ref) {
     print "Адрес: $addr Имя: $device_ref->{$addr}\n";
}

После 10 секунд поисков, система вернула мне следующий список:

Адрес: 00:14:9A:8E:36:9D Имя: Motorola Phone5
Адрес: 00:12:D2:BE:2F:C2 Имя: hx2490

Адреса, извлеченные во время сканирования, можно использовать для установки соединения или же для дальнейшего поиска сервисов на самом устройстве.

Что же делать, после того, как мы узнали, кто есть вокруг?

Bluetooth поддерживает замечательную технологию RFCOMM — интерфейс, который позволяет значительно упростить обмен данными с устройствами. Упрощение достигается за счет представления соединения как высокоскоростного последовательного линка.
Немножко расширим программу — теперь она будет не только сканировать окрестности, но и выводить список доступных сервисов. Для этого воспользуемся функцией sdp_search.
sdp_search принимает три параметра — адрес устройства, ID сервиса и имя сервиса.

Функция возвращает массив указателей на хеш. Как раз эти хеши и содержать всю самую интересную информацию. Хеш формируется из следующих полей:

• SERVICE_NAME — название сервиса
• SERVICE_DESC — описание
• SERVICE_PROV — кто предоставляет услугу
• RFCOMM — номер порта для подключения по RFCOMM
• L2CAP — номер порта L2CAP

Так же может присутствовать поле UNKNOWN, описывающее любые нестандартные данные. Если какой-нибудь из ключей отсутствует, это значит что значения нет.

Переделываем программу так, чтобы получить список доступных сервисов на доступных устройствах:

#!/usr/bin/perl -w
use strict; 
use Net::Bluetooth; 
my $device_ref = get_remote_devices();
foreach my $addr (keys %$device_ref) {
    print "Адрес: $addr Название: $device_ref->{$addr}\n";
    my @sdp_array = sdp_search($addr, 0, "");
    foreach(@sdp_array) {
        print "Служба для $addr: ".$_->{SERVICE_NAME}."\n";
    }
}

На консоль было выведено:

Адрес: 00:14:9A:8E:36:9D Название: Motorola Phone5
Служба для 00:14:9A:8E:36:9D:
Служба для 00:14:9A:8E:36:9D: Dial-up networking Gateway
Служба для 00:14:9A:8E:36:9D: Voice Gateway
Служба для 00:14:9A:8E:36:9D: Hands-Free voice gateway
Служба для 00:14:9A:8E:36:9D: OBEX Object Push
Служба для 00:14:9A:8E:36:9D: OBEX File Transfer
Адрес: 00:12:D2:BE:2F:C2 Название: hx2490
Служба для 00:12:D2:BE:2F:C2: Доступ к сети
Служба для 00:12:D2:BE:2F:C2: Доступ к сети
Служба для 00:12:D2:BE:2F:C2: Последовательный порт
Служба для 00:12:D2:BE:2F:C2: Передача объектов OBEX
Служба для 00:12:D2:BE:2F:C2: Передача файлов OBEX
Служба для 00:12:D2:BE:2F:C2: Audio Gateway

Как видите, ничего глобально сложного нет. Кроме функций поиска, Net::Bluetooth позволяет устанавливать соединения, однако делается это, в отличие от функций поиска, в ОО-духе.

Предположим, мы хотим подключиться к телефону по протоколу OBEX для записи какой-то информации(или воровства личных файлов:)):

my $socket = Net::Bluetooth->newsocket("RFCOMM");
die "socket error $!\n" unless(defined($socket));
if($socket->connect($address, 9) != 0) {
    die "connect error: $!\n";
}

*CLIENT = $socket->perlfh();
#Какой-то код
read(CLIENT, $buffer, 256);

Используя Net::Bluetooth, можно не только подключаться к удаленным устройствам, но и самому предоставлять сервисы. Приведу небольшой пример(я пропустил обработку ошибок)

my $server =  Net::Bluetooth->newsocket("RFCOMM");
#Подключаемся к первому порту
$server->bind(1);
$server->listen(2);
my $service = Net::Bluetooth->newservice($server, "1101", "GPS", "GPS Receiver");
#Обрабатываем входящие подключения
my $client = $server->accept();
#Извлекаем информацию о клиенте
my ($address, $name) = $client->getpeername();
#Получаем указатель
*CLIENT = $client->perlfh();
##
##Работаем с клиентом
##
#Корректно выходим
$client->close();
$service->stopservice();
$server->close();

Net::Bluetooth обеспечивает исключительно низкоуровневый доступ, что не всегда удобно. Конечно, все зависит от того, что нужно делать — шуровать по другим мобильный телефонам или же обеспечивать сервис для сторонних клиентов. В первом случае проще будет воспользоваться наработками по протоколу OBEX(OBject Exchange). Я нашел неплохой модуль, представляющий собой надстройку над библиотекой OpenOBEX(http://dev.zuckschwerdt.org/openobex/), которая позволяет выполнить следующие действия(названия говорят сами за себя):

• connect
• disconnect
• chpath
• mkpath
• cdup
• cdtop
• get
• list
• vget_capability
• put_file
• put_data
• delete

Приведу небольшой пример:

#!/usr/bin/perl
use strict;
use OBEXFTP;
my $client = new OBEXFTP::client($OBEXFTP::BLUETOOTH);
my $ret $client->connect("00:14:9A:8E:36:9D", 9);
$ret = $cli->list("/");
print "$ret\n";

#Список будет представлен в формате XML:

<?xml version="1.0" ?>
<!DOCTYPE folder-listing SYSTEM "obex-folder-listing.dtd">
<folder-listing>
<parent-folder />
    <folder name="audio" size="0" type="folder" modified="19700101T000000Z" user-perm="RW" />
    <folder name="video" size="0" type="folder" modified="19700101T000000Z" user-perm="RW" />
    <folder name="picture" size="0" type="folder" modified="19700101T000000Z" user-perm="RW" />
</folder-listing>

#Перейдем в директорию picture
$ret = $cli->list("/picture");
print "$ret\n";

Вывод:

<?xml version="1.0" ?>
<!DOCTYPE folder-listing SYSTEM "obex-folder-listing.dtd">
    <folder-listing>
<parent-folder />
        <file name="12-25-05_1847.jpg" size="18973" type="image/jpeg" modified="20051225T184731Z" user-perm="RW" />
        <file name="porosya..gif" size="20329" type="image/gif" modified="20060731T143909Z" user-perm="RW" />
        <file name="Angel.jpg" size="10003" type="image/jpeg" modified="20060712T092342Z" user-perm="RW" />
        <file name="22-12-07_1502.jpg" size="15335" type="image/jpeg" modified="20071222T150235Z" user-perm="RW" />
        <file name="sobaki.jpg" size="20791" type="image/jpeg" modified="20060904T044022Z" user-perm="RW" />
        <file name="09-12-07_1805.jpg" size="32151" type="image/jpeg" modified="20071209T180513Z" user-perm="RW" />
        <file name="cow_.gif" size="12075" type="image/gif" modified="20060512T154435Z" user-perm="RW" />
        <file name="21-07-07_1856.jpg" size="33900" type="image/jpeg" modified="20070721T185625Z" user-perm="RW" />
        <file name="22-12-07_1503.jpg" size="14280" type="image/jpeg" modified="20071222T150251Z" user-perm="RW" />
    </folder-listing>

#Выходим
$ret = $cli->disconnect();
$client->DESTROY();

Вот, пожалуй, и все. Не сильно много, за бортом остался практически весь OBEX и L2CAP, однако основной цели я достиг — показать, что perl можно использовать в качестве языка разработки под Bluetooth-ориентированные задачи.

Гулько Сергей