Net-Bluetooth-0.41/000755 000766 000024 00000000000 12437103723 014564 5ustar00adutkostaff000000 000000 Net-Bluetooth-0.41/Bluetooth.pm000644 000766 000024 00000026550 12437103650 017076 0ustar00adutkostaff000000 000000 package Net::Bluetooth; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Carp; require Exporter; require DynaLoader; require 5.008; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(get_remote_devices sdp_search); $VERSION = '0.41'; bootstrap Net::Bluetooth $VERSION; _init(); END { _deinit(); } sub newsocket { my $class = shift; my $proto = shift; my $client = shift; my $addr = shift; my $self = {}; return if($proto !~ /^RFCOMM$|^L2CAP$/i); $self->{PROTO} = $proto; #### test this if(defined($client) && defined($addr)) { $self->{SOCK_FD} = $client; $self->{ADDR} = $addr; } else { my $sock = _socket($proto); return if($sock < 0); $self->{SOCK_FD} = $sock; } bless($self, $class); return $self; } sub connect { my $self = shift; my $addr = shift; my $port = shift; return -1 if(_connect($self->{SOCK_FD}, $addr, $port, $self->{PROTO}) < 0); $self->{ADDR} = $addr; $self->{PORT} = $port; return 0; } sub _debug { my $self = shift; print "addr: $self->{ADDR}\n"; print "sock: $self->{SOCK_FD}\n"; print "proto: $self->{PROTO}\n"; } sub bind { my $self = shift; my $port = shift; return -1 if(_bind($self->{SOCK_FD}, $port, $self->{PROTO}) < 0); $self->{PORT} = $port; return 0; } sub listen { my $self = shift; my $backlog = shift; return -1 if(_listen($self->{SOCK_FD}, $backlog) < 0); return 0; } sub accept { my $self = shift; my ($client, $addr) = _accept($self->{SOCK_FD}, $self->{PROTO}); return if($client < 0); return(Net::Bluetooth->newsocket($self->{PROTO}, $client, $addr)); } sub close { my $self = shift; _close($self->{SOCK_FD}); $self->{SOCK_FD} = -1; } sub getpeername { my $self = shift; my ($addr, $port) = _getpeername($self->{SOCK_FD}, $self->{PROTO}); return($addr, $port); } sub perlfh { my $self = shift; *SOCK = _perlfh($self->{SOCK_FD}); return *SOCK; } sub fileno { my $self = shift; return($self->{SOCK_FD}); } #### register a service sub newservice { my $class = shift; my $server_obj = shift; my $service_id = shift; my $name = shift; my $desc = shift; my $self = {}; my $result = 0; return unless(exists($server_obj->{PORT})); $self->{PROTO} = $server_obj->{PROTO}; $self->{SERVER_FD} = $server_obj->{SOCK_FD}; $self->{PORT} = $server_obj->{PORT}; $self->{SERVICE_ID} = $service_id; $self->{SERVICE_NAME} = $name; $self->{SERVICE_DESC} = $desc; #### On a system where we use service handles if(_use_service_handle()) { $result = _register_service_handle($self->{PROTO}, $self->{PORT}, $service_id, $name, $desc); $self->{SERVICE_HANDLE} = $result; } else { $result = _register_service($self->{SERVER_FD}, $self->{PROTO}, $self->{PORT}, $service_id, $name, $desc, 1); } #### 0 on error, return undef return if($result == 0); bless($self, $class); return $self; } sub stopservice { my $self = shift; if(_use_service_handle()) { _stop_service_handle($self->{SERVICE_HANDLE}); } else { _register_service($self->{SERVER_FD}, $self->{PROTO}, $self->{PORT}, $self->{SERVICE_ID}, $self->{SERVICE_NAME}, $self->{SERVICE_DESC}, 0); } } 1; __END__ =head1 NAME Net::Bluetooth - Perl Bluetooth Interface =head1 SYNOPSIS use Net::Bluetooth; #### list all remote devices in the area my $device_ref = get_remote_devices(); foreach $addr (keys %$device_ref) { print "Address: $addr Name: $device_ref->{$addr}\n"; } #### search for a specific service (0x1101) on a remote device my @sdp_array = sdp_search($addr, "1101", ""); #### foreach service record foreach $rec_ref (@sdp_array) { #### Print all available information for service foreach $attr (keys %$rec_ref) { print "Attribute: $attr Value: $rec_ref->{$attr}\n"; } } #### Create a RFCOMM client $obj = Net::Bluetooth->newsocket("RFCOMM"); die "socket error $!\n" unless(defined($obj)); if($obj->connect($addr, $port) != 0) { die "connect error: $!\n"; } #### create a Perl filehandle for reading and writing *SERVER = $obj->perlfh(); $amount = read(SERVER, $buf, 256); close(SERVER); #### create a RFCOMM server $obj = Net::Bluetooth->newsocket("RFCOMM"); #### bind to port 1 if($obj->bind(1) != 0) { die "bind error: $!\n"; } #### listen with a backlog of 2 if($obj->listen(2) != 0) { die "listen error: $!\n"; } #### register a service #### $obj must be a open and bound socket my $service_obj = Net::Bluetooth->newservice($obj, "1101", "GPS", "GPS Receiver"); unless(defined($service_obj)) { #### couldn't register service } #### accept a client connection $client_obj = $obj->accept(); unless(defined($client_obj)) { die "client accept failed: $!\n"; } #### get client information my ($caddr, $port) = $client_obj->getpeername(); #### create a Perl filehandle for reading and writing *CLIENT = $client_obj->perlfh(); print CLIENT "stuff"; #### close client connection close(CLIENT); #### stop advertising service $service_obj->stopservice(); #### close server connection $obj->close(); =head1 DESCRIPTION This module creates a Bluetooth interface for Perl. Net::Bluetooth works with the BlueZ libs as well as with Microsoft Windows. If you are going to be using a Unix system, the Bluez libs can be obtained at www.bluez.org. Please make sure these are installed and working properly before you install the module. Depending on your system BlueZ maybe already installed, or you may have to build it yourself and do some configuration. You can verify that BlueZ can detect devices and services with the utilities that are included with it (hciconfig, sdptool, hcitool, etc). If you are using Windows, please make sure you have Service Pack 2 installed and the Microsoft Platform SDK. Also please make sure the "$win_include" variable at the top of Makfile.PL is set properly. This needs to point to the SDK include directory for SP2. This is where the module will look for all the Bluetooth header files (ws2bth.h, etc). Please check out the samples included in the samples directory for more general information. =head1 FUNCTIONS =over 4 =item get_remote_devices() Searches for remote Bluetooth devices. The search will take approximately 5 - 10 seconds (This will be a configurable value in the future.). When finished, it will return a hash reference that contains the device address and name. The address is the key and the name is the value. Name will be set to "[unknown]" if the name could not be resolved. See the NOTES section of this document for more information about this. =item sdp_search($addr, $uuid, $name) This searches a specific device for service records. The first argument is the device address which is not optional. The uuid argument can be a valid uuid or "0". The name argument can be a valid service name or "". It will return services that match the uuid or service name if supplied, otherwise it will return all public service records for the device. The return value is a list which contains a hash reference for each service record found. The key/values for the hash are as follows: C: Service Name C: Service Description C: Service Provider C: RFCOMM Port C: L2CAP Port C: Unknown Protocol Port If any of the values are unavailable, the keys will not exist. If $addr is "localhost" the call will use the local SDP server. =back =head1 SOCKET OBJECT The bluetooth socket object is used to create bluetooth sockets and interface with them. There are two types of sockets supported, RFCOMM and L2CAP. The methods are listed below. =over 4 =item newsocket("RFCOMM") This constructs a socket object for a RFCOMM socket or L2CAP socket. =item connect($addr, $port) This calls the connect() system call with the address and port you supply. You can use this to connect to a server. Returns 0 on success. =item bind($port) This calls the bind() system call with the port you provide. You can use this to bind to a port if you are creating a server. Returns 0 on success. As a side note, RFCOMM ports can only range from 1 - 31. =item listen($backlog) This calls the listen() system call with the backlog you provide. Returns 0 on success. =item accept() This calls the accept() system call and creates a new bluetooth socket object which is returned. On failure it will return undef. =item perlfh() This call returns a Perl filehandle for a open socket. You can use the Perl filehandle as you would any other filehandle, except with Perl functions that use the socket address structure. This provides a easy way to do socket IO instead of doing it through the socket object. Currently this is the only way to do socket IO, although soon I will provide read/write calls through the object interface. =item close() This closes the socket object. This can also be done through the Perl close() call on a created Perl filehandle. =item getpeername() This returns the address and name for a open bluetooth socket. (BlueZ only for now) =back =head1 SERVICE OBJECT The service object allows you to register a service with your local SDP server. The methods are as follows: =over 4 =item newservice($obj, $service_uuid, $service_name, $service_desc) This registers a service with your local SDP server. The first argument is a open and bound socket that you created with newsocket(). The second argument is the service uuid. The third argument is the service name. The fourth argument is the service description. The return value is a new service object. This will be undefined if there was an error. =item stop_service() This unregisters your service with the local SDP server. The service will be unregistered without this call when the application exits. =back =head1 NOTES All uuids used with this module can either be 128 bit values: "00000000-0000-0000-0000-000000000000" or 16 bit values: "0000". All values must be represented as strings (enclosed in quotes), and must be hexadecimal values. Windows will not immediately return the device name if it is not already cached. Also there is no mechinism to alert the system when it has acquired the device name. Therefore you may have to call get_remote_devices() twice before the name shows up. I'll see if this can be handled better in the future. Currently on Windows the service name and description returned by sdp_search() are not setting their terminating NULL character properly. This can result in some garbage characters at the end of the string. I am looking at parsing the raw record to fix this problem. =head1 REQUIREMENTS You need BlueZ or Microsoft Service Pack 2 installed and the Microsoft Platform SDK. Windows needs at least Perl 5.8. =head1 AUTHOR Ian Guthrie IGuthrie@aol.com Copyright (c) 2006 Ian Guthrie. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1). =cut Net-Bluetooth-0.41/BlueZ.xs000644 000766 000024 00000043241 12437103442 016163 0ustar00adutkostaff000000 000000 #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include #include #include #include #include #include #include #include #include #ifdef __cplusplus } #endif typedef PerlIO * InOutStream; #define BROWSE_GROUP_STRING "1002" // Code from PyBlueZ int str2uuid(char *uuid_str, uuid_t *uuid) { uint32_t uuid_int[4]; char *endptr; if(strlen(uuid_str) == 36) { // Parse uuid128 standard format: 12345678-9012-3456-7890-123456789012 char buf[9] = { 0 }; if(uuid_str[8] != '-' && uuid_str[13] != '-' && uuid_str[18] != '-' && uuid_str[23] != '-') { return -1; } // first 8-bytes strncpy(buf, uuid_str, 8); uuid_int[0] = htonl(strtoul(buf, &endptr, 16)); if(endptr != buf + 8) return -1; // second 8-bytes strncpy(buf, uuid_str+9, 4); strncpy(buf+4, uuid_str+14, 4); uuid_int[1] = htonl(strtoul( buf, &endptr, 16)); if(endptr != buf + 8) return -1; // third 8-bytes strncpy(buf, uuid_str+19, 4); strncpy(buf+4, uuid_str+24, 4); uuid_int[2] = htonl(strtoul(buf, &endptr, 16)); if(endptr != buf + 8) return -1; // fourth 8-bytes strncpy(buf, uuid_str+28, 8); uuid_int[3] = htonl(strtoul(buf, &endptr, 16)); if(endptr != buf + 8) return -1; if(uuid != NULL) sdp_uuid128_create(uuid, uuid_int); } else if(strlen(uuid_str) == 8) { // 32-bit reserved UUID uint32_t i = strtoul(uuid_str, &endptr, 16); if(endptr != uuid_str + 8) return -1; if(uuid != NULL) sdp_uuid32_create(uuid, i); } else if(strlen(uuid_str) == 6) { // 16-bit reserved UUID with 0x on front if(uuid_str[0] == '0' && uuid_str[1] == 'x' || uuid_str[1] == 'X') { // move chars up uuid_str[0] = uuid_str[2]; uuid_str[1] = uuid_str[3]; uuid_str[2] = uuid_str[4]; uuid_str[3] = uuid_str[5]; uuid_str[4] = '\0'; int i = strtol(uuid_str, &endptr, 16); if(endptr != uuid_str + 4) return -1; if(uuid != NULL) sdp_uuid16_create(uuid, i); } else return(-1); } else if(strlen(uuid_str) == 4) { // 16-bit reserved UUID int i = strtol(uuid_str, &endptr, 16); if(endptr != uuid_str + 4) return -1; if(uuid != NULL) sdp_uuid16_create(uuid, i); } else { return -1; } return 0; } MODULE = Net::Bluetooth PACKAGE = Net::Bluetooth int _init() CODE: RETVAL = 0; OUTPUT: RETVAL int _deinit() CODE: RETVAL = 0; OUTPUT: RETVAL void _close(sock) int sock PPCODE: close(sock); InOutStream _perlfh(fd) int fd CODE: InOutStream fh = PerlIO_fdopen(fd, "r+"); RETVAL = fh; OUTPUT: RETVAL unsigned int _use_service_handle() CODE: // We use a service handle with BlueZ RETVAL = 1; OUTPUT: RETVAL void get_remote_devices(...) PPCODE: EXTEND(sp, 1); char addr[19]; char name[248]; char *local_addr; int len = 8; // 1.28 * len int max_rsp = 255; // max devices int flags = IREQ_CACHE_FLUSH; // flush cache of previously discovered devices int dev_id; bdaddr_t baddr; STRLEN n_a; if(items > 0) { local_addr = (char *) SvPV(ST(1), n_a); // str2ba always returns 0 str2ba(local_addr, &baddr); dev_id = hci_get_route(&baddr); } else { dev_id = hci_get_route(NULL); } if(dev_id < 0) { //croak("Invalid device ID returned\n"); XSRETURN_UNDEF; } int sock = hci_open_dev(dev_id); if(sock < 0) { //croak("Could not open device socket\n"); XSRETURN_UNDEF; } inquiry_info *ii = (inquiry_info*) malloc(max_rsp * sizeof(inquiry_info)); if(ii == NULL) { croak("malloc failed in get_remote_devices"); } int num_rsp = hci_inquiry(dev_id, len, max_rsp, NULL, &ii, flags); // hci_inquiry error or no devices found if(num_rsp <= 0) { free(ii); close(sock); XSRETURN_UNDEF; } HV *return_hash = newHV(); int i; for(i = 0; i < num_rsp; i++) { ba2str(&(ii+i)->bdaddr, addr); if(hci_read_remote_name(sock, &(ii+i)->bdaddr, sizeof(name), name, 0) < 0) strcpy(name, "[unknown]"); hv_store(return_hash, addr, strlen(addr), newSVpv(name, 0), 0); } free(ii); PUSHs(sv_2mortal(newRV_inc((SV*) return_hash))); close(sock); void sdp_search(addr, service, name) char *addr char *service char *name PPCODE: EXTEND(sp, 1); uuid_t svc_uuid; bdaddr_t target; sdp_list_t *response_list = NULL; sdp_session_t *session = 0; unsigned int portnum = 0; char local_host [] = "FF:FF:FF:00:00:00"; if(strcasecmp(addr, "localhost") == 0 || strcasecmp(addr, "local") == 0) str2ba(local_host, &target); else str2ba(addr, &target); // connect to remote or local SDP server session = sdp_connect(BDADDR_ANY, &target, SDP_RETRY_IF_BUSY); if(session == NULL) XSRETURN_UNDEF; // specify the UUID of the application we are searching for // convert the UUID string into a uuid_t // if service is not set, search for PUBLIC_BROWSE_GROUP if(service == NULL || strlen(service) == 0 || strlen(service) == 1 && *service == '0') { if(str2uuid(BROWSE_GROUP_STRING, &svc_uuid) != 0) { XSRETURN_UNDEF; } } else { if(str2uuid(service, &svc_uuid) != 0){ XSRETURN_UNDEF; } } sdp_list_t *search_list = sdp_list_append(NULL, &svc_uuid); uint32_t range = 0x0000FFFF; sdp_list_t *attrid_list = sdp_list_append(NULL, &range); // get a list of service records if(sdp_service_search_attr_req(session, search_list, SDP_ATTR_REQ_RANGE, attrid_list, &response_list) != 0) { sdp_list_free(search_list, 0); sdp_list_free(attrid_list, 0); XSRETURN_UNDEF; } sdp_list_t *r = response_list; // go through each of the service records // create a hash for each record that matches for(; r; r = r->next) { sdp_record_t *rec = (sdp_record_t*) r->data; sdp_list_t *proto_list; HV *return_hash = NULL; // get service name char buf[256]; if(sdp_get_service_name(rec, buf, sizeof(buf)) == 0) { // no name match requested if(!*name) { return_hash = newHV(); hv_store(return_hash, "SERVICE_NAME", strlen("SERVICE_NAME"), newSVpv(buf, 0), 0); } // name matches else if(strcasecmp(name, buf) == 0 ) { return_hash = newHV(); hv_store(return_hash, "SERVICE_NAME", strlen("SERVICE_NAME"), newSVpv(buf, 0), 0); } // name doesn't match, skip record else { sdp_record_free(rec); continue; } } else { // name doesn't match if(*name) { sdp_record_free(rec); continue; } else { // do not create the key } } // get service description if(sdp_get_service_desc(rec, buf, sizeof(buf)) == 0) { if(return_hash == NULL) return_hash = newHV(); hv_store(return_hash, "SERVICE_DESC", strlen("SERVICE_DESC"), newSVpv(buf, 0), 0); } else { // do not create the key } // get service provider name if(! sdp_get_provider_name(rec, buf, sizeof(buf)) == 0) { if(return_hash == NULL) return_hash = newHV(); hv_store(return_hash, "SERVICE_PROV", strlen("SERVICE_PROV"), newSVpv(buf, 0), 0); } else { // do not create the key } // get a list of the protocol sequences if(sdp_get_access_protos(rec, &proto_list) == 0) { sdp_list_t *p = proto_list; int port; if(return_hash == NULL) return_hash = newHV(); if((port = sdp_get_proto_port(p, RFCOMM_UUID)) != 0) { hv_store(return_hash, "RFCOMM", strlen("RFCOMM"), newSVuv(port), 0); } else if((port = sdp_get_proto_port(p, L2CAP_UUID)) != 0) { hv_store(return_hash, "L2CAP", strlen("L2CAP"), newSVuv(port), 0); } else { hv_store(return_hash, "UNKNOWN", strlen("UNKNOWN"), newSVuv(port), 0); } // sdp_get_access_protos allocates data on the heap for the // protocol list, so we need to free the results... for(; p; p = p->next) { sdp_list_free((sdp_list_t*)p->data, 0); } sdp_list_free(proto_list, 0); } else { } sdp_record_free(rec); if(return_hash != NULL) PUSHs(sv_2mortal(newRV_inc((SV*) return_hash))); } sdp_list_free(response_list, 0); sdp_list_free(search_list, 0); sdp_list_free(attrid_list, 0); sdp_close(session); int _socket(proto) char *proto CODE: if(strcasecmp(proto, "RFCOMM") == 0) RETVAL = socket(AF_BLUETOOTH, SOCK_STREAM, BTPROTO_RFCOMM); else if(strcasecmp(proto, "L2CAP") == 0) RETVAL = socket(AF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP); else RETVAL = -1; OUTPUT: RETVAL int _connect(fd, addr, port, proto) int fd char *addr int port char *proto CODE: //char local_host [] = "FF:FF:FF:00:00:00"; if(strcasecmp(proto, "RFCOMM") == 0) { struct sockaddr_rc rcaddr; rcaddr.rc_family = AF_BLUETOOTH; rcaddr.rc_channel = (uint8_t) port; str2ba(addr, &rcaddr.rc_bdaddr); // connect to server if(connect(fd, (struct sockaddr *)&rcaddr, sizeof(rcaddr)) == 0) RETVAL = 0; else RETVAL = -1; } else if(strcasecmp(proto, "L2CAP") == 0) { struct sockaddr_l2 l2addr = { 0 }; l2addr.l2_family = AF_BLUETOOTH; l2addr.l2_psm = htobs(port); str2ba(addr, &l2addr.l2_bdaddr); /*if(strcasecmp(addr, "localhost") == 0 || strcasecmp(addr, "local") == 0) { str2ba(local_host, &l2addr.l2_bdaddr); } else */ // connect to server if(connect(fd, (struct sockaddr *)&l2addr, sizeof(l2addr)) == 0) RETVAL = 0; else RETVAL = -1; } else RETVAL = -1; OUTPUT: RETVAL int _bind(fd, port, proto) int fd int port char *proto CODE: if(strcasecmp(proto, "RFCOMM") == 0) { struct sockaddr_rc rcaddr; // set the connection parameters rcaddr.rc_family = AF_BLUETOOTH; rcaddr.rc_channel = (uint8_t) port; rcaddr.rc_bdaddr = *BDADDR_ANY; RETVAL = bind(fd, (struct sockaddr *)&rcaddr, sizeof(rcaddr)); } else if(strcasecmp(proto, "L2CAP") == 0) { struct sockaddr_l2 l2addr = { 0 }; // set the connection parameters l2addr.l2_family = AF_BLUETOOTH; l2addr.l2_psm = htobs(port); l2addr.l2_bdaddr = *BDADDR_ANY; RETVAL = bind(fd, (struct sockaddr *)&l2addr, sizeof(l2addr)); } else RETVAL = -1; OUTPUT: RETVAL int _listen(fd, backlog) int fd int backlog CODE: RETVAL = listen(fd, backlog); OUTPUT: RETVAL void _accept(fd, proto) int fd char *proto PPCODE: EXTEND(sp, 2); socklen_t addr_len; int res; if(strcasecmp(proto, "RFCOMM") == 0) { struct sockaddr_rc rcaddr; addr_len = sizeof(rcaddr); res = accept(fd, (struct sockaddr *)&rcaddr, &addr_len); PUSHs(sv_2mortal(newSViv(res))); if(res >= 0) { char addr[19]; ba2str(&rcaddr.rc_bdaddr, addr); PUSHs(sv_2mortal(newSVpv(addr, 0))); } } else if(strcasecmp(proto, "L2CAP") == 0) { struct sockaddr_l2 l2addr = { 0 }; addr_len = sizeof(l2addr); res = accept(fd, (struct sockaddr *)&l2addr, &addr_len); PUSHs(sv_2mortal(newSViv(res))); if(res >= 0) { char addr[19]; ba2str(&l2addr.l2_bdaddr, addr); PUSHs(sv_2mortal(newSVpv(addr, 0))); } } else PUSHs(sv_2mortal(newSViv(-1))); unsigned int _register_service_handle(proto, port, service_id, name, desc) char *proto int port char *service_id char *name char *desc PPCODE: uint8_t rfcomm_channel = 0; uint16_t l2cap_port = 0; const char *service_name = name; const char *service_dsc = desc; const char *service_prov = name; uuid_t root_uuid, l2cap_uuid, rfcomm_uuid, svc_uuid; sdp_list_t *l2cap_list = 0, *rfcomm_list = 0, *root_list = 0, *proto_list = 0, *access_proto_list = 0; sdp_data_t *channel = 0, *psm = 0; sdp_record_t *record = sdp_record_alloc(); //sdp_uuid16_create(&svc_uuid, service_id); if(str2uuid(service_id, &svc_uuid) != 0) { XSRETURN_IV(0); } sdp_set_service_id(record, svc_uuid); // make the service record publicly browsable sdp_uuid16_create(&root_uuid, PUBLIC_BROWSE_GROUP); root_list = sdp_list_append(0, &root_uuid); sdp_set_browse_groups(record, root_list); // set l2cap information sdp_uuid16_create(&l2cap_uuid, L2CAP_UUID); l2cap_list = sdp_list_append(0, &l2cap_uuid); proto_list = sdp_list_append(0, l2cap_list); if(strcasecmp(proto, "L2CAP") == 0) { uint16_t l2cap_port = port; psm = sdp_data_alloc(SDP_UINT16, &l2cap_port); sdp_list_append(l2cap_list, psm); } //proto_list = sdp_list_append(0, l2cap_list); // set rfcomm information //sdp_uuid16_create(&rfcomm_uuid, RFCOMM_UUID); //rfcomm_list = sdp_list_append(0, &rfcomm_uuid); if(strcasecmp(proto, "RFCOMM") == 0) { sdp_uuid16_create(&rfcomm_uuid, RFCOMM_UUID); rfcomm_list = sdp_list_append(0, &rfcomm_uuid); uint8_t rfcomm_channel = port; channel = sdp_data_alloc(SDP_UINT8, &rfcomm_channel); sdp_list_append(rfcomm_list, channel); sdp_list_append(proto_list, rfcomm_list); } //sdp_list_append(proto_list, rfcomm_list); // attach protocol information to service record access_proto_list = sdp_list_append( 0, proto_list ); sdp_set_access_protos( record, access_proto_list ); // set the name, provider, and description sdp_set_info_attr(record, service_name, service_prov, service_dsc); // connect to the local SDP server, register the service record, and disconnect sdp_session_t *session = sdp_connect(BDADDR_ANY, BDADDR_LOCAL, SDP_RETRY_IF_BUSY); if(session) { if(sdp_record_register(session, record, 0) >= 0) { // this is bad and should be kept internal // will fix this up next run PUSHs(sv_2mortal(newSVuv((unsigned int)session))); } else { PUSHs(sv_2mortal(newSViv(0))); } } else { PUSHs(sv_2mortal(newSViv(0))); } if(psm) sdp_data_free(psm); if(channel) sdp_data_free(channel); sdp_list_free(l2cap_list, 0); sdp_list_free(rfcomm_list, 0); sdp_list_free(root_list, 0); sdp_list_free(access_proto_list, 0); void _stop_service_handle(sdp_addr) unsigned int sdp_addr CODE: sdp_session_t *sdp_session; sdp_session = (sdp_session_t *) sdp_addr; sdp_close(sdp_session); void _getpeername(fd, proto) int fd char *proto PPCODE: EXTEND(sp, 2); if(strcasecmp(proto, "RFCOMM") == 0) { struct sockaddr_rc rcaddr; socklen_t len = sizeof(rcaddr); if(getpeername(fd, (struct sockaddr *) &rcaddr, &len) == 0) { char addr[19]; ba2str(&rcaddr.rc_bdaddr, addr); PUSHs(sv_2mortal(newSVpv(addr, 0))); PUSHs(sv_2mortal(newSVuv(rcaddr.rc_channel))); } } else if(strcasecmp(proto, "L2CAP") == 0) { struct sockaddr_l2 l2addr = { 0 }; socklen_t len = sizeof(l2addr); if(getpeername(fd, (struct sockaddr *) &l2addr, &len) == 0) { char addr[19]; ba2str(&l2addr.l2_bdaddr, addr); PUSHs(sv_2mortal(newSVpv(addr, 0))); PUSHs(sv_2mortal(newSVuv(l2addr.l2_psm))); } } Net-Bluetooth-0.41/Changes000644 000766 000024 00000002677 12437103566 016100 0ustar00adutkostaff000000 000000 Revision history for Perl extension Net::Bluetooth 0.41 Mon Dec 01 10:20:00 2014 - Created repository on Bitbucket. - Incorporated change from ticket #54014 (Benoit Peccatte) - Pushing updated version 0.32 Fri June 09 14:05:11 2006 - Initial creation 0.34 Fri June 16 17:07:11 2006 - Added Windows support. - Changed the API. 0.35 Sat June 17 00:02:11 2006 - Fixed a sdp_search bug where a "0" service_id was not searching the public group. - Fixed a bug in the sdp_search for Win where keys where being defined when there was no value. 0.36 Tue June 20 02:07:10 2006 - Added localhost sdp_search for Windows. - Added samples directory. - Fixed a bug with undef searching and sdp_search(). - Set device name to [unknown] on Windows if it isn't defined. - Updated documentation. - Fixed bug where sdp_search was not looking at the name arg on Windows. 0.37 Fri June 23 23:52:11 2006 - bind, listen, connect, were returning undef instead of a integer. - Added GPS sample. - String compares on Windows are now case-insensitive. 0.38 Sun October 08 18:54:11 2006 - Just updated the README to include the ppd/ppm info for Windows. 0.39 Sun January 14 16:42:11 2007 - Fixed a deallocation bug when creating a L2CAP service. 0.40 Sat August 11 19:48:00 2007 - perlfh() now returns the filehandle by value instead of reference. This was causing problems with multiple clients. Net-Bluetooth-0.41/Makefile.PL000644 000766 000024 00000002434 10446677551 016556 0ustar00adutkostaff000000 000000 use ExtUtils::MakeMaker; use Config qw(%Config); require 5.008; my $win_include = '"-IC:\\PROGRAM FILES\\MICROSOFT PLATFORM SDK FOR WINDOWS SERVER 2003 R2\\INCLUDE"'; my $lib_path = ""; my $inc_path = ""; print "OS = $Config{osname}\n"; if($Config{osname} =~ /^MSWin/i) { print "**ATTENTION!!**\n"; print "Attempting to build for Windows with the following include path:\n"; print "$win_include\n"; print "If this is not the include path for the SP2 SDK, please change the\n"; print "\$win_include variable in Makefile.PL.\n\n\n"; $inc_path = $win_include; copy_xs("MSWin.xs", "Bluetooth.xs"); } else { $lib_path = '-lbluetooth'; copy_xs("BlueZ.xs", "Bluetooth.xs"); } sub copy_xs { my $source = shift; my $dest = shift; open(SOURCE, "$source") or die "$! $source\n"; open(DEST, ">$dest") or die "$! $dest\n"; @contents = ; print DEST @contents; close(DEST); close(SOURCE); } WriteMakefile( 'NAME' => 'Net::Bluetooth', 'VERSION_FROM' => 'Bluetooth.pm', # finds $VERSION 'LIBS' => [$lib_path], # e.g., '-lm' 'DEFINE' => $define, # e.g., '-DHAVE_SOMETHING' 'INC' => $inc_path, # e.g., '-I/usr/include/other' 'clean' => {FILES => 'Bluetooth.xs'}, 'XSPROTOARG' => '-prototypes' ); Net-Bluetooth-0.41/MANIFEST000644 000766 000024 00000000600 12437103723 015711 0ustar00adutkostaff000000 000000 Makefile.PL MANIFEST README BlueZ.xs MSWin.xs Bluetooth.pm test.pl typemap Changes samples/device_discovery samples/service_discovery samples/client_connection samples/server_and_service_registration samples/get_gps_data META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-Bluetooth-0.41/META.json000644 000766 000024 00000001427 12437103723 016211 0ustar00adutkostaff000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.120630", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Bluetooth", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "version" : "0.41" } Net-Bluetooth-0.41/META.yml000644 000766 000024 00000000655 12437103723 016043 0ustar00adutkostaff000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.120630' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-Bluetooth no_index: directory: - t - inc requires: {} version: 0.41 Net-Bluetooth-0.41/MSWin.xs000644 000766 000024 00000030771 10447140144 016142 0ustar00adutkostaff000000 000000 #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include #include #include #ifdef __cplusplus } #endif typedef PerlIO * InOutStream; #define UUID_BASE_128 "00000000-0000-1000-8000-00805F9B34FB" // Code from PyBlueZ static void ba2str( BTH_ADDR ba, char *addr ) { int i; unsigned char bytes[6]; for( i=0; i<6; i++ ) { bytes[5-i] = (unsigned char) ((ba >> (i*8)) & 0xff); } sprintf(addr, "%02X:%02X:%02X:%02X:%02X:%02X", bytes[0], bytes[1], bytes[2], bytes[3], bytes[4], bytes[5] ); } // Code from PyBlueZ static int str2uuid( const char *uuid_str, GUID *uuid ) { // Parse uuid128 standard format: 12345678-9012-3456-7890-123456789012 int i; char buf[20] = { 0 }; strncpy(buf, uuid_str, 8); uuid->Data1 = strtoul( buf, NULL, 16 ); memset(buf, 0, sizeof(buf)); strncpy(buf, uuid_str+9, 4); uuid->Data2 = (unsigned short) strtoul( buf, NULL, 16 ); memset(buf, 0, sizeof(buf)); strncpy(buf, uuid_str+14, 4); uuid->Data3 = (unsigned short) strtoul( buf, NULL, 16 ); memset(buf, 0, sizeof(buf)); strncpy(buf, uuid_str+19, 4); strncpy(buf+4, uuid_str+24, 12); for( i=0; i<8; i++ ) { char buf2[3] = { buf[2*i], buf[2*i+1], 0 }; uuid->Data4[i] = (unsigned char)strtoul( buf2, NULL, 16 ); } return 0; } static int build_uuid(GUID *uuid, char *service) { char service_buf[37]; if(service == NULL || strcmp(service, "0") == 0 || strlen(service) == 0) { // Use public browse group strcpy(service_buf, UUID_BASE_128); service_buf[4] = '1'; service_buf[5] = '0'; service_buf[6] = '0'; service_buf[7] = '2'; str2uuid(service_buf, uuid); } // 128 bit else if(strlen(service) == 36) { if(service[8] != '-' || service[13] != '-' || service[18] != '-' || service[23] != '-' ) { return(-1); } str2uuid(service, uuid); } // they left 0x on? else if(strlen(service) == 6){ if(service[0] == '0' && service[1] == 'x' || service[1] == 'X') { strcpy(service_buf, UUID_BASE_128); service_buf[4] = service[2]; service_buf[5] = service[3]; service_buf[6] = service[4]; service_buf[7] = service[5]; str2uuid(service_buf, uuid); } else { return(-1); } } // 16 bit else if(strlen(service) == 4) { strcpy(service_buf, UUID_BASE_128); service_buf[4] = service[0]; service_buf[5] = service[1]; service_buf[6] = service[2]; service_buf[7] = service[3]; str2uuid(service_buf, uuid); } else { return(-1); } return(0); } MODULE = Net::Bluetooth PACKAGE = Net::Bluetooth void _init() CODE: WORD wVersionRequested; WSADATA wsaData; wVersionRequested = MAKEWORD(2, 0); if(WSAStartup(wVersionRequested, &wsaData) != 0) { croak("Could not init Winsock!"); } void _deinit() CODE: WSACleanup(); InOutStream _perlfh(fd) int fd CODE: InOutStream fh = PerlIO_fdopen(fd, "r+"); RETVAL = fh; OUTPUT: RETVAL void _close(sock) int sock PPCODE: closesocket(sock); unsigned int _use_service_handle() CODE: // We dont use the service handle on Windows RETVAL = 0; OUTPUT: RETVAL void get_remote_devices() PPCODE: int done = 0; int iRet; int error; DWORD flags = 0; DWORD qs_len; HANDLE hLookup; char addr_buf[64]; WSAQUERYSET *qs; BTH_ADDR result; HV *return_hash = NULL; qs_len = sizeof(WSAQUERYSET); qs = (WSAQUERYSET*) malloc(qs_len); ZeroMemory(qs, sizeof(WSAQUERYSET)); qs->dwSize = sizeof(WSAQUERYSET); qs->dwNameSpace = NS_BTH; qs->lpcsaBuffer = NULL; flags |= LUP_FLUSHCACHE | LUP_RETURN_NAME | LUP_RETURN_ADDR | LUP_CONTAINERS; iRet = WSALookupServiceBegin(qs, flags, &hLookup); // return undef if error and empty hash if no devices found? if(iRet == SOCKET_ERROR) { error = WSAGetLastError(); if(error == WSASERVICE_NOT_FOUND) { // No device WSALookupServiceEnd(hLookup); free(qs); } else { free(qs); } } else { EXTEND(sp, 1); while(! done) { if(WSALookupServiceNext(hLookup, flags, &qs_len, qs) == NO_ERROR) { result = ((SOCKADDR_BTH*)qs->lpcsaBuffer->RemoteAddr.lpSockaddr)->btAddr; ba2str(result, addr_buf); if(return_hash == NULL) return_hash = newHV(); if(qs->lpszServiceInstanceName == NULL || strlen(qs->lpszServiceInstanceName) == 0) { hv_store(return_hash, addr_buf, strlen(addr_buf), newSVpv("[unknown]", 0), 0); } else { hv_store(return_hash, addr_buf, strlen(addr_buf), newSVpv(qs->lpszServiceInstanceName, 0), 0); } } else { error = WSAGetLastError(); if(error == WSAEFAULT) { free(qs); qs = (WSAQUERYSET*) malloc(qs_len); ZeroMemory(qs, qs_len); } else if(error == WSA_E_NO_MORE) { done = 1; } else { done = 1; } } } // only return if has values if(return_hash != NULL) PUSHs(sv_2mortal(newRV_inc((SV*) return_hash))); WSALookupServiceEnd(hLookup); } void sdp_search(addr, service, name) char *addr char *service char *name PPCODE: char *addrstr = NULL; char *uuidstr = "0"; char localAddressBuf[32]; DWORD qs_len; WSAQUERYSET *qs; DWORD flags; HANDLE h; GUID uuid; SOCKADDR_BTH sa; int sa_len = sizeof(sa); int local_fd = 0; int done = 0; int proto; int port; int error; HV *return_hash = NULL; EXTEND(sp, 1); // this prolly doesnt need to be malloced // inquiry data structure qs_len = sizeof(WSAQUERYSET); qs = (WSAQUERYSET*) malloc(qs_len); flags = LUP_FLUSHCACHE | LUP_RETURN_ALL; ZeroMemory(qs, qs_len); qs->dwSize = sizeof(WSAQUERYSET); qs->dwNameSpace = NS_BTH; // ignored for queries? qs->dwNumberOfCsAddrs = 0; if(_stricmp(addr, "localhost") == 0 || _stricmp(addr, "local") == 0 ) { memset(&sa, 0, sizeof(sa)); local_fd = socket(AF_BTH, SOCK_STREAM, BTHPROTO_RFCOMM); if(local_fd < 1) { free(qs); XSRETURN_UNDEF; } sa.addressFamily = AF_BTH; sa.port = BT_PORT_ANY; if(bind(local_fd,(LPSOCKADDR)&sa,sa_len) != NO_ERROR) { free(qs); close(local_fd); XSRETURN_UNDEF; } if(getsockname(local_fd, (LPSOCKADDR)&sa, &sa_len) != NO_ERROR) { free(qs); close(local_fd); XSRETURN_UNDEF; } ba2str(sa.btAddr, localAddressBuf); qs->lpszContext = (LPSTR) localAddressBuf; close(local_fd); } else { qs->lpszContext = (LPSTR) addr; } memset(&uuid, 0, sizeof(uuid)); if(build_uuid(&uuid, service) != 0) { free(qs); XSRETURN_UNDEF; } qs->lpServiceClassId = &uuid; if(WSALookupServiceBegin(qs, flags, &h) == SOCKET_ERROR) { free(qs); XSRETURN_UNDEF; } else { // iterate through the inquiry results while(! done) { if(WSALookupServiceNext(h, flags, &qs_len, qs) == NO_ERROR) { return_hash = newHV(); // If name is valid, then compare names. if(name && strlen(name) > 0) { if(qs->lpszServiceInstanceName && strlen(qs->lpszServiceInstanceName) > 0) { if(_stricmp(name, qs->lpszServiceInstanceName) == 0) { hv_store(return_hash, "SERVICE_NAME", strlen("SERVICE_NAME"), newSVpv(qs->lpszServiceInstanceName, 0), 0); } else { continue; } } else { continue; } } else if(qs->lpszServiceInstanceName && strlen(qs->lpszServiceInstanceName) > 0) { hv_store(return_hash, "SERVICE_NAME", strlen("SERVICE_NAME"), newSVpv(qs->lpszServiceInstanceName, 0), 0); } if(qs->lpszComment && strlen(qs->lpszComment) > 0) { hv_store(return_hash, "SERVICE_DESC", strlen("SERVICE_DESC"), newSVpv(qs->lpszComment, 0), 0); } // set protocol and port proto = qs->lpcsaBuffer->iProtocol; port = ((SOCKADDR_BTH*)qs->lpcsaBuffer->RemoteAddr.lpSockaddr)->port; if(proto == BTHPROTO_RFCOMM) { if(port) { hv_store(return_hash, "RFCOMM", strlen("RFCOMM"), newSViv(port), 0); } } else if(proto == BTHPROTO_L2CAP) { if(port) { hv_store(return_hash, "L2CAP", strlen("L2CAP"), newSViv(port), 0); } } else { if(port) { hv_store(return_hash, "UNKNOWN", strlen("UNKNOWN"), newSViv(port), 0); } } // qs->lpBlob->pBlobData and qs->lpBlob->cbSize give access to the raw service records PUSHs(sv_2mortal(newRV_inc((SV*) return_hash))); } else { error = WSAGetLastError(); if(error == WSAEFAULT) {; free(qs); qs = (WSAQUERYSET*) malloc(qs_len); } else if(error == WSA_E_NO_MORE) { done = 1; } else { done = 1; } } } } WSALookupServiceEnd(h); free(qs); void _register_service(serverfd, proto, port, service_id, name, desc, advertise) int serverfd char *proto int port char *service_id char *name char *desc int advertise PPCODE: WSAQUERYSET qs; WSAESETSERVICEOP op; SOCKADDR_BTH sa; int sa_len = sizeof(sa); char *service_name = NULL; char *service_desc = NULL; char *service_class_id_str = NULL; CSADDR_INFO sockInfo; GUID uuid; EXTEND(sp, 1); memset(&qs, 0, sizeof(qs)); memset(&sa, 0, sizeof(sa)); memset(&sockInfo, 0, sizeof(sockInfo)); memset(&uuid, 0, sizeof(uuid)); op = advertise ? RNRSERVICE_REGISTER : RNRSERVICE_DELETE; if(getsockname(serverfd, (SOCKADDR*) &sa, &sa_len) == SOCKET_ERROR) { PUSHs(sv_2mortal(newSViv(1))); XSRETURN_IV(0); } if(build_uuid(&uuid, service_id) != 0) { XSRETURN_IV(0); } sockInfo.iProtocol = BTHPROTO_RFCOMM; sockInfo.iSocketType = SOCK_STREAM; sockInfo.LocalAddr.lpSockaddr = (LPSOCKADDR) &sa; sockInfo.LocalAddr.iSockaddrLength = sizeof(sa); sockInfo.RemoteAddr.lpSockaddr = (LPSOCKADDR) &sa; sockInfo.RemoteAddr.iSockaddrLength = sizeof(sa); qs.dwSize = sizeof(qs); qs.dwNameSpace = NS_BTH; qs.lpcsaBuffer = &sockInfo; qs.lpszServiceInstanceName = name; qs.lpszComment = name; qs.lpServiceClassId = (LPGUID) &uuid; qs.dwNumberOfCsAddrs = 1; if(WSASetService(&qs, op, 0) == SOCKET_ERROR) { PUSHs(sv_2mortal(newSViv(0))); } else { PUSHs(sv_2mortal(newSViv(1))); } int _stop_service(sdp_addr) unsigned int sdp_addr CODE: // don't do anything here since we don't use handles RETVAL = 0; OUTPUT: RETVAL int _socket(proto) char *proto CODE: if(_stricmp(proto, "RFCOMM") == 0) { RETVAL = socket(AF_BTH, SOCK_STREAM, BTHPROTO_RFCOMM); } else if(_stricmp(proto, "L2CAP") == 0) { RETVAL = socket(AF_BTH, SOCK_STREAM, BTHPROTO_L2CAP); } else { RETVAL = -1; } OUTPUT: RETVAL int _connect(fd, addr, port, proto) int fd char *addr int port char *proto CODE: SOCKADDR_BTH sa; int sa_len = sizeof(sa); memset(&sa, 0, sizeof(sa)); if(WSAStringToAddress(addr, AF_BTH, NULL, (LPSOCKADDR)&sa, &sa_len) == SOCKET_ERROR) { RETVAL = -1; } else { sa.addressFamily = AF_BTH; sa.port = port; RETVAL = connect(fd, (LPSOCKADDR)&sa, sizeof(sa)); } OUTPUT: RETVAL int _bind(fd, port, proto) int fd int port char *proto CODE: int status; SOCKADDR_BTH sa; int sa_len; sa_len = sizeof(sa); memset(&sa, 0, sa_len); sa.btAddr = 0; sa.addressFamily = AF_BTH; sa.port = port; status = bind(fd, (LPSOCKADDR)&sa, sa_len); if(status == NO_ERROR) { RETVAL = 0; } else { RETVAL = -1; } OUTPUT: RETVAL int _listen(fd, backlog) int fd int backlog CODE: int status; status = listen(fd, backlog); if(status == NO_ERROR) { RETVAL = 0; } else { RETVAL = -1; } OUTPUT: RETVAL void _accept(fd, proto) int fd char *proto PPCODE: int addr_len; int res; char addr[19]; SOCKADDR_BTH rcaddr; EXTEND(sp, 2); addr_len = sizeof(rcaddr); res = accept(fd, (LPSOCKADDR)&rcaddr, &addr_len); if(res != INVALID_SOCKET) { PUSHs(sv_2mortal(newSViv(res))); ba2str(rcaddr.btAddr, addr); PUSHs(sv_2mortal(newSVpv(addr, 0))); } else { PUSHs(sv_2mortal(newSViv(-1))); } void _getpeername(fd, proto) int fd char *proto PPCODE: EXTEND(sp, 2); // not implemented for Windows yet PUSHs(sv_2mortal(newSVuv(0))); PUSHs(sv_2mortal(newSVuv(0))); Net-Bluetooth-0.41/README000644 000766 000024 00000024130 10512316250 015435 0ustar00adutkostaff000000 000000 INSTALL TO INSTALL RUN: perl Makefile.PL make make test make install If you would like to use the prebuilt Windows XP version, you can find the most recent ppd file at: http://www.conditor.com/Net-Bluetooth.ppd Usually to install the prebuilt Windows XP version you would run: ppm install http://www.conditor.com/Net-Bluetooth.ppd Once installed, run 'perldoc Net::Bluetooth' for more information. If you are going to be using a Unix system, the Bluez libs can be obtained at www.bluez.org. Please make sure these are installed and working properly before you install the module. Depending on your system BlueZ maybe already installed, or you may have to build it yourself and do some configuration. You can verify BlueZ can detect devices and services with the utilities that are included with it (hciconfig, sdptool, hcitool, etc). If you are using Windows XP, please make sure you have Service Pack 2 installed and the Microsoft Platform SDK. Also please make sure the "$win_include" variable at the top of Makfile.PL is set properly. This needs to point to the SDK include directory for SP2. This is where the module will look for all the Bluetooth header files (ws2bth.h, etc). Please check out the samples included in the samples directory for more general information. If you have any problems or questions please email me at IGuthrie@aol.com with "Net::Bluetooth" in the subject line. If you run into a build problem, please include the output of the install commands, the version of Perl you are using (perl -v), and what operating system you are using. Module Documentation: NAME Net::Bluetooth - Perl Bluetooth Interface SYNOPSIS use Net::Bluetooth; #### list all remote devices in the area my $device_ref = get_remote_devices(); foreach $addr (keys %$device_ref) { print "Address: $addr Name: $device_ref->{$addr}\n"; } #### search for a specific service (0x1101) on a remote device my @sdp_array = sdp_search($addr, "1101", ""); #### foreach service record foreach $rec_ref (@sdp_array) { #### Print all available information for service foreach $attr (keys %$rec_ref) { print "Attribute: $attr Value: $rec_ref->{$attr}\n"; } } #### Create a RFCOMM client $obj = Net::Bluetooth->newsocket("RFCOMM"); die "socket error $!\n" unless(defined($obj)); if($obj->connect($addr, $port) != 0) { die "connect error: $!\n"; } #### create a Perl filehandle for reading and writing *SERVER = $obj->perlfh(); $amount = read(SERVER, $buf, 256); close(SERVER); #### create a RFCOMM server $obj = Net::Bluetooth->newsocket("RFCOMM"); #### bind to port 1 if($obj->bind(1) != 0) { die "bind error: $!\n"; } #### listen with a backlog of 2 if($obj->listen(2) != 0) { die "listen error: $!\n"; } #### register a service #### $obj must be a open and bound socket my $service_obj = Net::Bluetooth->newservice($obj, "1101", "GPS", "GPS Receiver"); unless(defined($service_obj)) { #### couldn't register service } #### accept a client connection $client_obj = $obj->accept(); unless(defined($client_obj)) { die "client accept failed: $!\n"; } #### get client information my ($caddr, $port) = $client_obj->getpeername(); #### create a Perl filehandle for reading and writing *CLIENT = $client_obj->perlfh(); print CLIENT "stuff"; #### close client connection close(CLIENT); #### stop advertising service $service_obj->stopservice(); #### close server connection $obj->close(); DESCRIPTION This module creates a Bluetooth interface for Perl. Net::Bluetooth works with the BlueZ libs as well as with Microsoft Windows. If you are going to be using a Unix system, the Bluez libs can be obtained at www.bluez.org. Please make sure these are installed and working properly before you install the module. Depending on your system BlueZ maybe already installed, or you may have to build it yourself and do some configuration. You can verify that BlueZ can detect devices and services with the utilities that are included with it (hciconfig, sdptool, hcitool, etc). If you are using Windows, please make sure you have Service Pack 2 installed and the Microsoft Platform SDK. Also please make sure the "$win_include" variable at the top of Makfile.PL is set properly. This needs to point to the SDK include directory for SP2. This is where the module will look for all the Bluetooth header files (ws2bth.h, etc). Please check out the samples included in the samples directory for more general information. FUNCTIONS get_remote_devices() Searches for remote Bluetooth devices. The search will take approximately 5 - 10 seconds (This will be a configurable value in the future.). When finished, it will return a hash reference that contains the device address and name. The address is the key and the name is the value. Name will be set to "[unknown]" if the name could not be resolved. See the NOTES section of this document for more information about this. sdp_search($addr, $uuid, $name) This searches a specific device for service records. The first argument is the device address which is not optional. The uuid argument can be a valid uuid or "0". The name argument can be a valid service name or "". It will return services that match the uuid or service name if supplied, otherwise it will return all public service records for the device. The return value is a list which contains a hash reference for each service record found. The key/values for the hash are as follows: SERVICE_NAME: Service Name SERVICE_DESC: Service Description SERVICE_PROV: Service Provider RFCOMM: RFCOMM Port L2CAP: L2CAP Port UNKNOWN: Unknown Protocol Port If any of the values are unavailable, the keys will not exist. If $addr is "localhost" the call will use the local SDP server. SOCKET OBJECT The bluetooth socket object is used to create bluetooth sockets and interface with them. There are two types of sockets supported, RFCOMM and L2CAP. The methods are listed below. newsocket("RFCOMM") This constructs a socket object for a RFCOMM socket or L2CAP socket. connect($addr, $port) This calls the connect() system call with the address and port you supply. You can use this to connect to a server. Returns 0 on success. bind($port) This calls the bind() system call with the port you provide. You can use this to bind to a port if you are creating a server. Returns 0 on success. As a side note, RFCOMM ports can only range from 1 - 31. listen($backlog) This calls the listen() system call with the backlog you provide. Returns 0 on success. accept() This calls the accept() system call and creates a new bluetooth socket object which is returned. On failure it will return undef. perlfh() This call returns a Perl filehandle for a open socket. You can use the Perl filehandle as you would any other filehandle, except with Perl functions that use the socket address structure. This provides a easy way to do socket IO instead of doing it through the socket object. Currently this is the only way to do socket IO, although soon I will provide read/write calls through the object interface. close() This closes the socket object. This can also be done through the Perl close() call on a created Perl filehandle. getpeername() This returns the address and name for a open bluetooth socket. (BlueZ only for now) SERVICE OBJECT The service object allows you to register a service with your local SDP server. The methods are as follows: newservice($obj, $service_uuid, $service_name, $service_desc) This registers a service with your local SDP server. The first argument is a open and bound socket that you created with newsocket(). The second argument is the service uuid. The third argument is the service name. The fourth argument is the service description. The return value is a new service object. This will be undefined if there was an error. stop_service() This unregisters your service with the local SDP server. The service will be unregistered without this call when the application exits. NOTES All uuids used with this module can either be 128 bit values: "00000000-0000-0000-0000-000000000000" or 16 bit values: "0000". All values must be represented as strings (enclosed in quotes), and must be hexadecimal values. Windows will not immediately return the device name if it is not already cached. Also there is no mechinism to alert the system when it has acquired the device name. Therefore you may have to call get_remote_devices() twice before the name shows up. I'll see if this can be handled better in the future. Currently on Windows the service name and description returned by sdp_search() are not setting their terminating NULL character properly. This can result in some garbage characters at the end of the string. I am looking at parsing the raw record to fix this problem. Some helpful resources are the O'Reilly book "Linux Unwired". The BlueZ site www.bluez.org Intro to Bluetooth programming: http://people.csail.mit.edu/albert/bluez-intro/index.html REQUIREMENTS You need BlueZ or Microsoft Service Pack 2 and the Microsoft Platform SDK. You will also need at least Perl 5.8. AUTHOR Ian Guthrie IGuthrie@aol.com Copyright (c) 2006 Ian Guthrie. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. SEE ALSO perl(1). Net-Bluetooth-0.41/samples/000755 000766 000024 00000000000 12437103723 016230 5ustar00adutkostaff000000 000000 Net-Bluetooth-0.41/test.pl000644 000766 000024 00000001234 10446677510 016110 0ustar00adutkostaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "0..1\n"; } END {print "not ok 1\n" unless $loaded;} use Config qw(%Config); use Net::Bluetooth; $loaded = 1; print "ok 1\n"; ######################### End of black magic. #### Left out test calls because we do not know the state #### of the machine. print"All tests successful!\n\n"; Net-Bluetooth-0.41/typemap000644 000766 000024 00000000011 10442346340 016154 0ustar00adutkostaff000000 000000 TYPEMAP Net-Bluetooth-0.41/samples/client_connection000755 000766 000024 00000001530 10445673501 021655 0ustar00adutkostaff000000 000000 use Net::Bluetooth; #### Create a RFCOMM client #### Create a new socket object, this is basically calling #### the systems socket() call and setting some variable. #### The argument can be either "RFCOMM" or "L2CAP". my $obj = Net::Bluetooth->newsocket("RFCOMM"); die "Socket could not be created!" unless(defined($obj)); #### Connect to server. You can see how to obtain the port and #### address in the service sample file. if($obj->connect($addr, $port) != 0) { die "connect error: $!"; } #### Create a Perl filehandle for reading and writing #### The filehandle should work with any Perl call that #### does not use the sockaddr struct. *SERVER = $obj->perlfh(); $amount = read(SERVER, $buf, 256); close(SERVER); Net-Bluetooth-0.41/samples/device_discovery000755 000766 000024 00000001421 10445662442 021507 0ustar00adutkostaff000000 000000 use Net::Bluetooth; #### list all remote devices in the area my $device_ref = get_remote_devices(); foreach $addr (keys %$device_ref) { print "Address: $addr Name: $device_ref->{$addr}\n"; } #### Note: Windows will not immediately return the device name #### if it is not already cached. Also there is no mechinism #### to alert the system when it has acquired the device name. #### Therefore you may have to call get_remote_devices() twice #### before the name shows up. (Yeah it is lame, but even the #### samples that come with the Windows SDK show them putting #### a Sleep() call in to get around the problem. #### BlueZ does not have this issue. Net-Bluetooth-0.41/samples/get_gps_data000755 000766 000024 00000003615 10447143616 020610 0ustar00adutkostaff000000 000000 use Net::Bluetooth; $| = 1; #### This program connects to a specific GPS device #### and continuously prints out data received. #### List all remote devices in the area. my $device_ref = get_remote_devices(); die "No devices found!\n" unless(defined($device_ref)); my $g_addr = undef; #### Search for my GPS device and set the address. #### My GPS device is named "BT GPS" so I just match #### against that. You could match against your devices #### name just hardcode the address. foreach $addr (keys %$device_ref) { $g_addr = $addr if($device_ref->{$addr} =~ /BT GPS/i); #### Print out all the devices for fun print "Address: $addr Name: $device_ref->{$addr}\n"; } die "GPS not found\n" unless(defined($g_addr)); my $port = 0; #### Search for the serial port service. #### This is what my GPS device uses to transfer data. #### The serial port UUID is 0x1101. my @sdp_array = sdp_search($g_addr, "1101", ""); foreach $rec_ref (@sdp_array) { foreach $key (keys %$rec_ref) { #### Set the RFCOMM port $port = $rec_ref->{$key} if($key =~ /RFCOMM/); #### Print out all attributes for fun print "Key: $key Value: $rec_ref->{$key}\n"; } } die "Service not found!\n" if($port == 0); #### Create a socket and connect to the device. my $obj = Net::Bluetooth->newsocket("RFCOMM"); die "socket error: $!\n" unless(defined($obj)); die "connect error: $!\n" if($obj->connect($g_addr, $port) != 0); #### Create a Perl filehandle for reading and writing. *SERVER = $obj->perlfh(); my $amount = 1; #### Loop until user exits program. while($amount > 0) { $amount = read(SERVER, $buf, 512); #### Parse the GPGGA string and print values we want. if($buf =~ /\$GPGGA,(.+?)\n/) { my $gps_string = $1; my ($lat, $lng, $alt) = (split(/\,/, $gps_string))[1, 3, 8]; print "Latitude: $lat\n"; print "Longitude: $lng\n"; print "Altitude: $alt\n"; print "\n\n"; } } close(SERVER); Net-Bluetooth-0.41/samples/server_and_service_registration000755 000766 000024 00000003771 10552532301 024622 0ustar00adutkostaff000000 000000 use Net::Bluetooth; #### Create a RFCOMM server #### Create a new socket object, this is basically calling #### the systems socket() call and setting some variable. #### The argument can be either "RFCOMM" or "L2CAP". my $server_obj = Net::Bluetooth->newsocket("L2CAP"); die "Socket could not be created!" unless(defined($server_obj)); print "after socket\n"; #### Bind to port 1 if($server_obj->bind(5) != 0) { #### Could try another port instead of exiting. die "bind error: $!\n"; } print "after bind\n"; #### Listen with a backlog of 2 if($server_obj->listen(2) != 0) { die "listen error: $!"; } print "after listen\n"; #### Register a service #### $server_obj must be a open and bound socket #### The second option is the service ID. #### The third option is the service name. #### The fourth option is the service description. my $service_obj = Net::Bluetooth->newservice($server_obj, "1101", "GPS", "GPS"); print "new service\n"; unless(defined($service_obj)) { die "Could not register service!"; } #### accept a client connection $client_obj = $server_obj->accept(); unless(defined($client_obj)) { die "client accept failed: $!"; } #### Create a Perl filehandle for reading and writing #### The filehandle should work with any Perl call that #### does not use the sockaddr struct. *CLIENT = $client_obj->perlfh(); foreach(1 .. 1000) { print CLIENT "stuff"; } #### close client connection close(CLIENT); #### stop advertising service $service_obj->stopservice(); #### close server connection $server_obj->close(); Net-Bluetooth-0.41/samples/service_discovery000755 000766 000024 00000005132 10445703536 021713 0ustar00adutkostaff000000 000000 use Net::Bluetooth; #### About the sdp_search call: #### The $addr argument is an address in the form of "00:00:00:00:00:00". #### $addr can also be "localhost" which will search the local SDP server. #### The second argument is the service ID to search for and is optional. #### It is a string in the form of a 128 bit ID: #### "00000000-0000-0000-0000-000000000000" or a 16 bit ID: "0000". #### All service IDs must be in hexidecimal format. #### The service ID can also be "0" which will search the public #### services on the device. #### The third argument is the service name and is optional. #### Different ways to search for a service: #### Search for service 1101 (Serial Port) and do not specify a name. sdp_search($addr, "1101", ""); #### Search for services named "Imaging" and do not specify a service ID. sdp_search($addr, "", "Imaging"); #### Search for a service on the local SDP server. sdp_search("localhost", "12345678-1234-1234-123456789012", ""); #### Search for public services and do not specify a name. #### Note, usually not every single device service is listed in the public group. sdp_search($addr, "0", ""); sdp_search($addr, "", ""); #### Finally here is an exmaple of how I search for the serial port on my GPS device: use Net::Bluetooth; #### find remote devices my $device_ref = get_remote_devices(); #### Could retry here instead of exiting. die "No devices found." unless(defined($device_ref)); my $gps_addr = ""; #### Loop through each device and find the one we want. foreach $addr (keys %$device_ref) { #### If the device name matches "BT GPS" grab the address. $gps_addr = $addr if($device_ref->{$addr} =~ /^BT GPS/); } #### Could retry here instead of exiting. die "BT GPS not found." unless(defined($gps_addr)); #### Search for the serial service (0x1101) on my GPS device. #### The serial port is what mine uses to transfer GPS info. my @sdp_array = sdp_search($gps_addr, "1101", ""); die "No service records found" unless(defined(@sdp_array)); my $port = 0; #### Loop through all the service records. #### foreach service record .... foreach $rec_ref (@sdp_array) { #### Get the RFCOMM port number for the service. if(exists($rec_ref->{RFCOMM})) { $port = $rec_ref->{RFCOMM}; last; } } die "No RFCOMM record found." unless($port > 0);