From 817222fdf57ae5d1c98e35c4ef8a1f305553a7b5 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sun, 1 Jan 2017 15:15:23 -0600 Subject: [PATCH 01/27] Alexa Echo and Google Home bridge emulating the Hue api --- bin/mh | 3 + lib/AlexaBridge.pm | 582 +++++++++++++++++++++++++++++++++++++++++++++ lib/http_server.pl | 6 + 3 files changed, 591 insertions(+) create mode 100644 lib/AlexaBridge.pm diff --git a/bin/mh b/bin/mh index 0e85956c4..e5b6f209c 100755 --- a/bin/mh +++ b/bin/mh @@ -807,6 +807,7 @@ sub setup { use EIB_Items; use EIB_Device; use ajax; + use AlexaBridge; eval "use BSC"; # Base_Items @@ -976,6 +977,7 @@ sub setup { &socket_open($port_name); } + &AlexaBridge::startup; # Start the AlexaBridge sockets, in lib/AlexaBridge.pm &xAP::startup; # Start the xAP sockets, in lib/xAP_Items.pm &xPL::startup; # Start the xPL sockets, in lib/xPL_Items.pm &EIB_Device::startup; # Start the EIB device, in lib/EIB_Device.pm @@ -2921,6 +2923,7 @@ sub check_for_socket_data { { ( my $from_port, my $from_ip ) = sockaddr_in($from_saddr) if $from_saddr; + $Socket_Ports{$port_name}{from_ipport} = $from_saddr; $Socket_Ports{$port_name}{from_port} = $from_port; $Socket_Ports{$port_name}{from_ip} = $from_ip; } diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm new file mode 100644 index 000000000..bfb9670b9 --- /dev/null +++ b/lib/AlexaBridge.pm @@ -0,0 +1,582 @@ +package AlexaBridge; + +@AlexaBridge::ISA = ('Generic_Item'); + +use Carp; +use IO::Socket::INET; +use Socket; +use IO::Socket::Multicast; + + + +use constant SSDP_IP => "239.255.255.250"; +use constant SSDP_PORT => 1900; +use constant CRLF => "\015\012"; + +use constant DEFAULT_HTTP_PORT => 8085; +use constant DEFAULT_LEASE_TIME => 1800; +use constant DEFAULT_NOTIFICATION_PORT => 50000; +use constant DEFAULT_PORT_COUNT => 0; + +my ($ssdpNotificationName, $ssdpListenName, $AlexaGlobal); + +sub startup { + unless ($::config_parms{'alexa_enable'}) { return } + &open_port(); + &::MainLoop_pre_add_hook( \&AlexaBridge::check_for_data, 1 ); +} + +sub open_port { + + my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || DEFAULT_PORT_COUNT; + for my $count (0..$AlexaHttpPortCount) { + my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || DEFAULT_HTTP_PORT; + $AlexaHttpPort = ($AlexaHttpPort + $count); + my $AlexaHttpName = 'alexaServer'.$count; + &http_ports($AlexaHttpName, $AlexaHttpPort); + $AlexaGlobal->{http_sockets}->{$AlexaHttpName} = new Socket_Item( undef, undef, $AlexaHttpName ); + &main::print_log ("Alexa open_port: p=$AlexaHttpPort pn=$AlexaHttpName s=$$AlexaHttpName\n") + if $main::Debug{alexa}; + } + + + $AlexaGlobal->{http_sender}->{'alexa_http_sender'} = new Socket_Item('alexa_http_sender', undef, $::config_parms{'http_server'}.':'.$::config_parms{'http_port'}, 'alexa_http_sender', 'tcp', 'raw'); + + + my $notificationPort = $::config_parms{'alexa_notification_port'} || DEFAULT_NOTIFICATION_PORT; + + + $ssdpNotificationName = 'alexaSsdpNotification'; + $ssdpNotificationSocket = new IO::Socket::INET->new( + Proto => 'udp', + LocalPort => $notificationPort) + || &main::print_log( "\nError: Could not start a udp alexa multicast notification sender on $notificationPort: $@\n\n" ) && return; + + setsockopt($ssdpNotificationSocket, + getprotobyname('ip'), + IP_MULTICAST_TTL, + pack 'I', 4); + $::Socket_Ports{$ssdpNotificationName}{protocol} = 'udp'; + $::Socket_Ports{$ssdpNotificationName}{datatype} = 'raw'; + $::Socket_Ports{$ssdpNotificationName}{port} = $notificationPort; + $::Socket_Ports{$ssdpNotificationName}{sock} = $ssdpNotificationSocket; + $::Socket_Ports{$ssdpNotificationName}{socka} = $ssdpNotificationSocket; # UDP ports are always "active" + $alexa_ssdp_send = new Socket_Item( undef, undef, $ssdpNotificationName ); + + printf " - creating %-15s on %3s %5s %s\n", $ssdpNotificationName, 'udp', $notificationPort; + &main::print_log ("Alexa open_port: p=$notificationPort pn=$ssdpNotificationName s=$alexa_ssdp_send\n") + if $main::Debug{alexa}; + + + $ssdpListenName = 'alexaSsdpListen'; + $ssdpListenSocket = new IO::Socket::Multicast->new( + LocalPort => SSDP_PORT, + Proto => 'udp', + Reuse => 1) + || &main::print_log( "\nError: Could not start a udp alexa multicast listen server on ". SSDP_PORT .$@ ."\n\n" ) && return; + $ssdpListenSocket->mcast_add(SSDP_IP); + $::Socket_Ports{$ssdpListenName}{protocol} = 'udp'; + $::Socket_Ports{$ssdpListenName}{datatype} = 'raw'; + $::Socket_Ports{$ssdpListenName}{port} = SSDP_PORT; + $::Socket_Ports{$ssdpListenName}{sock} = $ssdpListenSocket; + $::Socket_Ports{$ssdpListenName}{socka} = $ssdpListenSocket; # UDP ports are always "active" + $alexa_ssdp_listen = new Socket_Item( undef, undef, $ssdpListenName ); + + printf " - creating %-15s on %3s %5s %s\n", $ssdpListenName, 'udp', SSDP_PORT; + &main::print_log ("Alexa open_port: p=$ssdpPort pn=$ssdpListenName s=$alexa_ssdp_listen\n") + if $main::Debug{alexa}; + + return 1; +} + + +sub http_ports { + my ( $AlexaHttpName, $AlexaHttpPort ) = @_; + my $AlexaHttpSocket = new IO::Socket::INET->new( + Proto => 'tcp', + LocalPort => $AlexaHttpPort, + Reuse => 1, + Listen => 10) + || &main::print_log( "\nError: Could not start a tcp $AlexaHttpName on $AlexaHttpPort: $@\n\n" ) && return; + + $::Socket_Ports{$AlexaHttpName}{protocol} = 'tcp'; + $::Socket_Ports{$AlexaHttpName}{datatype} = 'raw'; + $::Socket_Ports{$AlexaHttpName}{port} = $AlexaHttpPort; + $::Socket_Ports{$AlexaHttpName}{sock} = $AlexaHttpSocket; + $::Socket_Ports{$AlexaHttpName}{socka} = $AlexaHttpSocket; + printf " - creating %-15s on %3s %5s %s\n", $AlexaHttpName, 'tcp', $AlexaHttpPort; +} + +sub check_for_data { + my $alexa_http_sender = $AlexaGlobal->{http_sender}->{'alexa_http_sender'}; + #foreach my $socketName ( keys %{$AlexaGlobal->{http_sockets}} ) { + my $socketName = 'alexaServer0'; + my $alexa_listen = $AlexaGlobal->{http_sockets}{$socketName}; + if ( $alexa_listen && ( my $alexa_data = said $alexa_listen ) ) { + #&main::print_log( "[Alexa] Info: Data - $alexa_data" ); + $alexa_http_sender->start unless $alexa_http_sender->active; + $alexa_http_sender->set($alexa_data); + + } + + if ( $alexa_http_sender && ( my $alexa_sender_data = said $alexa_http_sender ) ) { + $alexa_listen->set($alexa_sender_data); + # $alexa_http_sender->stop; + } + # } + + + if ( $alexa_ssdp_listen && ( my $ssdp_data = said $alexa_ssdp_listen) ) { + my $peer = $::Socket_Ports{$ssdpListenName}{from_ipport}; + &_receiveSSDPEvent($ssdp_data, $peer); + } +} + +sub _receiveSSDPEvent { + my ( $buf, $peer ) = @_; + + + if ($buf !~ /\015?\012\015?\012/) { + return; + } + + $buf =~ s/^(?:\015?\012)+//; # ignore leading blank lines + if (!($buf =~ s/^(\S+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012//)) { + # Bad header + return; + } + + my $method = $1; + if ($method ne 'M-SEARCH') { + # We only care about searches + return; + } + + my $target; + if ( $buf =~ /ST: urn:Belkin:device:\*\*.*/ ) { &_sendSearchResponse($peer) } + elsif ( $buf =~ /ST: urn:schemas-upnp-org:device:basic:1.*/ ) { &_sendSearchResponse($peer) } +} + + + +sub _sendSearchResponse { + my $peer = shift; + my $count = 0; + my $selfname = (&main::list_objects_by_type('AlexaBridge'))[0]; + my $self = ::get_object_by_name($selfname); + + foreach my $port ( (sort keys %{$self->{child}->{'ports'}}) ) { + next unless ( $self->{child}->{$port} ); + my $output = "HTTP/1.1 200 OK\r\n"; + $output .= 'Location: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; + $output .= 'OPT: '."\"http://schemas.upnp.org/upnp/1/0/\"\; ns\=01"."\r\n"; + $output .= '01-NLS: D1710C33-328D-4152-A5FA-5382541A92FF'."\r\n"; + $output .= 'USN: uuid:Socket-1_0-221438K0100073::urn:Belkin:device:**'."\r\n"; + $output .= 'Cache-control: max-age=86400'."\r\n"; + $output .= 'ST: urn:schemas-upnp-org:device:basic:1'."\r\n"; + $output .= 'EXT: '."\r\n"; + $output .= "\r\n"; + my $socket = handle $alexa_ssdp_send; + + send($socket, $output, 0, $peer); + $count++; + } +} + +sub process_http { + + unless ($::config_parms{'alexa_enable'}) { return 0 } + my ( $uri, $request_type, $host, $body, $socket ) = @_; + + unless ( ($uri =~ /^\/upnp\//) || ($uri =~ /^\/api\//) ) { return 0 } # Added for performance + + my $selfname = (&main::list_objects_by_type('AlexaBridge'))[0]; + my $self = ::get_object_by_name($selfname); + unless ($self) { &main::print_log( "[Alexa] Error: No AlexaBridge parent object found" ); return 0 } + + use HTTP::Date qw(time2str); + + #get the port from the host header + my @uris = split(/\//, $uri); + my $port; + if ( $host =~ /(.*):(\d+)/ ) { + $host = $1; + $port = $2; + } + + +my $xmlmessage = qq[ + + +1 +0 + +http://$::config_parms{'alexaHttpIp'}:$port/ + +urn:schemas-upnp-org:device:basic:1 +Amazon-Echo-MH-Bridge (192.168.195.37) +Royal Philips Electronics +http://misterhouse.sourceforge.net/ +Hue Emulator for Amazon Echo bridge +Philips hue bridge 2012 +929000226503 +https://github.com/hollie/misterhouse +amazon-mh-bridge0 +uuid:amazon-mh-bridge0 + + +(null) +(null) +(null) +(null) +(null) + + +index.html + + +image/png +48 +48 +24 +hue_logo_0.png + + +image/png +120 +120 +24 +hue_logo_3.png + + + +]; + + +my $AlexaObjects; + if ( $self->{child}->{$port} ) { + # use Data::Dumper; + $AlexaObjects = $self->{child}->{$port}; + #&main::print_log( Data::Dumper->Dumper($AlexaObjects) ); + } + else { + &main::print_log( "[Alexa] Error: No Matching object for port ( $port )" ); + $output = "HTTP/1.1 404 Not Found\r\n"; + return $output; + } + +&main::print_log ("[Alexa] Debug: Port: ( $port ) URI: ( $uri ) Body: ( $body ) Type: ( $request_type ) \n") if $main::Debug{'alexa'}; + + if ( ($uri =~ /^\/upnp\/.*\/setup.xml$/) && (lc($request_type) eq "get") ) { + my $output = "HTTP/1.1 200 OK\r\n"; + $output .= "Server: MisterHouse\r\n"; + $output .= 'Access-Control-Allow-Origin: *'."\r\n"; + $output .= 'Access-Control-Allow-Methods: POST, GET, OPTIONS, DELETE, PUT'."\r\n"; + $output .= 'Access-Control-Max-Age: 3600'."\r\n"; + $output .= 'Access-Control-Allow-Headers: Origin, X-Requested-With, Content-Type, Accept'."\r\n"; + $output .= 'X-Application-Context: application'."\r\n"; + $output .= 'Content-Type: application/xml;charset=UTF-8'."\r\n"; + $output .= "Content-Length: ". (length $xmlmessage) ."\r\n"; + $output .= "Date: ". time2str(time)."\r\n"; + $output .= "\r\n"; + $output .= $xmlmessage; + return $output; + } + elsif ( ($uri =~ /^\/api\/$/) && (lc($request_type) eq "post") ) { + my $content = qq[\[{"success":{"username":"lights"}}\]]; + my $output = "HTTP/1.1 200 OK\r\n"; + $output .= "Server: MisterHouse\r\n"; + $output .= 'Access-Control-Allow-Origin: *'."\r\n"; + $output .= 'Access-Control-Allow-Methods: POST, GET, OPTIONS, DELETE, PUT'."\r\n"; + $output .= 'Access-Control-Max-Age: 3600'."\r\n"; + $output .= 'Access-Control-Allow-Headers: Origin, X-Requested-With, Content-Type, Accept'."\r\n"; + $output .= 'X-Application-Context: application'."\r\n"; + $output .= 'Content-Type: application/json;charset=UTF-8'."\r\n"; + $output .= "Content-Length: ". (length $content) ."\r\n"; + $output .= "Date: ". time2str(time)."\r\n"; + $output .= "\r\n"; + $output .= $content; + return $output; + } + elsif ( ($uri =~ /^\/api\/.*\/lights\/(.*)\/state$/) && (lc($request_type) eq "put") ) { + my $output; + my $deviceID = $1; + my $state = undef; + if ( $body =~ /\"(on)\": (true)/ ) { $state = 'on' } + elsif ( $body =~ /\"(on)\": (false)/ ) { $state = 'off' } + elsif ( $body =~ /\"(off)\": (true)/ ) { $state = 'off' } + elsif ( $body =~ /\"(off)\": (false)/ ) { $state = 'on' } + if ( $body =~ /\"(bri)\": (\d+)/ ) { $state = $2 } + elsif ( $body =~ /\"(bri)\":(\d+)/ ) { $state = $2 } + my $content = qq[\[{"success":{"/lights/$deviceID/state/$1":$2}}\]]; + + if ( ($AlexaObjects->{'uuid'}->{$deviceID}) && (defined($state)) ) { + &get_set_state($self, $AlexaObjects, $deviceID, 'set', $state); + + $output = "HTTP/1.1 200 OK\r\n"; + $output .= "Server: MisterHouse\r\n"; + $output .= 'Access-Control-Allow-Origin: *'."\r\n"; + $output .= 'Access-Control-Allow-Methods: POST, GET, OPTIONS, DELETE, PUT'."\r\n"; + $output .= 'Access-Control-Max-Age: 3600'."\r\n"; + $output .= 'Access-Control-Allow-Headers: Origin, X-Requested-With, Content-Type, Accept'."\r\n"; + $output .= 'X-Application-Context: application'."\r\n"; + $output .= 'Content-Type: text/plain;charset=UTF-8'."\r\n"; + $output .= "Content-Length: ". (length $content) ."\r\n"; + $output .= "Date: ". time2str(time)."\r\n"; + $output .= "\r\n"; + $output .= $content; + } else { + $output = "HTTP/1.1 404 Not Found\r\n"; + return $output; + } + print $socket $output; # print direct to the socket so it does not close. + &main::http_process_request($socket); # we know there will be another request so get it in the same tcp session. + return ' '; + #return $output; + } + elsif ( ($uri =~ /^\/api\/.*/) && (lc($request_type) eq "get") ) { + my $count = 0; + my $content; my $name; my $statep1; my $statep2; my $statep3; my $statep4; my $delm; my $output; + my $end = ''; + if (defined $uris[4]) { + if ( ($uris[3] eq 'lights') && ($AlexaObjects->{'uuid'}->{$uris[4]}) ) { + $uuid = $uris[4]; + $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + my $state = &get_set_state($self, $AlexaObjects, $uuid,'get'); + + $statep1 = qq[{"state":{$state,"hue":15823,"sat":88,"effect":"none","ct":313,"alert":"none","colormode":"ct","reachable":true,"xy":\[0.4255,0.3998\]},"type":"Extended color light","name":"]; + $statep2 = qq[","modelid":"LCT001","manufacturername":"Philips","uniqueid":"$uuid","swversion":"65003148","pointsymbol":{"1":"none","2":"none","3":"none","4":"none","5":"none","6":"none","7":"none","8":"none"}}]; + $content = $statep1.$name.$statep2; + $count = 1; + } + elsif ( ($uris[3] eq 'groups') && ($AlexaObjects->{'groups'}->{$uris[4]}) ) { + $name = $AlexaObjects->{'groups'}->{$uris[4]}->{'name'}; + $content = qq[{"action": {"on": true,"hue": 0,"effect": "none","bri": 100,"sat": 100,"ct": 500,"xy": \[0.5, 0.5\]},"lights": \["1","2"\],"state":{"any_on":true,"all_on":true}"type":"Room","class":"Other","name":"$name"}]; + $count = 1; + } + + } + elsif (defined $uris[3]) { + if ( $uris[3] eq 'lights' ) { + $statep1 = qq[{"]; + $statep2 = qq[":"]; + $end = qq["}]; + $delm = qq[","]; + foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { + $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + next unless $name; + if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name } + else { $content = $statep1.$uuid.$statep2.$name } + $count++; + } + } + elsif ( $uris[3] eq 'groups' ) { + $statep1 = qq[{"]; + $statep2 = qq[":"]; + $end = qq["}]; + $delm = qq[","]; + foreach my $id ( keys %{$AlexaObjects->{'groups'}} ) { + $name = $AlexaObjects->{'groups'}->{$id}->{'name'}; + next unless $name; + $statep1 = qq[{"$id": {"name": "$name","lights": \["1","2"\],"type": "LightGroup","action": {"on": true,"bri": 254,"hue": 10000,"sat": 254,"effect": "none","xy": \[0.5,0.5\],"ct": 250,"alert": "select","colormode": "ct"}}]; + $delim = qq[,]; + $statep2 = qq["$id": {"name": "$name","lights": \["3","4"\],"type": "LightGroup","action": {"on": true,"bri": 153,"hue": 4345,"sat": 254,"effect": "none","xy": \[0.5,0.5\],"ct": 250,"alert": "select","colormode": "ct"}}]; + $end = qq[}]; + if ($count >= 1) { $content = $content.$delim.$statep2 } + else { $content = $statep1 } + $count++; + } + } + } + elsif (defined $uris[2]) { + $statep1 = qq[{"lights":{"]; + #$statep2 = qq[":{"state":{"on":false,"bri":254,"hue":15823,"sat":88,"effect":"none","ct":313,"alert":"none","colormode":"ct","reachable":true,"xy":\[0.4255,0.3998\]},"type":"Extended color light","name":"]; + $statep2 = qq[":{"state":{"on":false,"bri":254,"reachable":true},"type":"Extended color light","name":"]; # dis + #$statep2 = qq[":{"state":{"on":false,"bri":254,"hue":15823,"sat":88,"effect":"none","ct":313,"alert":"none","colormode":"ct","reachable":true},"type":"Extended color light","name":"]; + #$statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","uniqueid":"]; + $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; # + #$statep4 = qq[","swversion":"65003148","pointsymbol":{"1":"none","2":"none","3":"none","4":"none","5":"none","6":"none","7":"none","8":"none"}}]; + $end = qq[}}]; + $delm = qq[,"]; + foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { + $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + next unless $name; + #if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3.$uuid.$statep4 } + #else { $content = $statep1.$uuid.$statep2.$name.$statep3.$uuid.$statep4 } + if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3 } + else { $content = $statep1.$uuid.$statep2.$name.$statep3 } + $count++; + } + } + if ($count >= 1) { + $content = $content.$end; + $output = "HTTP/1.1 200 OK\r\n"; + $output .= "Server: MisterHouse\r\n"; + $output .= 'Access-Control-Allow-Origin: *'."\r\n"; + $output .= 'Access-Control-Allow-Methods: POST, GET, OPTIONS, DELETE, PUT'."\r\n"; + $output .= 'Access-Control-Max-Age: 3600'."\r\n"; + $output .= 'Access-Control-Allow-Headers: Origin, X-Requested-With, Content-Type, Accept'."\r\n"; + $output .= 'X-Application-Context: application'."\r\n"; + $output .= 'Content-Type: application/json;charset=UTF-8'."\r\n"; + $output .= "Content-Length: ". (length $content) ."\r\n"; + $output .= "Date: ". time2str(time)."\r\n"; + $output .= "\r\n"; + $output .= $content; + } else { + my $output = "HTTP/1.1 404 Not Found\r\n"; + } + return $output; + } + else { return 0 } +} + +sub get_set_state { + my ( $self, $AlexaObjects, $uuid, $action, $state ) = @_; + my $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + my $realname = $AlexaObjects->{'uuid'}->{$uuid}->{'realname'}; + my $sub = $AlexaObjects->{'uuid'}->{$uuid}->{'sub'}; + my $statesub = $AlexaObjects->{'uuid'}->{$uuid}->{'statesub'}; + $state = $AlexaObjects->{'uuid'}->{$uuid}->{$state} if $AlexaObjects->{'uuid'}->{$uuid}->{$state}; + if ( $state =~ /\d+/ ) { $state = &roundoff($state / 2.52) } + &main::print_log ("[Alexa] Debug: get_set_state ($uuid $action $state) : name: $name realname: $realname sub: $sub state: $state\n") if $main::Debug{'alexa'}; + if ( $realname =~ /^\$/ ) { + my $object = ::get_object_by_name( $realname ); + if ( $action eq 'get' ) { + my $cstate = $object->$statesub; + $cstate =~ s/\%//; + if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":252] } + elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":252] } + elsif ( $cstate =~ /\d+/ ) { return qq["on":true,"bri":].&roundoff($cstate * 2.52) } + else { return qq["on":false,"bri":252] } + } + elsif ( $action eq 'set' ) { + + &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state )\n") if $main::Debug{'alexa'}; + $object->$sub($state); + return; + } + } + elsif ( $sub =~ /^run_voice_cmd$/ ) { + if ( $action eq 'set' ) { + $realname =~ s/#/$state/; + &main::print_log ("[Alexa] Debug: running voice command: ( $realname )\n") if $main::Debug{'alexa'}; + &main::run_voice_cmd("$realname"); + } + elsif ( $action eq 'get' ) { + return qq["on":false,"bri":252]; + } + + } + elsif ( ref($sub) eq 'CODE' ) { + &main::print_log ("[Alexa] Debug: running sub: $sub( $state ) \n") if $main::Debug{'alexa'}; + &{$sub}($state) if ($action eq 'set'); + return qq["on":false,"bri":252] if ($action eq 'get'); + } +} + +sub roundoff +{ + my $num = shift; + my $roundto = shift || 1; + + return int($num/$roundto+0.5)*$roundto; +} + +sub new { + my ($class) = @_; + my $self = new Generic_Item(); + bless $self, $class; + return $self; +} + +sub register { + my ( $self, $child ) = @_; + $self->{child} = $child; +} + +package AlexaBridge_Item; + +@AlexaBridge_Item::ISA = ('Generic_Item'); + +sub new { + my ($class, $parent) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $parent->register($self); + my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || DEFAULT_PORT_COUNT; + for my $count (0..$AlexaHttpPortCount) { + my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || DEFAULT_HTTP_PORT; + $AlexaHttpPort = ($AlexaHttpPort + $count); + $self->{'ports'}->{$AlexaHttpPort} = 0; + } + $self->{'ports'}->{$::config_parms{'http_port'}} = 0; + return $self; +} + +sub add { + my ($self, $realname, $name, $sub, $on, $off, $statesub) = @_; + + return unless defined $realname; + my $fullname; + my $cleanname = $realname; + $cleanname =~ s/\$//; + $cleanname =~ s/ //; + $cleanname =~ s/#//; + $cleanname =~ s/\\//; + $cleanname =~ s/&//; + + if ( defined($name) ) { + $fullname = $cleanname.'.'.$name; + } + else { + $fullname = $cleanname.'.'.$cleanname; + } + #use Data::Dumper; + my $uuid = $self->uuid($fullname); + + foreach my $port ( (sort keys %{$self->{'ports'}}) ) { + my $size = keys %{$self->{$port}->{'uuid'}}; + next if ($size eq 60); + $self->{$port}->{'uuid'}->{$uuid}->{'realname'}=$realname; + $self->{$port}->{'uuid'}->{$uuid}->{'name'}=$name || $cleanname; + $self->{$port}->{'uuid'}->{$uuid}->{'sub'}=$sub || 'set'; + $self->{$port}->{'uuid'}->{$uuid}->{'on'}=$on || 'on'; + $self->{$port}->{'uuid'}->{$uuid}->{'off'}=$off || 'off'; + $self->{$port}->{'uuid'}->{$uuid}->{'statesub'}=$statesub || 'state'; + last; + } + +# Testing groups, saw the Echo hit /api/odtQdwTaiTjPgURo4ZyEtGfIqRgfSeCm1fl2AMG2/groups/0 +#$self->{'groups'}->{0}->{'name'}='group0'; +#$self->{'groups'}->{0}->{'realname'}='$light0'; +#$self->{'groups'}->{0}->{'sub'}='set'; +#$self->{'groups'}->{0}->{'on'}='on'; +#$self->{'groups'}->{0}->{'off'}='off'; +#$self->{'groups'}->{1}->{'name'}='group1'; +#$self->{'groups'}->{1}->{'realname'}='$light1'; +#$self->{'groups'}->{1}->{'sub'}='set'; +#$self->{'groups'}->{1}->{'on'}='on'; +#$self->{'groups'}->{1}->{'off'}='off'; +#$self->{'groups'}->{2}->{'name'}='group2'; +#$self->{'groups'}->{2}->{'realname'}='$light2'; +#$self->{'groups'}->{2}->{'sub'}='set'; +#$self->{'groups'}->{2}->{'on'}='on'; +#$self->{'groups'}->{2}->{'off'}='off'; + #&main::print_log( Data::Dumper->Dumper($self->{'uuid'}) ); +} + +sub get_objects { + my ($self) = @_; + return $self->{'uuid'}; +} + +sub uuid { + my ($self, $name) = @_; + use Data::UUID; + $ug = Data::UUID->new; + $uuid = $ug->to_string( ( $ug->create_from_name(NameSpace_DNS, $name) ) ); + return lc($uuid); +} + +1; + diff --git a/lib/http_server.pl b/lib/http_server.pl index cf0f58624..04ee1f60c 100644 --- a/lib/http_server.pl +++ b/lib/http_server.pl @@ -7,7 +7,9 @@ use strict; use Text::ParseWords; +use AlexaBridge; require 'http_utils.pl'; +#require 'alexa_server.pl'; #use Data::Dumper; #$main::Debug{http} = 4; @@ -537,6 +539,10 @@ sub http_process_request { return; } + if ( my $alexa_response = &AlexaBridge::process_http($get_req, $req_typ, $Http{'Host'}, $HTTP_BODY, $socket) ) { + print $socket $alexa_response unless $alexa_response eq ' '; + return; + } # See if the request was for a file if ( &test_for_file( $socket, $get_req, $get_arg ) ) { } From 2824d2026f5e0ee7970dec1d6e89e64029357abe Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 6 Jan 2017 15:06:08 -0600 Subject: [PATCH 02/27] General Code cleanup, fixed some Google Home issues, added new ini option for mac addres --- lib/AlexaBridge.pm | 209 +++++++++++++++++++++++++++++++-------------- lib/http_server.pl | 2 +- 2 files changed, 145 insertions(+), 66 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index bfb9670b9..8b8015c36 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -18,7 +18,7 @@ use constant DEFAULT_LEASE_TIME => 1800; use constant DEFAULT_NOTIFICATION_PORT => 50000; use constant DEFAULT_PORT_COUNT => 0; -my ($ssdpNotificationName, $ssdpListenName, $AlexaGlobal); +my ($AlexaGlobal); sub startup { unless ($::config_parms{'alexa_enable'}) { return } @@ -28,25 +28,27 @@ sub startup { sub open_port { - my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || DEFAULT_PORT_COUNT; - for my $count (0..$AlexaHttpPortCount) { - my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || DEFAULT_HTTP_PORT; - $AlexaHttpPort = ($AlexaHttpPort + $count); - my $AlexaHttpName = 'alexaServer'.$count; - &http_ports($AlexaHttpName, $AlexaHttpPort); - $AlexaGlobal->{http_sockets}->{$AlexaHttpName} = new Socket_Item( undef, undef, $AlexaHttpName ); - &main::print_log ("Alexa open_port: p=$AlexaHttpPort pn=$AlexaHttpName s=$$AlexaHttpName\n") + my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || DEFAULT_PORT_COUNT; + if ($AlexaHttpPortCount) { + $AlexaHttpPortCount = ($AlexaHttpPortCount - 1); + for my $count (0..$AlexaHttpPortCount) { + my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || DEFAULT_HTTP_PORT; + $AlexaHttpPort = ($AlexaHttpPort + $count); + my $AlexaHttpName = 'alexaServer'.$count; + &http_ports($AlexaHttpName, $AlexaHttpPort); + $AlexaGlobal->{http_sockets}->{$AlexaHttpName} = new Socket_Item( undef, undef, $AlexaHttpName ); + $AlexaGlobal->{http_sockets}->{$AlexaHttpName}->{port} = $AlexaHttpPort; + &main::print_log ("Alexa open_port: p=$AlexaHttpPort pn=$AlexaHttpName s=$AlexaHttpName\n") if $main::Debug{alexa}; - } - - - $AlexaGlobal->{http_sender}->{'alexa_http_sender'} = new Socket_Item('alexa_http_sender', undef, $::config_parms{'http_server'}.':'.$::config_parms{'http_port'}, 'alexa_http_sender', 'tcp', 'raw'); + } + $AlexaGlobal->{http_sender}->{'alexa_http_sender'} = new Socket_Item('alexa_http_sender', undef, $::config_parms{'http_server'}.':'.$::config_parms{'http_port'}, 'alexa_http_sender', 'tcp', 'raw'); + } my $notificationPort = $::config_parms{'alexa_notification_port'} || DEFAULT_NOTIFICATION_PORT; - $ssdpNotificationName = 'alexaSsdpNotification'; + my $ssdpNotificationName = 'alexaSsdpNotification'; $ssdpNotificationSocket = new IO::Socket::INET->new( Proto => 'udp', LocalPort => $notificationPort) @@ -61,15 +63,15 @@ sub open_port { $::Socket_Ports{$ssdpNotificationName}{port} = $notificationPort; $::Socket_Ports{$ssdpNotificationName}{sock} = $ssdpNotificationSocket; $::Socket_Ports{$ssdpNotificationName}{socka} = $ssdpNotificationSocket; # UDP ports are always "active" - $alexa_ssdp_send = new Socket_Item( undef, undef, $ssdpNotificationName ); + $AlexaGlobal->{'ssdp_send'} = new Socket_Item( undef, undef, $ssdpNotificationName ); printf " - creating %-15s on %3s %5s %s\n", $ssdpNotificationName, 'udp', $notificationPort; - &main::print_log ("Alexa open_port: p=$notificationPort pn=$ssdpNotificationName s=$alexa_ssdp_send\n") + &main::print_log ("Alexa open_port: p=$notificationPort pn=$ssdpNotificationName s=".$AlexaGlobal->{'ssdp_send'} ."\n") if $main::Debug{alexa}; - $ssdpListenName = 'alexaSsdpListen'; - $ssdpListenSocket = new IO::Socket::Multicast->new( + my $ssdpListenName = 'alexaSsdpListen'; + my $ssdpListenSocket = new IO::Socket::Multicast->new( LocalPort => SSDP_PORT, Proto => 'udp', Reuse => 1) @@ -80,10 +82,10 @@ sub open_port { $::Socket_Ports{$ssdpListenName}{port} = SSDP_PORT; $::Socket_Ports{$ssdpListenName}{sock} = $ssdpListenSocket; $::Socket_Ports{$ssdpListenName}{socka} = $ssdpListenSocket; # UDP ports are always "active" - $alexa_ssdp_listen = new Socket_Item( undef, undef, $ssdpListenName ); + $AlexaGlobal->{'ssdp_listen'} = new Socket_Item( undef, undef, $ssdpListenName ); printf " - creating %-15s on %3s %5s %s\n", $ssdpListenName, 'udp', SSDP_PORT; - &main::print_log ("Alexa open_port: p=$ssdpPort pn=$ssdpListenName s=$alexa_ssdp_listen\n") + &main::print_log ("Alexa open_port: p=$ssdpPort pn=$ssdpListenName s=" .$AlexaGlobal->{'ssdp_listen'} ."\n") if $main::Debug{alexa}; return 1; @@ -109,28 +111,36 @@ sub http_ports { sub check_for_data { my $alexa_http_sender = $AlexaGlobal->{http_sender}->{'alexa_http_sender'}; - #foreach my $socketName ( keys %{$AlexaGlobal->{http_sockets}} ) { - my $socketName = 'alexaServer0'; - my $alexa_listen = $AlexaGlobal->{http_sockets}{$socketName}; + my $alexa_ssdp_listen = $AlexaGlobal->{ssdp_listen}; + #foreach my $AlexaHttpName ( keys %{$AlexaGlobal->{http_sockets}} ) { + my $AlexaHttpName = 'alexaServer0'; + my $alexa_listen = $AlexaGlobal->{http_sockets}{$AlexaHttpName}; if ( $alexa_listen && ( my $alexa_data = said $alexa_listen ) ) { #&main::print_log( "[Alexa] Info: Data - $alexa_data" ); $alexa_http_sender->start unless $alexa_http_sender->active; $alexa_http_sender->set($alexa_data); } + &_sendHttpData($alexa_listen, $alexa_http_sender); - if ( $alexa_http_sender && ( my $alexa_sender_data = said $alexa_http_sender ) ) { - $alexa_listen->set($alexa_sender_data); - # $alexa_http_sender->stop; - } # } + + my $alexa_ssdp_listen = $AlexaGlobal->{ssdp_listen}; if ( $alexa_ssdp_listen && ( my $ssdp_data = said $alexa_ssdp_listen) ) { - my $peer = $::Socket_Ports{$ssdpListenName}{from_ipport}; + my $peer = $::Socket_Ports{'alexaSsdpListen'}{from_ipport}; &_receiveSSDPEvent($ssdp_data, $peer); } } + + +sub _sendHttpData { + my ($alexa_listen, $alexa_http_sender) = @_; + if ( $alexa_http_sender && ( my $alexa_sender_data = said $alexa_http_sender ) ) { + $alexa_listen->set($alexa_sender_data); + } +} sub _receiveSSDPEvent { my ( $buf, $peer ) = @_; @@ -155,30 +165,65 @@ sub _receiveSSDPEvent { my $target; if ( $buf =~ /ST: urn:Belkin:device:\*\*.*/ ) { &_sendSearchResponse($peer) } elsif ( $buf =~ /ST: urn:schemas-upnp-org:device:basic:1.*/ ) { &_sendSearchResponse($peer) } + elsif ( $buf =~ /ST: ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } } sub _sendSearchResponse { - my $peer = shift; + my ($peer,$type) = @_; my $count = 0; my $selfname = (&main::list_objects_by_type('AlexaBridge'))[0]; my $self = ::get_object_by_name($selfname); + my $alexa_ssdp_send = $AlexaGlobal->{'ssdp_send'}; + my $mac = $::config_parms{'alexaMac'} || '9aa645cc40aa'; + foreach my $port ( (sort keys %{$self->{child}->{'ports'}}) ) { - next unless ( $self->{child}->{$port} ); - my $output = "HTTP/1.1 200 OK\r\n"; - $output .= 'Location: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; - $output .= 'OPT: '."\"http://schemas.upnp.org/upnp/1/0/\"\; ns\=01"."\r\n"; - $output .= '01-NLS: D1710C33-328D-4152-A5FA-5382541A92FF'."\r\n"; - $output .= 'USN: uuid:Socket-1_0-221438K0100073::urn:Belkin:device:**'."\r\n"; - $output .= 'Cache-control: max-age=86400'."\r\n"; - $output .= 'ST: urn:schemas-upnp-org:device:basic:1'."\r\n"; + next unless ( $self->{child}->{$port} ); + my $socket = handle $alexa_ssdp_send; + my $output; + if ($type eq 'all') { + $output = "HTTP/1.1 200 OK\r\n"; + $output .= 'HOST: 239.255.255.250:1900'."\r\n"; + $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; - $output .= "\r\n"; - my $socket = handle $alexa_ssdp_send; - + $output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/description.xml' ."\r\n"; + #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; + $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; + $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; + $output .= 'ST: upnp:rootdevice' ."\r\n"; + $output .= 'USN: uuid:'.$mac.'::upnp:rootdevice' ."\r\n"; + $output .= "\r\n"; + send($socket, $output, 0, $peer); + + $output = "HTTP/1.1 200 OK\r\n"; + $output .= 'HOST: 239.255.255.250:1900'."\r\n"; + $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; + $output .= 'EXT: '."\r\n"; + $output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/description.xml' ."\r\n"; + #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; + $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; + $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; + $output .= 'ST: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; + $output .= 'USN: uuid:2f402f80-da50-11e1-9b23-001e06'.$mac."\r\n"; + $output .= "\r\n"; + send($socket, $output, 0, $peer); + } + + $output = "HTTP/1.1 200 OK\r\n"; + $output .= 'HOST: 239.255.255.250:1900'."\r\n"; + $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; + $output .= 'EXT: '."\r\n"; + $output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/description.xml' ."\r\n"; + #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; + $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; + $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; + $output .= 'ST: urn:schemas-upnp-org:device:basic:1'."\r\n"; + $output .= 'USN: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; + $output .= "\r\n"; send($socket, $output, 0, $peer); + $count++; } } @@ -186,25 +231,34 @@ sub _sendSearchResponse { sub process_http { unless ($::config_parms{'alexa_enable'}) { return 0 } - my ( $uri, $request_type, $host, $body, $socket ) = @_; + my ( $uri, $request_type, $body, $socket, %Http ) = @_; - unless ( ($uri =~ /^\/upnp\//) || ($uri =~ /^\/api\//) ) { return 0 } # Added for performance + unless ( ($uri =~ /^\/upnp\//) || ($uri =~ /^\/api/ ) || ($uri =~ /^\/description.xml$/) ) { return 0 } # Added for performance my $selfname = (&main::list_objects_by_type('AlexaBridge'))[0]; my $self = ::get_object_by_name($selfname); unless ($self) { &main::print_log( "[Alexa] Error: No AlexaBridge parent object found" ); return 0 } use HTTP::Date qw(time2str); + use IO::Compress::Gzip qw(gzip); #get the port from the host header my @uris = split(/\//, $uri); + my $host = $Http{'Host'}; my $port; if ( $host =~ /(.*):(\d+)/ ) { $host = $1; $port = $2; + } + elsif ( $host =~ /(\d+)/ ) { + $host = $1; + $port = '80'; } - - + elsif ( $host =~ /(\w+)/ ) { + $host = $1; + $port = '80'; + } + my $xmlmessage = qq[ @@ -261,13 +315,13 @@ my $AlexaObjects; } else { &main::print_log( "[Alexa] Error: No Matching object for port ( $port )" ); - $output = "HTTP/1.1 404 Not Found\r\n"; + $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; return $output; } &main::print_log ("[Alexa] Debug: Port: ( $port ) URI: ( $uri ) Body: ( $body ) Type: ( $request_type ) \n") if $main::Debug{'alexa'}; - if ( ($uri =~ /^\/upnp\/.*\/setup.xml$/) && (lc($request_type) eq "get") ) { + if ( ( ($uri =~ /^\/upnp\/.*\/setup.xml$/) || ($uri =~ /^\/description.xml$/) ) && (lc($request_type) eq "get") ) { my $output = "HTTP/1.1 200 OK\r\n"; $output .= "Server: MisterHouse\r\n"; $output .= 'Access-Control-Allow-Origin: *'."\r\n"; @@ -280,9 +334,10 @@ my $AlexaObjects; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; $output .= $xmlmessage; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } - elsif ( ($uri =~ /^\/api\/$/) && (lc($request_type) eq "post") ) { + elsif ( ($uri =~ /^\/api/) && (lc($request_type) eq "post") ) { my $content = qq[\[{"success":{"username":"lights"}}\]]; my $output = "HTTP/1.1 200 OK\r\n"; $output .= "Server: MisterHouse\r\n"; @@ -296,6 +351,7 @@ my $AlexaObjects; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; $output .= $content; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } elsif ( ($uri =~ /^\/api\/.*\/lights\/(.*)\/state$/) && (lc($request_type) eq "put") ) { @@ -326,13 +382,15 @@ my $AlexaObjects; $output .= "\r\n"; $output .= $content; } else { - $output = "HTTP/1.1 404 Not Found\r\n"; + $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } - print $socket $output; # print direct to the socket so it does not close. - &main::http_process_request($socket); # we know there will be another request so get it in the same tcp session. - return ' '; - #return $output; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; + return $output; + #print $socket $output; # print direct to the socket so it does not close. + #&main::http_process_request($socket); # we know there will be another request so get it in the same tcp session. + #return ' '; } elsif ( ($uri =~ /^\/api\/.*/) && (lc($request_type) eq "get") ) { my $count = 0; @@ -349,12 +407,17 @@ my $AlexaObjects; $content = $statep1.$name.$statep2; $count = 1; } + elsif ( $uris[3] eq 'lights' ) { + &main::print_log("[Alexa] Error: No Matching object for UUID ( $uris[4] )"); + $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; + return $output; + } elsif ( ($uris[3] eq 'groups') && ($AlexaObjects->{'groups'}->{$uris[4]}) ) { $name = $AlexaObjects->{'groups'}->{$uris[4]}->{'name'}; $content = qq[{"action": {"on": true,"hue": 0,"effect": "none","bri": 100,"sat": 100,"ct": 500,"xy": \[0.5, 0.5\]},"lights": \["1","2"\],"state":{"any_on":true,"all_on":true}"type":"Room","class":"Other","name":"$name"}]; $count = 1; } - } elsif (defined $uris[3]) { if ( $uris[3] eq 'lights' ) { @@ -410,6 +473,7 @@ my $AlexaObjects; } if ($count >= 1) { $content = $content.$end; + $content = &_Gzip($content,$Http{'Accept-Encoding'}); $output = "HTTP/1.1 200 OK\r\n"; $output .= "Server: MisterHouse\r\n"; $output .= 'Access-Control-Allow-Origin: *'."\r\n"; @@ -418,18 +482,30 @@ my $AlexaObjects; $output .= 'Access-Control-Allow-Headers: Origin, X-Requested-With, Content-Type, Accept'."\r\n"; $output .= 'X-Application-Context: application'."\r\n"; $output .= 'Content-Type: application/json;charset=UTF-8'."\r\n"; + $output .= "Content-Encoding: gzip\r\n" if ($Http{'Accept-Encoding'} =~ m/gzip/); $output .= "Content-Length: ". (length $content) ."\r\n"; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; $output .= $content; } else { - my $output = "HTTP/1.1 404 Not Found\r\n"; + my $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; } + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } else { return 0 } } +sub _Gzip { + my ($content_raw, $Encoding) = @_; + my $content; + if ( $Encoding =~ m/gzip/ && ((length $content_raw) >= 1) ) { + gzip \$content_raw => \$content; + } + else { $content = $content_raw; } + return $content; +} + sub get_set_state { my ( $self, $AlexaObjects, $uuid, $action, $state ) = @_; my $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; @@ -450,7 +526,6 @@ sub get_set_state { else { return qq["on":false,"bri":252] } } elsif ( $action eq 'set' ) { - &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state )\n") if $main::Debug{'alexa'}; $object->$sub($state); return; @@ -461,16 +536,22 @@ sub get_set_state { $realname =~ s/#/$state/; &main::print_log ("[Alexa] Debug: running voice command: ( $realname )\n") if $main::Debug{'alexa'}; &main::run_voice_cmd("$realname"); + return; } elsif ( $action eq 'get' ) { return qq["on":false,"bri":252]; - } + } } elsif ( ref($sub) eq 'CODE' ) { - &main::print_log ("[Alexa] Debug: running sub: $sub( $state ) \n") if $main::Debug{'alexa'}; - &{$sub}($state) if ($action eq 'set'); - return qq["on":false,"bri":252] if ($action eq 'get'); + if ( $action eq 'set' ) { + &main::print_log ("[Alexa] Debug: running sub: $sub( $state ) \n") if $main::Debug{'alexa'}; + &{$sub}($state); + return; + } + elsif ( $action eq 'get' ) { + return qq["on":false,"bri":252]; + } } } @@ -503,12 +584,10 @@ sub new { my $self = new Generic_Item(); bless $self, $class; $parent->register($self); - my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || DEFAULT_PORT_COUNT; - for my $count (0..$AlexaHttpPortCount) { - my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || DEFAULT_HTTP_PORT; - $AlexaHttpPort = ($AlexaHttpPort + $count); - $self->{'ports'}->{$AlexaHttpPort} = 0; - } + foreach my $AlexaHttpName ( keys %{$AlexaGlobal->{http_sockets}} ) { + my $AlexaHttpPort = $AlexaGlobal->{http_sockets}->{$AlexaHttpName}->{port}; + $self->{'ports'}->{$AlexaHttpPort} = 0; + } $self->{'ports'}->{$::config_parms{'http_port'}} = 0; return $self; } diff --git a/lib/http_server.pl b/lib/http_server.pl index 04ee1f60c..abdf878ec 100644 --- a/lib/http_server.pl +++ b/lib/http_server.pl @@ -539,7 +539,7 @@ sub http_process_request { return; } - if ( my $alexa_response = &AlexaBridge::process_http($get_req, $req_typ, $Http{'Host'}, $HTTP_BODY, $socket) ) { + if ( my $alexa_response = &AlexaBridge::process_http($get_req, $req_typ, $HTTP_BODY, $socket, %Http) ) { print $socket $alexa_response unless $alexa_response eq ' '; return; } From 939f1ed68730c3e32ca0fa2110dde6db1ad704b0 Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 6 Jan 2017 17:30:22 -0600 Subject: [PATCH 03/27] More Google Home fixes --- lib/AlexaBridge.pm | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 8b8015c36..28216747f 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -163,9 +163,11 @@ sub _receiveSSDPEvent { } my $target; + &main::print_log ("[Alexa] Debug: SSDP IN - $buf \n") if $main::Debug{'alexa'}; if ( $buf =~ /ST: urn:Belkin:device:\*\*.*/ ) { &_sendSearchResponse($peer) } elsif ( $buf =~ /ST: urn:schemas-upnp-org:device:basic:1.*/ ) { &_sendSearchResponse($peer) } elsif ( $buf =~ /ST: ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } + elsif ( $buf =~ /ST:ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } } @@ -195,6 +197,7 @@ sub _sendSearchResponse { $output .= 'ST: upnp:rootdevice' ."\r\n"; $output .= 'USN: uuid:'.$mac.'::upnp:rootdevice' ."\r\n"; $output .= "\r\n"; + &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'}; send($socket, $output, 0, $peer); $output = "HTTP/1.1 200 OK\r\n"; @@ -208,6 +211,7 @@ sub _sendSearchResponse { $output .= 'ST: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; $output .= 'USN: uuid:2f402f80-da50-11e1-9b23-001e06'.$mac."\r\n"; $output .= "\r\n"; + &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'}; send($socket, $output, 0, $peer); } @@ -221,7 +225,8 @@ sub _sendSearchResponse { $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; $output .= 'ST: urn:schemas-upnp-org:device:basic:1'."\r\n"; $output .= 'USN: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; - $output .= "\r\n"; + $output .= "\r\n"; + &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'}; send($socket, $output, 0, $peer); $count++; @@ -334,7 +339,7 @@ my $AlexaObjects; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; $output .= $xmlmessage; - &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: MH Response $xmlmessage \n") if $main::Debug{'alexa'}; return $output; } elsif ( ($uri =~ /^\/api/) && (lc($request_type) eq "post") ) { @@ -421,15 +426,22 @@ my $AlexaObjects; } elsif (defined $uris[3]) { if ( $uris[3] eq 'lights' ) { - $statep1 = qq[{"]; - $statep2 = qq[":"]; - $end = qq["}]; - $delm = qq[","]; + #$statep1 = qq[{"]; + #$statep2 = qq[":"]; + #$end = qq["}]; + #$delm = qq[","]; + $statep1 = qq[{"lights":{"]; + $statep2 = qq[":{"state":{"on":false,"bri":254,"reachable":true},"type":"Extended color light","name":"]; + $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; + $end = qq[}}]; + $delm = qq[,"]; foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; next unless $name; - if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name } - else { $content = $statep1.$uuid.$statep2.$name } + #if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name } + #else { $content = $statep1.$uuid.$statep2.$name } + if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3 } + else { $content = $statep1.$uuid.$statep2.$name.$statep3 } $count++; } } From 0282788dabec67a2920a2a1d55bdb97f90dd545c Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 6 Jan 2017 22:53:53 -0600 Subject: [PATCH 04/27] Changed UUIDs to numeric only for Google Home --- lib/AlexaBridge.pm | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 28216747f..9ff4f24ea 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -426,22 +426,26 @@ my $AlexaObjects; } elsif (defined $uris[3]) { if ( $uris[3] eq 'lights' ) { - #$statep1 = qq[{"]; + $statep1 = qq[{"]; #$statep2 = qq[":"]; #$end = qq["}]; #$delm = qq[","]; - $statep1 = qq[{"lights":{"]; + #### 1 $statep2 = qq[":{"state":{"on":false,"bri":254,"reachable":true},"type":"Extended color light","name":"]; $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; - $end = qq[}}]; + $end = qq[}]; $delm = qq[,"]; + #### 2 + foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; next unless $name; #if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name } #else { $content = $statep1.$uuid.$statep2.$name } + #### 1 if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3 } else { $content = $statep1.$uuid.$statep2.$name.$statep3 } + #### 2 $count++; } } @@ -610,11 +614,11 @@ sub add { return unless defined $realname; my $fullname; my $cleanname = $realname; - $cleanname =~ s/\$//; - $cleanname =~ s/ //; - $cleanname =~ s/#//; - $cleanname =~ s/\\//; - $cleanname =~ s/&//; + $cleanname =~ s/\$//g; + $cleanname =~ s/ //g; + $cleanname =~ s/#//g; + $cleanname =~ s/\\//g; + $cleanname =~ s/&//g; if ( defined($name) ) { $fullname = $cleanname.'.'.$name; @@ -666,6 +670,9 @@ sub uuid { use Data::UUID; $ug = Data::UUID->new; $uuid = $ug->to_string( ( $ug->create_from_name(NameSpace_DNS, $name) ) ); + $uuid =~ s/\D//g; + $uuid =~ s/-//g; + #$uuid = (substr $uuid, 0, 18); return lc($uuid); } From 3aa074537f2f3f80d4e18f5e90f84b320c55167c Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 01:14:07 -0600 Subject: [PATCH 05/27] Added IP and Mac discovery --- lib/AlexaBridge.pm | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 9ff4f24ea..243f213a6 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -18,7 +18,11 @@ use constant DEFAULT_LEASE_TIME => 1800; use constant DEFAULT_NOTIFICATION_PORT => 50000; use constant DEFAULT_PORT_COUNT => 0; -my ($AlexaGlobal); +my ($LOCAL_IP, $LOCAL_MAC) = &DiscoverAddy unless ( (defined($::config_parms{'alexaMac'})) && (defined($::config_parms{'alexaHttpIp'})) ); +$LOCAL_IP = $::config_parms{'alexaHttpIp'} if defined($::config_parms{'alexaHttpIp'}); +$LOCAL_MAC = $::config_parms{'alexaMac'} if defined($::config_parms{'alexaMac'}); + +my $AlexaGlobal; sub startup { unless ($::config_parms{'alexa_enable'}) { return } @@ -178,7 +182,7 @@ sub _sendSearchResponse { my $selfname = (&main::list_objects_by_type('AlexaBridge'))[0]; my $self = ::get_object_by_name($selfname); my $alexa_ssdp_send = $AlexaGlobal->{'ssdp_send'}; - my $mac = $::config_parms{'alexaMac'} || '9aa645cc40aa'; + my $mac = $LOCAL_MAC; foreach my $port ( (sort keys %{$self->{child}->{'ports'}}) ) { @@ -190,7 +194,7 @@ sub _sendSearchResponse { $output .= 'HOST: 239.255.255.250:1900'."\r\n"; $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; - $output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/description.xml' ."\r\n"; + $output .= 'LOCATION: http://'.$LOCAL_IP.':'.$port.'/description.xml' ."\r\n"; #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; @@ -204,7 +208,7 @@ sub _sendSearchResponse { $output .= 'HOST: 239.255.255.250:1900'."\r\n"; $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; - $output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/description.xml' ."\r\n"; + $output .= 'LOCATION: http://'.$LOCAL_IP.':'.$port.'/description.xml' ."\r\n"; #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; @@ -219,7 +223,7 @@ sub _sendSearchResponse { $output .= 'HOST: 239.255.255.250:1900'."\r\n"; $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; - $output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/description.xml' ."\r\n"; + $output .= 'LOCATION: http://'.$LOCAL_IP.':'.$port.'/description.xml' ."\r\n"; #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; @@ -270,10 +274,10 @@ my $xmlmessage = qq[ 1 0 -http://$::config_parms{'alexaHttpIp'}:$port/ +http://$LOCAL_IP:$port/ urn:schemas-upnp-org:device:basic:1 -Amazon-Echo-MH-Bridge (192.168.195.37) +Amazon-Echo-MH-Bridge ($LOCAL_IP) Royal Philips Electronics http://misterhouse.sourceforge.net/ Hue Emulator for Amazon Echo bridge @@ -522,6 +526,22 @@ sub _Gzip { return $content; } +sub DiscoverAddy { + use Net::Address::Ethernet qw( :all ); + my @a = get_addresses(@_); + foreach my $adapter (@a) { + # print $adapter->{sIP}."\n"; + # print $adapter->{sEthernet}."\n"; + # print "____________________\n"; + next unless ($adapter->{iActive} eq 1); + next if ($adapter->{sEthernet} eq ''); + next if ($adapter->{sIP} =~ /127\.0\.0\.1/); + my $Mac = $adapter->{sEthernet}; + $Mac =~ s/://g; + return ($adapter->{sIP},$Mac); + } +} + sub get_set_state { my ( $self, $AlexaObjects, $uuid, $action, $state ) = @_; my $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; From 75991869bad3f8c854e37b2a79668a2992630e82 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 08:47:09 -0600 Subject: [PATCH 06/27] Added more debugs, changed http debug to level 2 and SSDP debug to level 3 --- lib/AlexaBridge.pm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 243f213a6..6c1c5ce61 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -167,7 +167,7 @@ sub _receiveSSDPEvent { } my $target; - &main::print_log ("[Alexa] Debug: SSDP IN - $buf \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: SSDP IN - $buf \n") if $main::Debug{'alexa'} >= 3; if ( $buf =~ /ST: urn:Belkin:device:\*\*.*/ ) { &_sendSearchResponse($peer) } elsif ( $buf =~ /ST: urn:schemas-upnp-org:device:basic:1.*/ ) { &_sendSearchResponse($peer) } elsif ( $buf =~ /ST: ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } @@ -201,7 +201,7 @@ sub _sendSearchResponse { $output .= 'ST: upnp:rootdevice' ."\r\n"; $output .= 'USN: uuid:'.$mac.'::upnp:rootdevice' ."\r\n"; $output .= "\r\n"; - &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'} >= 3; send($socket, $output, 0, $peer); $output = "HTTP/1.1 200 OK\r\n"; @@ -215,7 +215,7 @@ sub _sendSearchResponse { $output .= 'ST: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; $output .= 'USN: uuid:2f402f80-da50-11e1-9b23-001e06'.$mac."\r\n"; $output .= "\r\n"; - &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'} >= 3; send($socket, $output, 0, $peer); } @@ -230,7 +230,7 @@ sub _sendSearchResponse { $output .= 'ST: urn:schemas-upnp-org:device:basic:1'."\r\n"; $output .= 'USN: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; $output .= "\r\n"; - &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: SSDP OUT - $output \n") if $main::Debug{'alexa'} >= 3; send($socket, $output, 0, $peer); $count++; @@ -343,7 +343,7 @@ my $AlexaObjects; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; $output .= $xmlmessage; - &main::print_log ("[Alexa] Debug: MH Response $xmlmessage \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: MH Response $xmlmessage \n") if $main::Debug{'alexa'} >= 2; return $output; } elsif ( ($uri =~ /^\/api/) && (lc($request_type) eq "post") ) { @@ -360,7 +360,7 @@ my $AlexaObjects; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; $output .= $content; - &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'} >= 2; return $output; } elsif ( ($uri =~ /^\/api\/.*\/lights\/(.*)\/state$/) && (lc($request_type) eq "put") ) { @@ -374,6 +374,7 @@ my $AlexaObjects; if ( $body =~ /\"(bri)\": (\d+)/ ) { $state = $2 } elsif ( $body =~ /\"(bri)\":(\d+)/ ) { $state = $2 } my $content = qq[\[{"success":{"/lights/$deviceID/state/$1":$2}}\]]; + &main::print_log ("[Alexa] Debug: MH Got request ( $1 - $2 ) to Set device ( $deviceID ) to ( $state )\n") if $main::Debug{'alexa'}; if ( ($AlexaObjects->{'uuid'}->{$deviceID}) && (defined($state)) ) { &get_set_state($self, $AlexaObjects, $deviceID, 'set', $state); @@ -392,10 +393,11 @@ my $AlexaObjects; $output .= $content; } else { $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + &main::print_log("[Alexa] Error: No Matching object for UUID ( $deviceID )"); &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } - &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'} >= 2; return $output; #print $socket $output; # print direct to the socket so it does not close. #&main::http_process_request($socket); # we know there will be another request so get it in the same tcp session. @@ -493,6 +495,7 @@ my $AlexaObjects; } if ($count >= 1) { $content = $content.$end; + $debugcontent = $content if $main::Debug{'alexa'} >= 2; $content = &_Gzip($content,$Http{'Accept-Encoding'}); $output = "HTTP/1.1 200 OK\r\n"; $output .= "Server: MisterHouse\r\n"; @@ -510,7 +513,7 @@ my $AlexaObjects; } else { my $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; } - &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; + &main::print_log ("[Alexa] Debug: MH Response $debugcontent \n") if $main::Debug{'alexa'} >= 2; return $output; } else { return 0 } From 713de7aa972a9f7913d45cc5304644404ef25caf Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 09:56:29 -0600 Subject: [PATCH 07/27] Fixed space issue in state message for Google Home --- lib/AlexaBridge.pm | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 6c1c5ce61..dde2001f6 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -324,7 +324,7 @@ my $AlexaObjects; } else { &main::print_log( "[Alexa] Error: No Matching object for port ( $port )" ); - $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n\r\n"; return $output; } @@ -367,6 +367,7 @@ my $AlexaObjects; my $output; my $deviceID = $1; my $state = undef; + if ($body =~ /:\w/ ) { $body =~ s/:/: /g } if ( $body =~ /\"(on)\": (true)/ ) { $state = 'on' } elsif ( $body =~ /\"(on)\": (false)/ ) { $state = 'off' } elsif ( $body =~ /\"(off)\": (true)/ ) { $state = 'off' } @@ -552,17 +553,17 @@ sub get_set_state { my $sub = $AlexaObjects->{'uuid'}->{$uuid}->{'sub'}; my $statesub = $AlexaObjects->{'uuid'}->{$uuid}->{'statesub'}; $state = $AlexaObjects->{'uuid'}->{$uuid}->{$state} if $AlexaObjects->{'uuid'}->{$uuid}->{$state}; - if ( $state =~ /\d+/ ) { $state = &roundoff($state / 2.52) } + if ( $state =~ /\d+/ ) { $state = &roundoff($state / 2.54) } &main::print_log ("[Alexa] Debug: get_set_state ($uuid $action $state) : name: $name realname: $realname sub: $sub state: $state\n") if $main::Debug{'alexa'}; if ( $realname =~ /^\$/ ) { my $object = ::get_object_by_name( $realname ); if ( $action eq 'get' ) { my $cstate = $object->$statesub; $cstate =~ s/\%//; - if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":252] } - elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":252] } - elsif ( $cstate =~ /\d+/ ) { return qq["on":true,"bri":].&roundoff($cstate * 2.52) } - else { return qq["on":false,"bri":252] } + if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":254] } + elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":254] } + elsif ( $cstate =~ /\d+/ ) { return qq["on":true,"bri":].&roundoff($cstate * 2.54) } + else { return qq["on":false,"bri":254] } } elsif ( $action eq 'set' ) { &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state )\n") if $main::Debug{'alexa'}; @@ -578,7 +579,7 @@ sub get_set_state { return; } elsif ( $action eq 'get' ) { - return qq["on":false,"bri":252]; + return qq["on":false,"bri":254]; } } @@ -589,7 +590,7 @@ sub get_set_state { return; } elsif ( $action eq 'get' ) { - return qq["on":false,"bri":252]; + return qq["on":false,"bri":254]; } } } From a0e1847496e29bb4899b82066cca30a8af14a7d4 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 10:23:17 -0600 Subject: [PATCH 08/27] Fixed space issue in state message for Google Home - Again --- lib/AlexaBridge.pm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index dde2001f6..43d9258f6 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -367,13 +367,12 @@ my $AlexaObjects; my $output; my $deviceID = $1; my $state = undef; - if ($body =~ /:\w/ ) { $body =~ s/:/: /g } - if ( $body =~ /\"(on)\": (true)/ ) { $state = 'on' } - elsif ( $body =~ /\"(on)\": (false)/ ) { $state = 'off' } - elsif ( $body =~ /\"(off)\": (true)/ ) { $state = 'off' } - elsif ( $body =~ /\"(off)\": (false)/ ) { $state = 'on' } - if ( $body =~ /\"(bri)\": (\d+)/ ) { $state = $2 } - elsif ( $body =~ /\"(bri)\":(\d+)/ ) { $state = $2 } + $body =~ s/: /:/g; + if ( $body =~ /\"(on)\":(true)/ ) { $state = 'on' } + elsif ( $body =~ /\"(on)\":(false)/ ) { $state = 'off' } + elsif ( $body =~ /\"(off)\":(true)/ ) { $state = 'off' } + elsif ( $body =~ /\"(off)\":(false)/ ) { $state = 'on' } + if ( $body =~ /\"(bri)\":(\d+)/ ) { $state = $2 } my $content = qq[\[{"success":{"/lights/$deviceID/state/$1":$2}}\]]; &main::print_log ("[Alexa] Debug: MH Got request ( $1 - $2 ) to Set device ( $deviceID ) to ( $state )\n") if $main::Debug{'alexa'}; @@ -394,7 +393,8 @@ my $AlexaObjects; $output .= $content; } else { $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; - &main::print_log("[Alexa] Error: No Matching object for UUID ( $deviceID )"); + &main::print_log("[Alexa] Error: No Matching object for UUID ( $deviceID )") unless ($AlexaObjects->{'uuid'}->{$deviceID}); + &main::print_log("[Alexa] Error: Missing State from PUT for object with UUID ( $deviceID )") unless (defined($state)); &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } From b8d491b04593465316c6e0771168bf4bc5866477 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 10:37:46 -0600 Subject: [PATCH 09/27] Fixed space issue in state message for Google Home - Again --- lib/AlexaBridge.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 43d9258f6..f862db8b2 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -566,8 +566,10 @@ sub get_set_state { else { return qq["on":false,"bri":254] } } elsif ( $action eq 'set' ) { - &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state )\n") if $main::Debug{'alexa'}; - $object->$sub($state); + my $end; + if ($object->$statesub =~ /%/) { $end = '%' } + &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state$end )\n") if $main::Debug{'alexa'}; + $object->$sub($state.$end); return; } } From 4ab8f10c4b78e023249bcef278e95d8fbc410de8 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 17:44:59 -0600 Subject: [PATCH 10/27] Fixed space issue in state message for Google Home - Again --- lib/AlexaBridge.pm | 51 ++++++++++++++++------------------------------ 1 file changed, 18 insertions(+), 33 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index f862db8b2..09b82be06 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -413,7 +413,6 @@ my $AlexaObjects; $uuid = $uris[4]; $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; my $state = &get_set_state($self, $AlexaObjects, $uuid,'get'); - $statep1 = qq[{"state":{$state,"hue":15823,"sat":88,"effect":"none","ct":313,"alert":"none","colormode":"ct","reachable":true,"xy":\[0.4255,0.3998\]},"type":"Extended color light","name":"]; $statep2 = qq[","modelid":"LCT001","manufacturername":"Philips","uniqueid":"$uuid","swversion":"65003148","pointsymbol":{"1":"none","2":"none","3":"none","4":"none","5":"none","6":"none","7":"none","8":"none"}}]; $content = $statep1.$name.$statep2; @@ -433,26 +432,17 @@ my $AlexaObjects; } elsif (defined $uris[3]) { if ( $uris[3] eq 'lights' ) { - $statep1 = qq[{"]; - #$statep2 = qq[":"]; - #$end = qq["}]; - #$delm = qq[","]; - #### 1 - $statep2 = qq[":{"state":{"on":false,"bri":254,"reachable":true},"type":"Extended color light","name":"]; - $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; - $end = qq[}]; - $delm = qq[,"]; - #### 2 - foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; - next unless $name; - #if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name } - #else { $content = $statep1.$uuid.$statep2.$name } - #### 1 + next unless $name; + my $state = &get_set_state($self, $AlexaObjects, $uuid,'get'); + $statep1 = qq[{"]; + $statep2 = qq[":{"state":{$state,"reachable":true},"type":"Extended color light","name":"]; + $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; + $end = qq[}]; + $delm = qq[,"]; if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3 } else { $content = $statep1.$uuid.$statep2.$name.$statep3 } - #### 2 $count++; } } @@ -475,20 +465,15 @@ my $AlexaObjects; } } elsif (defined $uris[2]) { - $statep1 = qq[{"lights":{"]; - #$statep2 = qq[":{"state":{"on":false,"bri":254,"hue":15823,"sat":88,"effect":"none","ct":313,"alert":"none","colormode":"ct","reachable":true,"xy":\[0.4255,0.3998\]},"type":"Extended color light","name":"]; - $statep2 = qq[":{"state":{"on":false,"bri":254,"reachable":true},"type":"Extended color light","name":"]; # dis - #$statep2 = qq[":{"state":{"on":false,"bri":254,"hue":15823,"sat":88,"effect":"none","ct":313,"alert":"none","colormode":"ct","reachable":true},"type":"Extended color light","name":"]; - #$statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","uniqueid":"]; - $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; # - #$statep4 = qq[","swversion":"65003148","pointsymbol":{"1":"none","2":"none","3":"none","4":"none","5":"none","6":"none","7":"none","8":"none"}}]; - $end = qq[}}]; - $delm = qq[,"]; foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { - $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; next unless $name; - #if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3.$uuid.$statep4 } - #else { $content = $statep1.$uuid.$statep2.$name.$statep3.$uuid.$statep4 } + my $state = &get_set_state($self, $AlexaObjects, $uuid,'get'); + $statep1 = qq[{"lights":{"]; + $statep2 = qq[":{"state":{$state,"reachable":true},"type":"Extended color light","name":"]; # dis + $statep3 = qq[","modelid":"LCT001","manufacturername":"Philips","swversion":"65003148"}]; # + $end = qq[}}]; + $delm = qq[,"]; if ($count >= 1) { $content = $content.$delm.$uuid.$statep2.$name.$statep3 } else { $content = $statep1.$uuid.$statep2.$name.$statep3 } $count++; @@ -563,11 +548,11 @@ sub get_set_state { if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":254] } elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":254] } elsif ( $cstate =~ /\d+/ ) { return qq["on":true,"bri":].&roundoff($cstate * 2.54) } - else { return qq["on":false,"bri":254] } + else { return qq["on":true,"bri":254] } } elsif ( $action eq 'set' ) { my $end; - if ($object->$statesub =~ /%/) { $end = '%' } + if ($object->$statesub =~ /\%/) { $end = '%' } &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state$end )\n") if $main::Debug{'alexa'}; $object->$sub($state.$end); return; @@ -581,7 +566,7 @@ sub get_set_state { return; } elsif ( $action eq 'get' ) { - return qq["on":false,"bri":254]; + return qq["on":true,"bri":254]; } } @@ -592,7 +577,7 @@ sub get_set_state { return; } elsif ( $action eq 'get' ) { - return qq["on":false,"bri":254]; + return qq["on":true,"bri":254]; } } } From 073b396da28b16b1032efe10f4e4a56bb0b4ad34 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 7 Jan 2017 17:49:33 -0600 Subject: [PATCH 11/27] Added correct states in all responses as is seems that Google Home actually uses them --- lib/AlexaBridge.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 09b82be06..416610b2a 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -683,7 +683,7 @@ sub uuid { $uuid = $ug->to_string( ( $ug->create_from_name(NameSpace_DNS, $name) ) ); $uuid =~ s/\D//g; $uuid =~ s/-//g; - #$uuid = (substr $uuid, 0, 18); + $uuid = (substr $uuid, 0, 9); return lc($uuid); } From f646325502a8b73b693fd5d111c2367d46203afe Mon Sep 17 00:00:00 2001 From: waynieack Date: Sun, 8 Jan 2017 02:26:58 -0600 Subject: [PATCH 12/27] Added correct states in all responses as is seems that Google Home actually uses them --- lib/AlexaBridge.pm | 73 ++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 61 insertions(+), 12 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 416610b2a..7518097ce 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -545,14 +545,17 @@ sub get_set_state { if ( $action eq 'get' ) { my $cstate = $object->$statesub; $cstate =~ s/\%//; - if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":254] } - elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":254] } + my $level = '254'; + if ( $object->can('state_level') ) { $level = ( &roundoff(($object->level) * 2.54) ) } + if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":$level] } + elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":$level] } elsif ( $cstate =~ /\d+/ ) { return qq["on":true,"bri":].&roundoff($cstate * 2.54) } - else { return qq["on":true,"bri":254] } + else { return qq["on":true,"bri":$level] } } elsif ( $action eq 'set' ) { my $end; - if ($object->$statesub =~ /\%/) { $end = '%' } + #if ($object->$statesub =~ /\%/) { $end = '%' } + if ( $object->can('state_level') ) { $end = '%'} &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state$end )\n") if $main::Debug{'alexa'}; $object->$sub($state.$end); return; @@ -605,17 +608,23 @@ sub register { package AlexaBridge_Item; @AlexaBridge_Item::ISA = ('Generic_Item'); +use Storable; sub new { my ($class, $parent) = @_; my $self = new Generic_Item(); + my $file = $::config_parms{'data_dir'}.'/alexa_temp.saved_id'; bless $self, $class; $parent->register($self); foreach my $AlexaHttpName ( keys %{$AlexaGlobal->{http_sockets}} ) { my $AlexaHttpPort = $AlexaGlobal->{http_sockets}->{$AlexaHttpName}->{port}; $self->{'ports'}->{$AlexaHttpPort} = 0; } - $self->{'ports'}->{$::config_parms{'http_port'}} = 0; + $self->{'ports'}->{$::config_parms{'http_port'}} = 0; + if (-e $file) { + my $restoredhash = retrieve($file); + $self->{idmap} = $restoredhash->{idmap}; + } else { $self->{idmap} } return $self; } @@ -652,6 +661,13 @@ sub add { last; } + # $self->{8080}->{'uuid'}->{3}->{'realname'}=$realname; + # $self->{8080}->{'uuid'}->{3}->{'name'}=$name || $cleanname; + # $self->{8080}->{'uuid'}->{3}->{'sub'}=$sub || 'set'; + # $self->{8080}->{'uuid'}->{3}->{'on'}=$on || 'on'; + # $self->{8080}->{'uuid'}->{3}->{'off'}=$off || 'off'; + # $self->{8080}->{'uuid'}->{3}->{'statesub'}=$statesub || 'state'; + # Testing groups, saw the Echo hit /api/odtQdwTaiTjPgURo4ZyEtGfIqRgfSeCm1fl2AMG2/groups/0 #$self->{'groups'}->{0}->{'name'}='group0'; #$self->{'groups'}->{0}->{'realname'}='$light0'; @@ -678,13 +694,46 @@ sub get_objects { sub uuid { my ($self, $name) = @_; - use Data::UUID; - $ug = Data::UUID->new; - $uuid = $ug->to_string( ( $ug->create_from_name(NameSpace_DNS, $name) ) ); - $uuid =~ s/\D//g; - $uuid =~ s/-//g; - $uuid = (substr $uuid, 0, 9); - return lc($uuid); + my $file = $::config_parms{'data_dir'}.'/alexa_temp.saved_id'; + return $self->{'idmap'}->{objects}->{$name} if ($self->{'idmap'}->{objects}->{$name}); + + my $highid; + my $missing; + my $count = 1; + foreach my $object (keys %{$self->{idmap}->{objects}}) { + my $currentid = $self->{idmap}->{objects}->{$object}; + $highid = $currentid if ( $currentid > $highid ); + $missing = $count unless ( $self->{'idmap'}->{ids}->{$count} ); #We have a number that has no value + $count++; + } + $highid++; + +$highid = $missing if ( defined($missing) ); # Reuse numbers for deleted objects to keep the count from growning for ever. + +$self->{'idmap'}->{objects}->{$name} = $highid; +$self->{'idmap'}->{ids}->{$highid} = $name; + +my $idmap->{'idmap'} = $self->{'idmap'}; +store $idmap, $file; +return $highid; + +# use Data::UUID; +# $ug = Data::UUID->new; +# $uuid = $ug->to_string( ( $ug->create_from_name(NameSpace_DNS, $name) ) ); +# $uuid =~ s/\D//g; +# $uuid =~ s/-//g; +# $uuid = (substr $uuid, 0, 9); +# return lc($uuid); +} + +sub isDeleted { + my ($self, $uuid) = @_; + my $count; + foreach my $port ( (sort keys %{$self->{'ports'}}) ) { + $count++ if ( $self->{$port}->{'uuid'}->{$uuid} ); + } + return 1 unless $count; + return 0; } 1; From 8d11e3e5c9bfe57792e9426056f307af7e4d0e9d Mon Sep 17 00:00:00 2001 From: waynieack Date: Sun, 8 Jan 2017 19:00:19 -0600 Subject: [PATCH 13/27] FIxed % with on/off command --- lib/AlexaBridge.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 7518097ce..b608741fa 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -555,7 +555,7 @@ sub get_set_state { elsif ( $action eq 'set' ) { my $end; #if ($object->$statesub =~ /\%/) { $end = '%' } - if ( $object->can('state_level') ) { $end = '%'} + if ( $object->can('state_level') && $state =~ /\d+/ ) { $end = '%'} &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state$end )\n") if $main::Debug{'alexa'}; $object->$sub($state.$end); return; From 272566c9bb593845583abc8c7322294a13f0277b Mon Sep 17 00:00:00 2001 From: waynieack Date: Sun, 8 Jan 2017 19:17:18 -0600 Subject: [PATCH 14/27] Fixed crash with undefined object --- lib/AlexaBridge.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index b608741fa..418e76466 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -542,6 +542,7 @@ sub get_set_state { &main::print_log ("[Alexa] Debug: get_set_state ($uuid $action $state) : name: $name realname: $realname sub: $sub state: $state\n") if $main::Debug{'alexa'}; if ( $realname =~ /^\$/ ) { my $object = ::get_object_by_name( $realname ); + return qq["on":true,"bri":254] unless defined $object; if ( $action eq 'get' ) { my $cstate = $object->$statesub; $cstate =~ s/\%//; From ee07f2a2e40729385d1a30efab537aae7079b5b8 Mon Sep 17 00:00:00 2001 From: waynieack Date: Mon, 9 Jan 2017 14:50:31 -0600 Subject: [PATCH 15/27] Added more debug messages to get state --- lib/AlexaBridge.pm | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 418e76466..de822eda2 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -537,7 +537,7 @@ sub get_set_state { my $realname = $AlexaObjects->{'uuid'}->{$uuid}->{'realname'}; my $sub = $AlexaObjects->{'uuid'}->{$uuid}->{'sub'}; my $statesub = $AlexaObjects->{'uuid'}->{$uuid}->{'statesub'}; - $state = $AlexaObjects->{'uuid'}->{$uuid}->{$state} if $AlexaObjects->{'uuid'}->{$uuid}->{$state}; + $state = $AlexaObjects->{'uuid'}->{$uuid}->{lc($state)} if $AlexaObjects->{'uuid'}->{$uuid}->{lc($state)}; if ( $state =~ /\d+/ ) { $state = &roundoff($state / 2.54) } &main::print_log ("[Alexa] Debug: get_set_state ($uuid $action $state) : name: $name realname: $realname sub: $sub state: $state\n") if $main::Debug{'alexa'}; if ( $realname =~ /^\$/ ) { @@ -547,11 +547,15 @@ sub get_set_state { my $cstate = $object->$statesub; $cstate =~ s/\%//; my $level = '254'; - if ( $object->can('state_level') ) { $level = ( &roundoff(($object->level) * 2.54) ) } - if ( $AlexaObjects->{'uuid'}->{$uuid}->{'on'} eq $cstate ) { return qq["on":true,"bri":$level] } - elsif ( $AlexaObjects->{'uuid'}->{$uuid}->{'off'} eq $cstate ) { return qq["on":false,"bri":$level] } - elsif ( $cstate =~ /\d+/ ) { return qq["on":true,"bri":].&roundoff($cstate * 2.54) } - else { return qq["on":true,"bri":$level] } + my $debug = "[Alexa] Debug: get_state (actual object state: $cstate) - "; + my $return; + if ( $object->can('state_level') ) { $level = ( &roundoff(($object->level) * 2.54) ); $debug .= "(level: $level) - "; } + if ( lc($AlexaObjects->{'uuid'}->{$uuid}->{'on'}) eq lc($cstate) ) { $return = qq["on":true,"bri":$level] } + elsif ( lc($AlexaObjects->{'uuid'}->{$uuid}->{'off'}) eq lc($cstate) ) { $return = qq["on":false,"bri":$level] } + elsif ( $cstate =~ /\d+/ ) { $return = qq["on":true,"bri":].&roundoff($cstate * 2.54) } + else { $return = qq["on":true,"bri":$level] } + &main::print_log ( "$debug returning - $return\n" ) if $main::Debug{'alexa'}; + return $return; } elsif ( $action eq 'set' ) { my $end; @@ -656,8 +660,8 @@ sub add { $self->{$port}->{'uuid'}->{$uuid}->{'realname'}=$realname; $self->{$port}->{'uuid'}->{$uuid}->{'name'}=$name || $cleanname; $self->{$port}->{'uuid'}->{$uuid}->{'sub'}=$sub || 'set'; - $self->{$port}->{'uuid'}->{$uuid}->{'on'}=$on || 'on'; - $self->{$port}->{'uuid'}->{$uuid}->{'off'}=$off || 'off'; + $self->{$port}->{'uuid'}->{$uuid}->{'on'}=lc($on) || 'on'; + $self->{$port}->{'uuid'}->{$uuid}->{'off'}=lc($off) || 'off'; $self->{$port}->{'uuid'}->{$uuid}->{'statesub'}=$statesub || 'state'; last; } From 5fb412421506656f4350fdca9b9d59582c947565 Mon Sep 17 00:00:00 2001 From: waynieack Date: Mon, 9 Jan 2017 16:28:33 -0600 Subject: [PATCH 16/27] Fixed x10 object so dim/brighten/-%/+% states are on --- lib/AlexaBridge.pm | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index de822eda2..476b459a0 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -547,9 +547,21 @@ sub get_set_state { my $cstate = $object->$statesub; $cstate =~ s/\%//; my $level = '254'; - my $debug = "[Alexa] Debug: get_state (actual object state: $cstate) - "; + my $type = $object->get_type(); + my $debug = "[Alexa] Debug: get_state (actual object state: $cstate) - (object type: $type) - "; my $return; - if ( $object->can('state_level') ) { $level = ( &roundoff(($object->level) * 2.54) ); $debug .= "(level: $level) - "; } + if ( $object->can('state_level') ) { + my $l = $object->level; + $l =~ s/\%//; + if ( $l =~ /\d+/ ) { + $level = ( &roundoff(($l) * 2.54) ); + $debug .= "(level: $level) - "; + } + } + if ( lc($type) =~ /x10/ ) { + if ( ($cstate =~ /\d+/) || ($cstate =~ /dim/) || ($cstate =~ /bright/) ) { $cstate = 'on' } + $debug .= "(determined state: $cstate) - "; + } if ( lc($AlexaObjects->{'uuid'}->{$uuid}->{'on'}) eq lc($cstate) ) { $return = qq["on":true,"bri":$level] } elsif ( lc($AlexaObjects->{'uuid'}->{$uuid}->{'off'}) eq lc($cstate) ) { $return = qq["on":false,"bri":$level] } elsif ( $cstate =~ /\d+/ ) { $return = qq["on":true,"bri":].&roundoff($cstate * 2.54) } @@ -590,6 +602,20 @@ sub get_set_state { } } +sub get_state { +my ( $self, $object, $statesub ) = @_; + my $cstate = $object->$statesub; + $cstate =~ s/\%//; + my $type = $object->get_type(); + my $debug = "[Alexa] Debug: get_state (actual object state: $cstate) - (object type: $type) - "; + if ( lc($type) =~ /x10/ ) { + if ( ($state =~ /\d+/) || ($state =~ /dim/) || ($state =~ /bright/) ) { $cstate = 'on' } + } + $debug .= "(determined state: $cstate) - "; + return $cstate; +} + + sub roundoff { my $num = shift; From 30f256b32d3937c1a2db49b343d35f0002031d20 Mon Sep 17 00:00:00 2001 From: waynieack Date: Tue, 10 Jan 2017 09:49:53 -0600 Subject: [PATCH 17/27] Added option for an external proxy like Apache or IIS to listen on a single port. --- lib/AlexaBridge.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 476b459a0..10703a3eb 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -651,7 +651,10 @@ sub new { my $AlexaHttpPort = $AlexaGlobal->{http_sockets}->{$AlexaHttpName}->{port}; $self->{'ports'}->{$AlexaHttpPort} = 0; } - $self->{'ports'}->{$::config_parms{'http_port'}} = 0; + if ( ($::config_parms{'alexaHttpPortCount'} eq 0) && ($::config_parms{'alexaHttpPort'}) ) { + $self->{'ports'}->{$::config_parms{'alexaHttpPort'}} = 0; # This is to disable all MH proxy ports and use an external proxy port via Apache + } + else { $self->{'ports'}->{$::config_parms{'http_port'}} = 0; } if (-e $file) { my $restoredhash = retrieve($file); $self->{idmap} = $restoredhash->{idmap}; @@ -730,7 +733,7 @@ sub uuid { my $highid; my $missing; - my $count = 1; + my $count = $::config_parms{'alexaUuidStart'} || 1; foreach my $object (keys %{$self->{idmap}->{objects}}) { my $currentid = $self->{idmap}->{objects}->{$object}; $highid = $currentid if ( $currentid > $highid ); From 6865b62251e00d08dad07380ffecddd0768bb172 Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 13 Jan 2017 21:23:57 -0600 Subject: [PATCH 18/27] Added Chunked mode for the Echo so only 1 port is needed to support 300 MH objects --- lib/AlexaBridge.pm | 156 +++++++++++++++++++++++++++++++-------------- 1 file changed, 107 insertions(+), 49 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 10703a3eb..44c349ab9 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -9,14 +9,14 @@ use IO::Socket::Multicast; -use constant SSDP_IP => "239.255.255.250"; -use constant SSDP_PORT => 1900; -use constant CRLF => "\015\012"; +#use constant SSDP_IP => "239.255.255.250"; +#use constant SSDP_PORT => 1900; +#use constant CRLF => "\015\012"; -use constant DEFAULT_HTTP_PORT => 8085; -use constant DEFAULT_LEASE_TIME => 1800; -use constant DEFAULT_NOTIFICATION_PORT => 50000; -use constant DEFAULT_PORT_COUNT => 0; +#use constant DEFAULT_HTTP_PORT => 80; +#use constant DEFAULT_LEASE_TIME => 1800; +#use constant DEFAULT_NOTIFICATION_PORT => 50000; +#use constant DEFAULT_PORT_COUNT => 0; my ($LOCAL_IP, $LOCAL_MAC) = &DiscoverAddy unless ( (defined($::config_parms{'alexaMac'})) && (defined($::config_parms{'alexaHttpIp'})) ); $LOCAL_IP = $::config_parms{'alexaHttpIp'} if defined($::config_parms{'alexaHttpIp'}); @@ -32,11 +32,12 @@ sub startup { sub open_port { - my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || DEFAULT_PORT_COUNT; + my $SSDP_PORT = '1900'; + my $AlexaHttpPortCount = $::config_parms{'alexaHttpPortCount'} || '0'; if ($AlexaHttpPortCount) { $AlexaHttpPortCount = ($AlexaHttpPortCount - 1); for my $count (0..$AlexaHttpPortCount) { - my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || DEFAULT_HTTP_PORT; + my $AlexaHttpPort = $::config_parms{'alexaHttpPort'} || '80'; $AlexaHttpPort = ($AlexaHttpPort + $count); my $AlexaHttpName = 'alexaServer'.$count; &http_ports($AlexaHttpName, $AlexaHttpPort); @@ -49,7 +50,7 @@ sub open_port { $AlexaGlobal->{http_sender}->{'alexa_http_sender'} = new Socket_Item('alexa_http_sender', undef, $::config_parms{'http_server'}.':'.$::config_parms{'http_port'}, 'alexa_http_sender', 'tcp', 'raw'); } - my $notificationPort = $::config_parms{'alexa_notification_port'} || DEFAULT_NOTIFICATION_PORT; + my $notificationPort = $::config_parms{'alexa_notification_port'} || '50000'; my $ssdpNotificationName = 'alexaSsdpNotification'; @@ -76,19 +77,19 @@ sub open_port { my $ssdpListenName = 'alexaSsdpListen'; my $ssdpListenSocket = new IO::Socket::Multicast->new( - LocalPort => SSDP_PORT, + LocalPort => $SSDP_PORT, Proto => 'udp', Reuse => 1) - || &main::print_log( "\nError: Could not start a udp alexa multicast listen server on ". SSDP_PORT .$@ ."\n\n" ) && return; - $ssdpListenSocket->mcast_add(SSDP_IP); + || &main::print_log( "\nError: Could not start a udp alexa multicast listen server on ". $SSDP_PORT .$@ ."\n\n" ) && return; + $ssdpListenSocket->mcast_add('239.255.255.250'); $::Socket_Ports{$ssdpListenName}{protocol} = 'udp'; $::Socket_Ports{$ssdpListenName}{datatype} = 'raw'; - $::Socket_Ports{$ssdpListenName}{port} = SSDP_PORT; + $::Socket_Ports{$ssdpListenName}{port} = $SSDP_PORT; $::Socket_Ports{$ssdpListenName}{sock} = $ssdpListenSocket; $::Socket_Ports{$ssdpListenName}{socka} = $ssdpListenSocket; # UDP ports are always "active" $AlexaGlobal->{'ssdp_listen'} = new Socket_Item( undef, undef, $ssdpListenName ); - printf " - creating %-15s on %3s %5s %s\n", $ssdpListenName, 'udp', SSDP_PORT; + printf " - creating %-15s on %3s %5s %s\n", $ssdpListenName, 'udp', $SSDP_PORT; &main::print_log ("Alexa open_port: p=$ssdpPort pn=$ssdpListenName s=" .$AlexaGlobal->{'ssdp_listen'} ."\n") if $main::Debug{alexa}; @@ -119,8 +120,10 @@ sub check_for_data { #foreach my $AlexaHttpName ( keys %{$AlexaGlobal->{http_sockets}} ) { my $AlexaHttpName = 'alexaServer0'; my $alexa_listen = $AlexaGlobal->{http_sockets}{$AlexaHttpName}; + if ( $alexa_listen && ( my $alexa_data = said $alexa_listen ) ) { - #&main::print_log( "[Alexa] Info: Data - $alexa_data" ); + my $peerip = $alexa_listen->peer; + &main::print_log( "[Alexa] Debug: Peer: $peerip Data IN - $alexa_data" ) if $main::Debug{'alexa'} >= 5; $alexa_http_sender->start unless $alexa_http_sender->active; $alexa_http_sender->set($alexa_data); @@ -142,6 +145,8 @@ sub check_for_data { sub _sendHttpData { my ($alexa_listen, $alexa_http_sender) = @_; if ( $alexa_http_sender && ( my $alexa_sender_data = said $alexa_http_sender ) ) { + my $peerip = $alexa_listen->peer; + &main::print_log( "[Alexa] Debug: Peer: $peerip Data OUT - $alexa_sender_data" ) if $main::Debug{'alexa'} >= 5; $alexa_listen->set($alexa_sender_data); } } @@ -167,11 +172,12 @@ sub _receiveSSDPEvent { } my $target; - &main::print_log ("[Alexa] Debug: SSDP IN - $buf \n") if $main::Debug{'alexa'} >= 3; - if ( $buf =~ /ST: urn:Belkin:device:\*\*.*/ ) { &_sendSearchResponse($peer) } - elsif ( $buf =~ /ST: urn:schemas-upnp-org:device:basic:1.*/ ) { &_sendSearchResponse($peer) } - elsif ( $buf =~ /ST: ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } - elsif ( $buf =~ /ST:ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } + $buf =~ s/ST: /ST:/g; + &main::print_log ("[Alexa] Debug: SSDP IN - $buf \n") if $main::Debug{'alexa'} >= 3; + if ( $buf =~ /ST:urn:Belkin:device:\*\*.*/ ) { &_sendSearchResponse($peer) } + elsif ( $buf =~ /ST:urn:schemas-upnp-org:device:basic:1.*/ ) { &_sendSearchResponse($peer) } + elsif ( $buf =~ /ST:ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } + #elsif ( $buf =~ /ST:ssdp:all.*/ ) { &_sendSearchResponse($peer,'all') } } @@ -186,7 +192,7 @@ sub _sendSearchResponse { foreach my $port ( (sort keys %{$self->{child}->{'ports'}}) ) { - next unless ( $self->{child}->{$port} ); + #next unless ( $self->{child}->{$port} ); my $socket = handle $alexa_ssdp_send; my $output; if ($type eq 'all') { @@ -195,7 +201,6 @@ sub _sendSearchResponse { $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; $output .= 'LOCATION: http://'.$LOCAL_IP.':'.$port.'/description.xml' ."\r\n"; - #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; $output .= 'ST: upnp:rootdevice' ."\r\n"; @@ -209,7 +214,6 @@ sub _sendSearchResponse { $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; $output .= 'LOCATION: http://'.$LOCAL_IP.':'.$port.'/description.xml' ."\r\n"; - #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; $output .= 'ST: uuid:2f402f80-da50-11e1-9b23-'.lc($mac)."\r\n"; @@ -224,7 +228,6 @@ sub _sendSearchResponse { $output .= 'CACHE-CONTROL: max-age=100'."\r\n"; $output .= 'EXT: '."\r\n"; $output .= 'LOCATION: http://'.$LOCAL_IP.':'.$port.'/description.xml' ."\r\n"; - #$output .= 'LOCATION: http://'.$::config_parms{'alexaHttpIp'}.':'.$port.'/upnp/alexa-mh-bridge'.$count.'/setup.xml' ."\r\n"; $output .= 'SERVER: Linux/3.14.0 UPnP/1.0 IpBridge/1.15.0' ."\r\n"; $output .= 'hue-bridgeid: B827EBFFFE'.uc((substr $mac, -6))."\r\n"; $output .= 'ST: urn:schemas-upnp-org:device:basic:1'."\r\n"; @@ -242,7 +245,7 @@ sub process_http { unless ($::config_parms{'alexa_enable'}) { return 0 } my ( $uri, $request_type, $body, $socket, %Http ) = @_; - unless ( ($uri =~ /^\/upnp\//) || ($uri =~ /^\/api/ ) || ($uri =~ /^\/description.xml$/) ) { return 0 } # Added for performance + unless ( ($uri =~ /^\/api/ ) || ($uri =~ /^\/description.xml$/) ) { return 0 } # Added for performance my $selfname = (&main::list_objects_by_type('AlexaBridge'))[0]; my $self = ::get_object_by_name($selfname); @@ -316,21 +319,25 @@ my $xmlmessage = qq[ ]; -my $AlexaObjects; - if ( $self->{child}->{$port} ) { +my ($AlexaObjects,$AlexaObjChunk); + if ( $::config_parms{'alexaEnableChunked'} ) { + $AlexaObjects = $self->{child}->{fulllist}; + } + elsif ( $self->{child}->{$port} ) { # use Data::Dumper; $AlexaObjects = $self->{child}->{$port}; + $AlexaObjChunk = $self->{child}->{$port}; #&main::print_log( Data::Dumper->Dumper($AlexaObjects) ); } else { &main::print_log( "[Alexa] Error: No Matching object for port ( $port )" ); - $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n\r\n"; + $output = "HTTP/1.1 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\nContent-Length: 2\r\nDate: ". time2str(time)."\r\n\r\n.."; return $output; } &main::print_log ("[Alexa] Debug: Port: ( $port ) URI: ( $uri ) Body: ( $body ) Type: ( $request_type ) \n") if $main::Debug{'alexa'}; - if ( ( ($uri =~ /^\/upnp\/.*\/setup.xml$/) || ($uri =~ /^\/description.xml$/) ) && (lc($request_type) eq "get") ) { + if ( ($uri =~ /^\/description.xml$/) && (lc($request_type) eq "get") ) { my $output = "HTTP/1.1 200 OK\r\n"; $output .= "Server: MisterHouse\r\n"; $output .= 'Access-Control-Allow-Origin: *'."\r\n"; @@ -392,7 +399,7 @@ my $AlexaObjects; $output .= "\r\n"; $output .= $content; } else { - $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + $output = "HTTP/1.1 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\nContent-Length: 2\r\nDate: ". time2str(time)."\r\n\r\n.."; &main::print_log("[Alexa] Error: No Matching object for UUID ( $deviceID )") unless ($AlexaObjects->{'uuid'}->{$deviceID}); &main::print_log("[Alexa] Error: Missing State from PUT for object with UUID ( $deviceID )") unless (defined($state)); &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; @@ -420,7 +427,7 @@ my $AlexaObjects; } elsif ( $uris[3] eq 'lights' ) { &main::print_log("[Alexa] Error: No Matching object for UUID ( $uris[4] )"); - $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + $output = "HTTP/1.1 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\nContent-Length: 2\r\nDate: ". time2str(time)."\r\n\r\n.."; &main::print_log ("[Alexa] Debug: MH Response $output \n") if $main::Debug{'alexa'}; return $output; } @@ -432,8 +439,9 @@ my $AlexaObjects; } elsif (defined $uris[3]) { if ( $uris[3] eq 'lights' ) { - foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { - $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + $AlexaObjChunk = $self->_GetChunk($uris[3]) if ( $::config_parms{'alexaEnableChunked'} ); + foreach my $uuid ( keys %{$AlexaObjChunk->{'uuid'}} ) { + $name = $AlexaObjChunk->{'uuid'}->{$uuid}->{'name'}; next unless $name; my $state = &get_set_state($self, $AlexaObjects, $uuid,'get'); $statep1 = qq[{"]; @@ -451,8 +459,9 @@ my $AlexaObjects; $statep2 = qq[":"]; $end = qq["}]; $delm = qq[","]; - foreach my $id ( keys %{$AlexaObjects->{'groups'}} ) { - $name = $AlexaObjects->{'groups'}->{$id}->{'name'}; + $AlexaObjChunk = $self->_GetChunk($uris[3]) if ( $::config_parms{'alexaEnableChunked'} ); + foreach my $id ( keys %{$AlexaObjChunk->{'groups'}} ) { + $name = $AlexaObjChunk->{'groups'}->{$id}->{'name'}; next unless $name; $statep1 = qq[{"$id": {"name": "$name","lights": \["1","2"\],"type": "LightGroup","action": {"on": true,"bri": 254,"hue": 10000,"sat": 254,"effect": "none","xy": \[0.5,0.5\],"ct": 250,"alert": "select","colormode": "ct"}}]; $delim = qq[,]; @@ -465,8 +474,9 @@ my $AlexaObjects; } } elsif (defined $uris[2]) { - foreach my $uuid ( keys %{$AlexaObjects->{'uuid'}} ) { - $name = $AlexaObjects->{'uuid'}->{$uuid}->{'name'}; + $AlexaObjChunk = $self->_GetChunk('all') if ( $::config_parms{'alexaEnableChunked'} ); + foreach my $uuid ( keys %{$AlexaObjChunk->{'uuid'}} ) { + $name = $AlexaObjChunk->{'uuid'}->{$uuid}->{'name'}; next unless $name; my $state = &get_set_state($self, $AlexaObjects, $uuid,'get'); $statep1 = qq[{"lights":{"]; @@ -497,9 +507,9 @@ my $AlexaObjects; $output .= "\r\n"; $output .= $content; } else { - my $output = "HTTP/1.0 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\n"; + $output = "HTTP/1.1 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\nContent-Length: 2\r\nDate: ". time2str(time)."\r\n\r\n.."; } - &main::print_log ("[Alexa] Debug: MH Response $debugcontent \n") if $main::Debug{'alexa'} >= 2; + &main::print_log ("[Alexa] Debug: MH Response $output.$debugcontent \n") if $main::Debug{'alexa'} >= 2; return $output; } else { return 0 } @@ -515,13 +525,30 @@ sub _Gzip { return $content; } + +sub _GetChunk { + my ( $self,$uri ) = @_; + use Time::HiRes qw(clock_gettime); + my $realtime = clock_gettime(CLOCK_REALTIME); + $self->{'conn'}->{$uri}->{time} = clock_gettime(CLOCK_REALTIME) unless $self->{'conn'}->{$uri}->{time}; + $self->{'conn'}->{$uri}->{count} = 0 unless defined($self->{'conn'}->{$uri}->{count}); + + if ( ($realtime - $self->{'conn'}->{$uri}->{time}) <= .7 ) { + my $size = $self->{child}->{ChkCnt}; + if ( $self->{'conn'}->{$uri}->{count} eq $size ) { $ChkCnt = $size; $self->{'conn'}->{$uri}->{count} = 0 } + elsif ( defined($self->{'conn'}->{$uri}->{count}) ) { $ChkCnt = $self->{'conn'}->{$uri}->{count}; $self->{'conn'}->{$uri}->{count}++ } + &main::print_log ("[Alexa] Debug: GetChunk - Time ( $realtime ) ChunkSize: ( $size ) Count: ( $ChkCnt ) CountHash: ( $self->{'conn'}->{$uri}->{count} )\n") if $main::Debug{'alexa'}; + } + else { undef $self->{'conn'}->{$uri}->{time}; undef $self->{'conn'}->{$uri}->{count} } + my $AlexaObjChunk = $self->{child}->{$ChkCnt}; + return $AlexaObjChunk; +} + + sub DiscoverAddy { use Net::Address::Ethernet qw( :all ); my @a = get_addresses(@_); foreach my $adapter (@a) { - # print $adapter->{sIP}."\n"; - # print $adapter->{sEthernet}."\n"; - # print "____________________\n"; next unless ($adapter->{iActive} eq 1); next if ($adapter->{sEthernet} eq ''); next if ($adapter->{sIP} =~ /127\.0\.0\.1/); @@ -571,7 +598,6 @@ sub get_set_state { } elsif ( $action eq 'set' ) { my $end; - #if ($object->$statesub =~ /\%/) { $end = '%' } if ( $object->can('state_level') && $state =~ /\d+/ ) { $end = '%'} &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state$end )\n") if $main::Debug{'alexa'}; $object->$sub($state.$end); @@ -650,11 +676,20 @@ sub new { foreach my $AlexaHttpName ( keys %{$AlexaGlobal->{http_sockets}} ) { my $AlexaHttpPort = $AlexaGlobal->{http_sockets}->{$AlexaHttpName}->{port}; $self->{'ports'}->{$AlexaHttpPort} = 0; + &main::print_log ("[Alexa] Debug: Configured for port $AlexaHttpPort\n") if $main::Debug{'alexa'}; } if ( ($::config_parms{'alexaHttpPortCount'} eq 0) && ($::config_parms{'alexaHttpPort'}) ) { $self->{'ports'}->{$::config_parms{'alexaHttpPort'}} = 0; # This is to disable all MH proxy ports and use an external proxy port via Apache + &main::print_log ("[Alexa] Debug: Configured for a EXTERNAL proxy on port $::config_parms{'alexaHttpPort'}\n") if $main::Debug{'alexa'}; + } + elsif ( ($::config_parms{'alexaNoDefaultHttp'}) && ($::config_parms{'alexaHttpPort'}) ) { + #this is to disable the default MH web port and only use a proxy port + &main::print_log ("[Alexa] Debug: Configured to disable port $::config_parms{'http_port'} and proxy port $::config_parms{'alexaHttpPort'}\n") if $main::Debug{'alexa'}; + } + else { + $self->{'ports'}->{$::config_parms{'http_port'}} = 0; + &main::print_log ("[Alexa] Debug: Configured for port $::config_parms{'http_port'}\n") if $main::Debug{'alexa'}; } - else { $self->{'ports'}->{$::config_parms{'http_port'}} = 0; } if (-e $file) { my $restoredhash = retrieve($file); $self->{idmap} = $restoredhash->{idmap}; @@ -681,11 +716,34 @@ sub add { $fullname = $cleanname.'.'.$cleanname; } #use Data::Dumper; - my $uuid = $self->uuid($fullname); - + my $uuid = $self->uuid($fullname); + my $alexaObjectsPerGet = $::config_parms{'alexaObjectsPerGet'} || '60'; + + if ( $::config_parms{'alexaEnableChunked'} ) { + $self->{fulllist}->{'uuid'}->{$uuid}->{'realname'}=$realname; + $self->{fulllist}->{'uuid'}->{$uuid}->{'name'}=$name || $cleanname; + $self->{fulllist}->{'uuid'}->{$uuid}->{'sub'}=$sub || 'set'; + $self->{fulllist}->{'uuid'}->{$uuid}->{'on'}=lc($on) || 'on'; + $self->{fulllist}->{'uuid'}->{$uuid}->{'off'}=lc($off) || 'off'; + $self->{fulllist}->{'uuid'}->{$uuid}->{'statesub'}=$statesub || 'state'; + for my $count (0..5) { + my $size = keys %{$self->{$count}->{'uuid'}}; + next if ($size eq $alexaObjectsPerGet); + $self->{$count}->{'uuid'}->{$uuid}->{'realname'}=$realname; + $self->{$count}->{'uuid'}->{$uuid}->{'name'}=$name || $cleanname; + $self->{$count}->{'uuid'}->{$uuid}->{'sub'}=$sub || 'set'; + $self->{$count}->{'uuid'}->{$uuid}->{'on'}=lc($on) || 'on'; + $self->{$count}->{'uuid'}->{$uuid}->{'off'}=lc($off) || 'off'; + $self->{$count}->{'uuid'}->{$uuid}->{'statesub'}=$statesub || 'state'; + $self->{ChkCnt} = $count; + &main::print_log ("[Alexa] Debug: UUID:( $uuid ) Count: ( $count ) \n") if $main::Debug{'alexa'}; + last; + } + } + else { foreach my $port ( (sort keys %{$self->{'ports'}}) ) { my $size = keys %{$self->{$port}->{'uuid'}}; - next if ($size eq 60); + next if ($size eq $alexaObjectsPerGet); $self->{$port}->{'uuid'}->{$uuid}->{'realname'}=$realname; $self->{$port}->{'uuid'}->{$uuid}->{'name'}=$name || $cleanname; $self->{$port}->{'uuid'}->{$uuid}->{'sub'}=$sub || 'set'; @@ -694,7 +752,7 @@ sub add { $self->{$port}->{'uuid'}->{$uuid}->{'statesub'}=$statesub || 'state'; last; } - +} # $self->{8080}->{'uuid'}->{3}->{'realname'}=$realname; # $self->{8080}->{'uuid'}->{3}->{'name'}=$name || $cleanname; # $self->{8080}->{'uuid'}->{3}->{'sub'}=$sub || 'set'; From 52224e57c4aad340250dee96592f6892de31bd03 Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 21 Jan 2017 12:14:16 -0600 Subject: [PATCH 19/27] Fixed issue with Google Home stuck connections. Added 'set' and 'state' when calling a configured sub so a real state can be returned by the sub --- lib/AlexaBridge.pm | 106 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 90 insertions(+), 16 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 44c349ab9..cc99cc6a0 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -1,3 +1,38 @@ +#For Google Home and a reverse proxy (Apache/IIS/etc): +#alexa_enable = 1 +#alexaHttpPortCount = 0 # disables all proxy ports +#alexaHttpPort = 80 # tells the module to send port 80 in the SSDP response and look for port 80 in the HTTP host header +#alexaObjectsPerGet = 300 # Google Home can handle us returning all objects in a single response +# +#For Google Home using the builtin proxy port: +#alexa_enable = 1 +#alexaHttpPortCount = 1 # Open 1 proxy port on port 80 (We default to port 80 so no need to define it) +#alexaNoDefaultHttp = 1 # Disable responding on the default MH web port because Google Home will not use it any way. +#alexaObjectsPerGet = 300 # Google Home can handle us returning all objects in a single response +# +# +#For Echo (Chunked method): +#alexa_enable = 1 +#alexaEnableChunked = 1 +# +# +#For Echo (Multi-port method): +## This method should not be needed unless for some reason your Echo does not work with the Chunked method. +#alexa_enable = 1 +#alexaHttpPortCount = 1 # Open 1 proxy port for a total of 2 ports including the default MH web port. We only support 1 for now unless I see a need for more. +#alexaHttpPort=8085 # The proxy port will be on port 8085, this port should be higher than the MH web port so it is used first. +# +# +# +#alexa_enable # Enable the module +#alexaEnableChunked # Enable chunked return method (For the Echo) +#alexaHttpPortCount # Amount of proxy ports to open +#alexaNoDefaultHttp # Disable responding on the default MH web port +#alexaObjectsPerGet # Amount of MH objects we return per GET from the Echo/GH +#alexaHttpPort # First proxy port number +#alexaMac # This is used in the SSDP response, We discover it so it does not need to be defined uless something goes wrong +#alexaHttpIp # This is the IP of the local MH server, We discover it so it does not need to be defined uless something goes wrong + package AlexaBridge; @AlexaBridge::ISA = ('Generic_Item'); @@ -129,6 +164,7 @@ sub check_for_data { } &_sendHttpData($alexa_listen, $alexa_http_sender); + &close_stuck_sockets($alexa_listen, $AlexaHttpName); #This closes the oldest connection from a source IP if a second one is made. Fix for GH stuck connections # } @@ -240,6 +276,31 @@ sub _sendSearchResponse { } } + +sub close_stuck_sockets { +my ($alexa_listen, $AlexaHttpName) = @_; + my $current_client_ip = $alexa_listen->peer; + $current_client_ip =~ s/:.*//; + my $current_client_port = $alexa_listen->peer; + $current_client_port =~ s/.*\://; + if ( (scalar @{ $::Socket_Ports{$AlexaHttpName}{clients} }) > 1 ) { + for my $ptr ( @{ $::Socket_Ports{$AlexaHttpName}{clients} } ) { + my ( $socka, $client_ip_address, $client_port, $data ) = @{$ptr}; + next if ( ($client_ip_address eq $current_client_ip) && ($client_port eq $current_client_port)); + if ($client_ip_address eq $current_client_ip) { + $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time} = time unless $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time}; + if ( (time - $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time}) ge 60 ) { + close $socka if $socka; + delete $AlexaGlobal->{http_client}->{$client_ip_address}; + &main::print_log( "[Alexa] Debug: Client count: ".(scalar @{ $::Socket_Ports{$AlexaHttpName}{clients} }) ." closing $client_ip_address : $client_port") if $main::Debug{'alexa'} >= 2; + } + } + } + + } +} + + sub process_http { unless ($::config_parms{'alexa_enable'}) { return 0 } @@ -505,11 +566,12 @@ my ($AlexaObjects,$AlexaObjChunk); $output .= "Content-Length: ". (length $content) ."\r\n"; $output .= "Date: ". time2str(time)."\r\n"; $output .= "\r\n"; + $debugcontent = $output.$debugcontent if $main::Debug{'alexa'} >= 2; $output .= $content; } else { $output = "HTTP/1.1 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\nContent-Length: 2\r\nDate: ". time2str(time)."\r\n\r\n.."; } - &main::print_log ("[Alexa] Debug: MH Response $output.$debugcontent \n") if $main::Debug{'alexa'} >= 2; + &main::print_log ("[Alexa] Debug: MH Response $debugcontent \n") if $main::Debug{'alexa'} >= 2; return $output; } else { return 0 } @@ -528,9 +590,12 @@ sub _Gzip { sub _GetChunk { my ( $self,$uri ) = @_; - use Time::HiRes qw(clock_gettime); - my $realtime = clock_gettime(CLOCK_REALTIME); - $self->{'conn'}->{$uri}->{time} = clock_gettime(CLOCK_REALTIME) unless $self->{'conn'}->{$uri}->{time}; + #use Time::HiRes qw(clock_gettime); + use Time::HiRes qw(time); + #my $realtime = clock_gettime(CLOCK_REALTIME); + my $realtime = time; + #$self->{'conn'}->{$uri}->{time} = clock_gettime(CLOCK_REALTIME) unless $self->{'conn'}->{$uri}->{time}; + $self->{'conn'}->{$uri}->{time} = time unless $self->{'conn'}->{$uri}->{time}; $self->{'conn'}->{$uri}->{count} = 0 unless defined($self->{'conn'}->{$uri}->{count}); if ( ($realtime - $self->{'conn'}->{$uri}->{time}) <= .7 ) { @@ -597,10 +662,10 @@ sub get_set_state { return $return; } elsif ( $action eq 'set' ) { - my $end; - if ( $object->can('state_level') && $state =~ /\d+/ ) { $end = '%'} - &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state$end )\n") if $main::Debug{'alexa'}; - $object->$sub($state.$end); + if ( $object->can('state_level') && $state =~ /\d+/ ) { $state = $state.'%'} + &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state )\n") if $main::Debug{'alexa'}; + if ( lc($type) =~ /clipsal_cbus/ ) { $object->$sub($state,'Alexa') } + else { $object->$sub($state) } return; } } @@ -617,15 +682,24 @@ sub get_set_state { } elsif ( ref($sub) eq 'CODE' ) { - if ( $action eq 'set' ) { - &main::print_log ("[Alexa] Debug: running sub: $sub( $state ) \n") if $main::Debug{'alexa'}; - &{$sub}($state); - return; - } - elsif ( $action eq 'get' ) { - return qq["on":true,"bri":254]; - } + if ( $action eq 'set' ) { + &main::print_log ("[Alexa] Debug: running sub: $sub( set, $state ) \n") if $main::Debug{'alexa'}; + &{$sub}('set',$state); + return; + } + elsif ( $action eq 'get' ) { + my $debug = "[Alexa] Debug: get_state running sub: $sub( state, $state ) - "; + my $state = &{$sub}('state'); + if ( $state =~ /\d+/ ) { + $state = ( &roundoff( ($state * 2.54) ) ); + my $return = qq["on":true,"bri":$state]; + &main::print_log ("$debug returning - $return\n" ) if $main::Debug{'alexa'}; + return $return; + } + return qq["on":true,"bri":254]; + } } + } sub get_state { From 6432392e940b99db741f6410c4dd95769f6487e1 Mon Sep 17 00:00:00 2001 From: waynieack Date: Tue, 31 Jan 2017 19:00:55 -0600 Subject: [PATCH 20/27] Fixed issue with Google Home stuck connections...Again. Added objects to read_table_A.pl so users can define them the the mht file. --- lib/AlexaBridge.pm | 160 ++++++++++++++++++++++++++++++++++++++++++-- lib/read_table_A.pl | 28 ++++++++ 2 files changed, 181 insertions(+), 7 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index cc99cc6a0..3670d683e 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -33,6 +33,110 @@ #alexaMac # This is used in the SSDP response, We discover it so it does not need to be defined uless something goes wrong #alexaHttpIp # This is the IP of the local MH server, We discover it so it does not need to be defined uless something goes wrong + + +# mht example + +# ALEXABRIDGE_ADD, , , , +# , , +# +# ALEX_BRIDGE, Alexa +# ALEXABRIDGE_ITEM, AlexaItems, Alexa + +# ALEXABRIDGE_ADD, AlexaItems, light1 light1, set, on, off, state # these are the defaults +# ALEXABRIDGE_ADD, AlexaItems, light1 # same as the line above +# ALEXABRIDGE_ADD, AlexaItems, light3, Test_Light_3 # if you want to change the name you say +# ALEXABRIDGE_ADD, AlexaItems, testsub, Test_Sub, \&testsub +# ! will be replaced with the action ( on/off/ ), so if you say "turn on test voice" then the module will run run_voice_cmd("test voice on") +# ALEXABRIDGE_ADD, AlexaItems, test_voice_!, Test_Voice, run_voice_cmd + + + + + +# user code example: +# $Alexa = new AlexaBridge(); # parent object +# $AlexaItems = new AlexaBridge_Item($Alexa); # child object +# +# $AlexaItems->add('$light1','light1','set','on','off','state'); +# +# +# +# In order to allow the user to map pretty much anything in MH to a Echo/GH +# command I created a mapping. +# +# $AlexaItems->add('','','','','',''); +# +# +# +# $AlexaItems->add('$light1','light1','set','on','off','state'); # This +# is the same as $AlexaItems->add('$light1') +# +# +# # To change the name of an object to a more natural name that you would +# say to the Echo/GH: +# +# $AlexaItems->add('$GarageHall_light_front','Garage_Hall_light'); +# +# +# # To map a voice command, # is replaced by the Echo/GH command +# (on/off/dim%). +# # My actual voice command in MH is "set night mode on", so I configure it +# like: +# +# $AlexaItems->add('set night mode !','NightMode','run_voice_cmd'); # If +# I say "Alexa, Turn on Night Mode", run_voice_cmd("set night mode on") is +# run in MH. +# +# +# # To configure a user code sub: +# # The actual name (argument 1) can be anything. +# # A code ref must be used. +# # (on/off/dim%) are passed to the sub as an argument when its run. +# $AlexaItems->add('testsub','Test_Sub',\&testsub); # say "Alexa, Turn on +# Test Sub", &testsub("on") is run in MH. +# +# +# # I have an Insteon thermostat and I configured it like: +# $AlexaItems->add('$thermostat','Heat','heat_setpoint',undef,undef,'get_heat_sp'); +# # say "Alexa, Set Heat to 73%", $thermostat->heat_setpoint("73") is run +# in MH. +# $AlexaItems->add('$thermostat','Cool','cool_setpoint',undef,undef,'get_cool_sp'); + + +# I have a script that I use to control my AV equipment and I can run it via +# ssh, so I made a voice command in MH: +# +# $v_set_tv_mode = new Voice_Cmd("set tv mode [on,off,hbo,netflix,roku,directtv,xbmc,wii]"); +# $p_set_tv_mode = new Process_Item; +# if (my $state = said $v_set_tv_mode) { +# set $p_set_tv_mode "/usr/bin/ssh wayne\@192.168.1.10 \"sudo /usr/local/HomeAVControl/bin/input_change $state\""; +# start $p_set_tv_mode; +# } +# +# +# +# I added the following to my MH user code: +# $AlexaItems->add('set tv mode #','tv','run_voice_cmd'); # "Alexa, Turn on +# tv" / "Alexa, Turn off tv" # turns all my AV stuff on or off +# $AlexaItems->add('set tv mode #','DirectTv','run_voice_cmd','directtv','directtv'); +# #"Alexa, Turn on Direct Tv" # turns all my AV stuff on and set the input to +# direct tv +# $AlexaItems->add('set tv mode #','Hbo','run_voice_cmd','hbo','hbo'); +# #"Alexa, Turn on hbo" # turns all my AV stuff on and set the input to Roku +# and launches the HBO Go app +# $AlexaItems->add('set tv mode #','Netflix','run_voice_cmd','netflix','netflix'); +# #"Alexa, Turn on Netflix" # turns all my AV stuff on and set the input to +# Roku and launches the Netflix app +# $AlexaItems->add('set tv mode #','Roku','run_voice_cmd','roku','roku'); +# $AlexaItems->add('set tv mode #','xbmc','run_voice_cmd','xbmc','xbmc'); +# $AlexaItems->add('set tv mode #','wii','run_voice_cmd','wii','wii'); + + + package AlexaBridge; @AlexaBridge::ISA = ('Generic_Item'); @@ -157,14 +261,19 @@ sub check_for_data { my $alexa_listen = $AlexaGlobal->{http_sockets}{$AlexaHttpName}; if ( $alexa_listen && ( my $alexa_data = said $alexa_listen ) ) { - my $peerip = $alexa_listen->peer; - &main::print_log( "[Alexa] Debug: Peer: $peerip Data IN - $alexa_data" ) if $main::Debug{'alexa'} >= 5; + my $client_ip_address = $alexa_listen->peer; + &main::print_log( "[Alexa] Debug: Peer: $client_ip_address Sent Data" ) if $main::Debug{'alexa'} >= 2; + &main::print_log( "[Alexa] Debug: Peer: $client_ip_address Data IN - $alexa_data" ) if $main::Debug{'alexa'} >= 5; + $client_ip_address =~ s/:.*//; + my $client_port = $alexa_listen->peer; + $client_port =~ s/.*\://; + $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time} = time; $alexa_http_sender->start unless $alexa_http_sender->active; $alexa_http_sender->set($alexa_data); } &_sendHttpData($alexa_listen, $alexa_http_sender); - &close_stuck_sockets($alexa_listen, $AlexaHttpName); #This closes the oldest connection from a source IP if a second one is made. Fix for GH stuck connections + &close_stuck_sockets($alexa_listen, $AlexaHttpName) if ($alexa_listen); #This closes the oldest connection from a source IP if a second one is made. Fix for GH stuck connections # } @@ -181,8 +290,13 @@ sub check_for_data { sub _sendHttpData { my ($alexa_listen, $alexa_http_sender) = @_; if ( $alexa_http_sender && ( my $alexa_sender_data = said $alexa_http_sender ) ) { - my $peerip = $alexa_listen->peer; - &main::print_log( "[Alexa] Debug: Peer: $peerip Data OUT - $alexa_sender_data" ) if $main::Debug{'alexa'} >= 5; + my $client_ip_address = $alexa_listen->peer; + &main::print_log( "[Alexa] Debug: Peer: $client_ip_address Data OUT - $alexa_sender_data" ) if $main::Debug{'alexa'} >= 5; + $client_ip_address =~ s/:.*//; + my $client_port = $alexa_listen->peer; + $client_port =~ s/.*\://; + + delete $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port} if $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}; $alexa_listen->set($alexa_sender_data); } } @@ -277,8 +391,9 @@ sub _sendSearchResponse { } -sub close_stuck_sockets { +sub close_stuck_sockets_old { my ($alexa_listen, $AlexaHttpName) = @_; + return unless $alexa_listen; my $current_client_ip = $alexa_listen->peer; $current_client_ip =~ s/:.*//; my $current_client_port = $alexa_listen->peer; @@ -301,6 +416,29 @@ my ($alexa_listen, $AlexaHttpName) = @_; } +sub close_stuck_sockets { +my ($alexa_listen, $AlexaHttpName) = @_; + return unless $alexa_listen; + my $current_client_ip = $alexa_listen->peer; + $current_client_ip =~ s/:.*//; + my $current_client_port = $alexa_listen->peer; + $current_client_port =~ s/.*\://; + for my $ptr ( @{ $::Socket_Ports{$AlexaHttpName}{clients} } ) { + my ( $socka, $client_ip_address, $client_port, $data ) = @{$ptr}; + next if ( ($client_ip_address eq $current_client_ip) && ($client_port eq $current_client_port)); + next unless $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time}; + my $timediff = (time - $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time}); + if ( $timediff >= 20 ) { + $output = "HTTP/1.1 404 Not Found\r\nServer: MisterHouse\r\nCache-Control: no-cache\r\nContent-Length: 2\r\nDate: ". time2str(time)."\r\n\r\n.."; + print $socka $output; + delete $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}; + &main::print_log( "[Alexa] Debug: Sending 404 to $client_ip_address:$client_port socket has been open for $timediff with no response") if $main::Debug{'alexa'} >= 2; + } + } + +} + + sub process_http { unless ($::config_parms{'alexa_enable'}) { return 0 } @@ -312,6 +450,13 @@ sub process_http { my $self = ::get_object_by_name($selfname); unless ($self) { &main::print_log( "[Alexa] Error: No AlexaBridge parent object found" ); return 0 } + #my $client_ip_address = $::Socket_Ports{http}{client_ip_address}; + #$client_ip_address =~ s/:.*//; + #my $client_port = $::Socket_Ports{http}{client_port}; + #$client_port =~ s/.*\://; + +#&main::print_log( "[Alexa] Debug: Process_http - Client: $client_ip_address:$client_port has sent data") if $main::Debug{'alexa'} >= 2; + use HTTP::Date qw(time2str); use IO::Compress::Gzip qw(gzip); @@ -665,13 +810,14 @@ sub get_set_state { if ( $object->can('state_level') && $state =~ /\d+/ ) { $state = $state.'%'} &main::print_log ("[Alexa] Debug: setting object ( $realname ) to state ( $state )\n") if $main::Debug{'alexa'}; if ( lc($type) =~ /clipsal_cbus/ ) { $object->$sub($state,'Alexa') } - else { $object->$sub($state) } + else { $object->$sub($state,'Alexa') } return; } } elsif ( $sub =~ /^run_voice_cmd$/ ) { if ( $action eq 'set' ) { $realname =~ s/#/$state/; + $realname =~ s/!/$state/; &main::print_log ("[Alexa] Debug: running voice command: ( $realname )\n") if $main::Debug{'alexa'}; &main::run_voice_cmd("$realname"); return; diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index b4cc1070c..863abb322 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -1609,6 +1609,34 @@ sub read_table_A { } #-------------- End AD2 Objects ------------- + #-------------- Alexa Objects ----------------- + elsif ( $type eq "ALEX_BRIDGE" ) { + require 'AlexaBridge.pm'; + ( $name ) = @item_info; + $object = "AlexaBridge('$other')"; + } + elsif ( $type eq "ALEXABRIDGE_ITEM" ) { + require 'AlexaBridge.pm'; + my ( $parent ); + ( $name, $parent ) = @item_info; + $object = "AlexaBridge_Item(\$$parent)"; + } + elsif ( $type eq "ALEXABRIDGE_ADD" ) { + my ( $parent, $realname, $name, $sub, $on, $off, $statesub, @other ) = @item_info; + if ($sub =~ /^&/) { $sub =~ s/&/\\&/ } + if ($sub =~ /^\\\\&/) { $sub =~ s/\\// } + if ($sub =~ /run_voice_cmd/) { $realname =~ s/_/ /g } + unless ( ($sub =~ /run_voice_cmd/) || ($sub =~ /&/) ) { $realname = "\$$realname" } + unless ( $sub =~ /&/ ) { $sub = "'".$sub."'" } + my $other = join ', ', ( map { "'$_'" } @other ); # Quote data + if ( !$packages{AlexaBridge}++ ) { # first time for this object type? + $code .= "use AlexaBridge;\n"; + } + $code .= sprintf "\$%-35s -> add('$realname','$name',$sub,'$on','$off','$statesub',$other);\n", $parent; + $object = ''; + } + #-------------- End Alexa Objects ---------------- + elsif ( $type =~ /PLCBUS_.*/ ) { require PLCBUS; ( $address, $name, $grouplist, @other ) = @item_info; From ba64fb8c21c811eab87c5db6c5a4190fd440ae7d Mon Sep 17 00:00:00 2001 From: waynieack Date: Sat, 4 Feb 2017 18:37:22 -0600 Subject: [PATCH 21/27] Updated POD doc --- lib/AlexaBridge.pm | 481 +++++++++++++++++++++++++++++++-------------- 1 file changed, 329 insertions(+), 152 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 3670d683e..468501321 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -1,141 +1,253 @@ -#For Google Home and a reverse proxy (Apache/IIS/etc): -#alexa_enable = 1 -#alexaHttpPortCount = 0 # disables all proxy ports -#alexaHttpPort = 80 # tells the module to send port 80 in the SSDP response and look for port 80 in the HTTP host header -#alexaObjectsPerGet = 300 # Google Home can handle us returning all objects in a single response -# -#For Google Home using the builtin proxy port: -#alexa_enable = 1 -#alexaHttpPortCount = 1 # Open 1 proxy port on port 80 (We default to port 80 so no need to define it) -#alexaNoDefaultHttp = 1 # Disable responding on the default MH web port because Google Home will not use it any way. -#alexaObjectsPerGet = 300 # Google Home can handle us returning all objects in a single response -# -# -#For Echo (Chunked method): -#alexa_enable = 1 -#alexaEnableChunked = 1 -# -# -#For Echo (Multi-port method): -## This method should not be needed unless for some reason your Echo does not work with the Chunked method. -#alexa_enable = 1 -#alexaHttpPortCount = 1 # Open 1 proxy port for a total of 2 ports including the default MH web port. We only support 1 for now unless I see a need for more. -#alexaHttpPort=8085 # The proxy port will be on port 8085, this port should be higher than the MH web port so it is used first. -# -# -# -#alexa_enable # Enable the module -#alexaEnableChunked # Enable chunked return method (For the Echo) -#alexaHttpPortCount # Amount of proxy ports to open -#alexaNoDefaultHttp # Disable responding on the default MH web port -#alexaObjectsPerGet # Amount of MH objects we return per GET from the Echo/GH -#alexaHttpPort # First proxy port number -#alexaMac # This is used in the SSDP response, We discover it so it does not need to be defined uless something goes wrong -#alexaHttpIp # This is the IP of the local MH server, We discover it so it does not need to be defined uless something goes wrong - - - -# mht example - -# ALEXABRIDGE_ADD, , , , -# , , -# -# ALEX_BRIDGE, Alexa -# ALEXABRIDGE_ITEM, AlexaItems, Alexa - -# ALEXABRIDGE_ADD, AlexaItems, light1 light1, set, on, off, state # these are the defaults -# ALEXABRIDGE_ADD, AlexaItems, light1 # same as the line above -# ALEXABRIDGE_ADD, AlexaItems, light3, Test_Light_3 # if you want to change the name you say -# ALEXABRIDGE_ADD, AlexaItems, testsub, Test_Sub, \&testsub -# ! will be replaced with the action ( on/off/ ), so if you say "turn on test voice" then the module will run run_voice_cmd("test voice on") -# ALEXABRIDGE_ADD, AlexaItems, test_voice_!, Test_Voice, run_voice_cmd - - - - - -# user code example: -# $Alexa = new AlexaBridge(); # parent object -# $AlexaItems = new AlexaBridge_Item($Alexa); # child object -# -# $AlexaItems->add('$light1','light1','set','on','off','state'); -# -# -# -# In order to allow the user to map pretty much anything in MH to a Echo/GH -# command I created a mapping. -# -# $AlexaItems->add('','','','','',''); -# -# -# -# $AlexaItems->add('$light1','light1','set','on','off','state'); # This -# is the same as $AlexaItems->add('$light1') -# -# -# # To change the name of an object to a more natural name that you would -# say to the Echo/GH: -# -# $AlexaItems->add('$GarageHall_light_front','Garage_Hall_light'); -# -# -# # To map a voice command, # is replaced by the Echo/GH command -# (on/off/dim%). -# # My actual voice command in MH is "set night mode on", so I configure it -# like: -# -# $AlexaItems->add('set night mode !','NightMode','run_voice_cmd'); # If -# I say "Alexa, Turn on Night Mode", run_voice_cmd("set night mode on") is -# run in MH. -# -# -# # To configure a user code sub: -# # The actual name (argument 1) can be anything. -# # A code ref must be used. -# # (on/off/dim%) are passed to the sub as an argument when its run. -# $AlexaItems->add('testsub','Test_Sub',\&testsub); # say "Alexa, Turn on -# Test Sub", &testsub("on") is run in MH. -# -# -# # I have an Insteon thermostat and I configured it like: -# $AlexaItems->add('$thermostat','Heat','heat_setpoint',undef,undef,'get_heat_sp'); -# # say "Alexa, Set Heat to 73%", $thermostat->heat_setpoint("73") is run -# in MH. -# $AlexaItems->add('$thermostat','Cool','cool_setpoint',undef,undef,'get_cool_sp'); - - -# I have a script that I use to control my AV equipment and I can run it via -# ssh, so I made a voice command in MH: -# -# $v_set_tv_mode = new Voice_Cmd("set tv mode [on,off,hbo,netflix,roku,directtv,xbmc,wii]"); -# $p_set_tv_mode = new Process_Item; -# if (my $state = said $v_set_tv_mode) { -# set $p_set_tv_mode "/usr/bin/ssh wayne\@192.168.1.10 \"sudo /usr/local/HomeAVControl/bin/input_change $state\""; -# start $p_set_tv_mode; -# } -# -# -# -# I added the following to my MH user code: -# $AlexaItems->add('set tv mode #','tv','run_voice_cmd'); # "Alexa, Turn on -# tv" / "Alexa, Turn off tv" # turns all my AV stuff on or off -# $AlexaItems->add('set tv mode #','DirectTv','run_voice_cmd','directtv','directtv'); -# #"Alexa, Turn on Direct Tv" # turns all my AV stuff on and set the input to -# direct tv -# $AlexaItems->add('set tv mode #','Hbo','run_voice_cmd','hbo','hbo'); -# #"Alexa, Turn on hbo" # turns all my AV stuff on and set the input to Roku -# and launches the HBO Go app -# $AlexaItems->add('set tv mode #','Netflix','run_voice_cmd','netflix','netflix'); -# #"Alexa, Turn on Netflix" # turns all my AV stuff on and set the input to -# Roku and launches the Netflix app -# $AlexaItems->add('set tv mode #','Roku','run_voice_cmd','roku','roku'); -# $AlexaItems->add('set tv mode #','xbmc','run_voice_cmd','xbmc','xbmc'); -# $AlexaItems->add('set tv mode #','wii','run_voice_cmd','wii','wii'); +=head1 B +=head2 DESCRIPTION +Module emulates the HUE to allow for direct connectivity from the Amazon Echo, Google Home, and any other devices that support the HUE bridge. + +=head2 CONFIGURATION + + +The AlexaBridge_Item object holds the configured Misterhouse objects that are presented to the Amazon Echo or Google Home. +See + +=head2 mh.private.ini Configuration + +Note: +You must use port 80 for Google Home, it is locked down to port 80. +The user running MH must be root to run on port 80 or you have to give the MH user rights to use the port. + +For Google Home and a reverse proxy (Apache/IIS/etc): + + alexa_enable = 1 + alexaHttpPortCount = 0 # disables all proxy ports + alexaHttpPort = 80 # tells the module to send port 80 in the SSDP response and look for port 80 in the HTTP host header + alexaObjectsPerGet = 300 # Google Home can handle us returning all objects in a single response + +For Google Home using the builtin proxy port: + + alexa_enable = 1 + alexaHttpPortCount = 1 # Open 1 proxy port on port 80 (We default to port 80 so no need to define it) + alexaNoDefaultHttp = 1 # Disable responding on the default MH web port because Google Home will not use it any way. + alexaObjectsPerGet = 300 # Google Home can handle us returning all objects in a single response + + +For Echo (Chunked method): + + alexa_enable = 1 + alexaEnableChunked = 1 + + +For Echo (Multi-port method): +This method should not be needed unless for some reason your Echo does not work with the Chunked method. + + alexa_enable = 1 + alexaHttpPortCount = 1 # Open 1 proxy port for a total of 2 ports including the default MH web port. We only support 1 for now unless I see a need for more. + alexaHttpPort=8085 # The proxy port will be on port 8085, this port should be higher than the MH web port so it is used first. + + +# All options + + alexa_enable # Enable the module + alexaEnableChunked # Enable chunked return method (For the Echo) + alexaHttpPortCount # Amount of proxy ports to open + alexaNoDefaultHttp # Disable responding on the default MH web port + alexaObjectsPerGet # Amount of MH objects we return per GET from the Echo/GH + alexaHttpPort # First proxy port number + alexaMac # This is used in the SSDP response, We discover it so it does not need to be defined unless something goes wrong + alexaHttpIp # This is the IP of the local MH server, We discover it so it does not need to be defined unless something goes wrong + +=head2 Defining the Primary Object + +The object can be defined in the user code or in a .mht file. + +In mht: + + ALEX_BRIDGE, Alexa + + +Or in user code: + + $Alexa = new AlexaBridge(); # parent object + + +=head2 NOTES + +The most important part of the configuration is mapping the objects/code you want to present to the module (Echo/Google Home/Etc.). +This allows the user to map pretty much anything in MH to a Echo/GH command. + + ALEXABRIDGE_ADD, , , , + , , + + - This is the only required parameter. If you are +good with the defaults, you can add an object like: +# In MHT + + ALEXABRIDGE_ADD, AlexaItems, light1 + +# or in user code + + $AlexaItems->add('$light1'); + + - This defaults to using the without the $. If want to change the name you say to the +Echo/GH to control the object, you can define it here. You can also make +aliases for objects so it's easier to remember. + + - This defaults to 'set' which +works for most objects. You can also put a code reference or +'run_voice_cmd'. + + - If you want to set an object to +something other than 'on' when you say 'on' to the Echo/GH, you can define +it here. Defaults to 'on'. + + - If you want to set an object to +something other than 'off' when you say 'off' to the Echo/GH, you can +define it here. Defaults to 'off'. + + - If your object uses a custom sub to +get the state, define it here. Defaults to 'state' which works for most +objects. + + +The dim % is the actual number you say to Alexa, so if you say "Alexa,Set +Light 1 to 75 %" then the dim % value will be 75. + + +The module supports 300 devices which is the max supported by the Echo + + + +=head2 Complete Examples + + +MHT examples: + + ALEX_BRIDGE, Alexa + ALEXABRIDGE_ITEM, AlexaItems, Alexa + ALEXABRIDGE_ADD, AlexaItems, light1 light1, set, on, off, state # these are the defaults + ALEXABRIDGE_ADD, AlexaItems, light1 # same as the line above + ALEXABRIDGE_ADD, AlexaItems, light3, Test_Light_3 # if you want to change the name you say + ALEXABRIDGE_ADD, AlexaItems, testsub, Test_Sub, \&testsub +# "!" will be replaced with the action ( on/off/ ), so if you say "turn on test voice" then the module will run run_voice_cmd("test voice on") + ALEXABRIDGE_ADD, AlexaItems, test_voice_!, Test_Voice, run_voice_cmd + + +User code examples: + + $Alexa = new AlexaBridge(); # parent object + $AlexaItems = new AlexaBridge_Item($Alexa); # child object + + $AlexaItems->add('$light1','light1','set','on','off','state'); # This is the same as $AlexaItems->add('$light1') + + + +To change the name of an object to a more natural name that you would say to the Echo/GH: + + $AlexaItems->add('$GarageHall_light_front','Garage_Hall_light'); + + +To map a voice command, # is replaced by the Echo/GH command (on/off/dim%). +My actual voice command in MH is "set night mode on", so I configure it like: + + $AlexaItems->add('set night mode !','NightMode','run_voice_cmd'); + + If I say "Alexa, Turn on Night Mode", run_voice_cmd("set night mode on") is run in MH. + + +To configure a user code sub: +The actual name (argument 1) can be anything. +A code ref must be used. +When the sub is run 2 arguments are passed to it: Argument 1 is (state or set) Argument 2 is: (on/off/). + +# Mht file + + ALEXABRIDGE_ADD, AlexaItems, testsub, Test_Sub, &testsub + +# User Code + + $AlexaItems->add('testsub','Test_Sub',\&testsub); # say "Alexa, Turn on Test Sub", &testsub('set','on') is run in MH. + + +# I have an Insteon thermostat, the Insteon object name is $thermostat and I configured it like: + + ALEXABRIDGE_ADD, AlexaItems, thermostat, Heat, heat_setpoint, on, off, get_heat_sp + +# say "Alexa, Set Heat to 73", $thermostat->heat_setpoint("73") is run in MH. + + ALEXABRIDGE_ADD, AlexaItems, thermostat, Cool, cool_setpoint, on, off, get_cool_sp + + +In order to be able to say things like "Alexa, set thermostat up by 2", a sub must be created in user code +When the above is said to the Echo, it first gets the current state, then subtracts or adds the amount that was said. + + sub temperature { + my ($type, $state) = @_; + + # $type is state or set + # $state is the number, on, off, etc + + # we are changing heat and cool so just return a static number, we just need the diff + # because the Echo will add or subtact the amount that was said to it. + # so if we say "set thermostat up by 2", 52 will be returned in $state + if ($type eq 'state') { return 50; } + + return '' unless ($state =~ /\d+/); Make sure we have a number + return '' if ($state > 65); # Dont allow changes over 15 + return '' if ($state < 35); # Dont allow changes over 15 + my ( $heatsp, $coolsp ); + $state = ($state - 50); # subtract the amount we return above to get the actual amount to change. + $coolsp = ((state $thermo_setpoint_c) + $state); + $heatsp = ((state $thermo_setpoint_h) + $state); + # The Insteon thermostat has an issue when setting both heat and cool at the same time, so the timer is a work around. + $alexa_temp_timer = new Timer; + $thermostat->cool_setpoint($coolsp); + set $alexa_temp_timer '7', sub { $thermostat->heat_setpoint($heatsp) } + } + +# Map our new temperature sub in the .mht file so the Echo/Google Home can discover it + + ALEXABRIDGE_ADD, AlexaItems, thermostat, thermostat, &temperature + + + +I have a script that I use to control my AV equipment and I can run it via +ssh, so I made a voice command in MH: + + $v_set_tv_mode = new Voice_Cmd("set tv mode [on,off,hbo,netflix,roku,directtv,xbmc,wii]"); + $p_set_tv_mode = new Process_Item; + if (my $state = said $v_set_tv_mode) { + set $p_set_tv_mode "/usr/bin/ssh wayne\@192.168.1.10 \"sudo /usr/local/HomeAVControl/bin/input_change $state\""; + start $p_set_tv_mode; + } + +I added the following to my .mht file: + + ALEXABRIDGE_ADD, AlexaItems, set_tv_mode_!, DirectTv, run_voice_cmd, directtv, directtv + ALEXABRIDGE_ADD, AlexaItems, set_tv_mode_!, Roku, run_voice_cmd, roku, roku + ALEXABRIDGE_ADD, AlexaItems, set_tv_mode_!, xbmc, run_voice_cmd, xbmc, xbmc + ALEXABRIDGE_ADD, AlexaItems, set_tv_mode_!, wii, run_voice_cmd, wii, wii + ALEXABRIDGE_ADD, AlexaItems, set_tv_mode_!, Hbo, run_voice_cmd, hbo, hbo + ALEXABRIDGE_ADD, AlexaItems, set_tv_mode_!, Netflix, run_voice_cmd, netflix, netflix + + + +=head2 INHERITS + +L + +HTTP::Date +IO::Compress::Gzip +Time::HiRes +Net::Address::Ethernet +Storable +Socket +IO::Socket::INET +IO::Socket::Multicast + +=over + +=cut package AlexaBridge; @@ -147,16 +259,6 @@ use Socket; use IO::Socket::Multicast; - -#use constant SSDP_IP => "239.255.255.250"; -#use constant SSDP_PORT => 1900; -#use constant CRLF => "\015\012"; - -#use constant DEFAULT_HTTP_PORT => 80; -#use constant DEFAULT_LEASE_TIME => 1800; -#use constant DEFAULT_NOTIFICATION_PORT => 50000; -#use constant DEFAULT_PORT_COUNT => 0; - my ($LOCAL_IP, $LOCAL_MAC) = &DiscoverAddy unless ( (defined($::config_parms{'alexaMac'})) && (defined($::config_parms{'alexaHttpIp'})) ); $LOCAL_IP = $::config_parms{'alexaHttpIp'} if defined($::config_parms{'alexaHttpIp'}); $LOCAL_MAC = $::config_parms{'alexaMac'} if defined($::config_parms{'alexaMac'}); @@ -450,12 +552,6 @@ sub process_http { my $self = ::get_object_by_name($selfname); unless ($self) { &main::print_log( "[Alexa] Error: No AlexaBridge parent object found" ); return 0 } - #my $client_ip_address = $::Socket_Ports{http}{client_ip_address}; - #$client_ip_address =~ s/:.*//; - #my $client_port = $::Socket_Ports{http}{client_port}; - #$client_port =~ s/.*\://; - -#&main::print_log( "[Alexa] Debug: Process_http - Client: $client_ip_address:$client_port has sent data") if $main::Debug{'alexa'} >= 2; use HTTP::Date qw(time2str); use IO::Compress::Gzip qw(gzip); @@ -882,6 +978,55 @@ sub register { $self->{child} = $child; } +=back + +=head1 B + +=head2 DESCRIPTION + +The AlexaBridge_Item object holds the configured Misterhouse objects that are presented to the Amazon Echo or Google Home + +=head2 mh.private.ini Configuration + +See L + +=head2 Defining the Child object + +The object can be defined in the user code or in a .mht file. + +In mht: + +ALEXABRIDGE_ITEM, , + +ie: + + ALEXABRIDGE_ITEM, AlexaItems, Alexa + + +Or in user code: + + = new AlexaBridge_Item(); + +ie: + + $AlexaItems = new AlexaBridge_Item($Alexa); + + +=head2 NOTES + +See L for complete examples + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut + + package AlexaBridge_Item; @AlexaBridge_Item::ISA = ('Generic_Item'); @@ -917,6 +1062,17 @@ sub new { return $self; } +=item C + +Presents misterhouse objects, subs, or voice coommands to the Echo, Google Home, or any thing that supports +the HUE bridge. + +add('','', +'','', +'',''); + +=cut + sub add { my ($self, $realname, $name, $sub, $on, $off, $statesub) = @_; @@ -1050,3 +1206,24 @@ sub isDeleted { 1; +=back + +=head2 NOTES + +=head2 AUTHOR + +Wayne Gatlin + +=head2 SEE ALSO + +=head2 LICENSE + +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. + +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, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut + + From 0871609d6cae1cdb3303a841393caf1765303e90 Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 10 Feb 2017 19:00:16 -0600 Subject: [PATCH 22/27] Added lib/site/IO/Socket/Multicast.pm --- lib/site/IO/Socket/Multicast.pm | 426 ++++++++++++++++++++++++++++++++ 1 file changed, 426 insertions(+) create mode 100644 lib/site/IO/Socket/Multicast.pm diff --git a/lib/site/IO/Socket/Multicast.pm b/lib/site/IO/Socket/Multicast.pm new file mode 100644 index 000000000..d69edb17a --- /dev/null +++ b/lib/site/IO/Socket/Multicast.pm @@ -0,0 +1,426 @@ +package IO::Socket::Multicast; + +use 5.005; +use strict; +use Carp 'croak'; +use Exporter (); +use DynaLoader (); +use IO::Socket; +BEGIN { + eval "use IO::Interface 0.94 'IFF_MULTICAST';"; +} +use vars qw(@ISA @EXPORT_OK @EXPORT %EXPORT_TAGS $VERSION); +BEGIN { + my @functions = qw( + mcast_add + mcast_drop + mcast_if + mcast_loopback + mcast_ttl + mcast_dest + mcast_send + ); + $VERSION = '1.12'; + @ISA = qw( + Exporter + DynaLoader + IO::Socket::INET + ); + @EXPORT = ( ); + %EXPORT_TAGS = ( + 'all' => \@functions, + 'functions' => \@functions, + ); + @EXPORT_OK = @{ $EXPORT_TAGS{'all'} }; +} + +my $IP = '\d+\.\d+\.\d+\.\d+'; + +sub import { + Socket->export_to_level(1,@_); + IO::Socket::Multicast->export_to_level(1,@_); +} + +sub new { + my $class = shift; + unshift @_,(Proto => 'udp') unless @_; + $class->SUPER::new(@_); +} + +sub configure { + my($self,$arg) = @_; + $arg->{Proto} ||= 'udp'; + $self->SUPER::configure($arg); +} + +sub mcast_add { + my $sock = shift; + my $group = shift || croak 'usage: $sock->mcast_add($mcast_addr [,$interface])'; + $group = inet_ntoa($group) unless $group =~ /^$IP$/o; + my $interface = get_if_addr($sock,shift); + return $sock->_mcast_add($group,$interface); +} + +sub mcast_drop { + my $sock = shift; + my $group = shift || croak 'usage: $sock->mcast_add($mcast_addr [,$interface])'; + $group = inet_ntoa($group) unless $group =~ /^$IP$/o; + my $interface = get_if_addr($sock,shift); + return $sock->_mcast_drop($group,$interface); +} + +sub mcast_if { + my $sock = shift; + + my $previous = $sock->_mcast_if; + $previous = $sock->addr_to_interface($previous) + if $sock->can('addr_to_interface'); + return $previous unless @_; + + my $interface = get_if_addr($sock,shift); + return $sock->_mcast_if($interface) ? $previous : undef; +} + +sub get_if_addr { + my $sock = shift; + return '0.0.0.0' unless defined (my $interface = shift); + return $interface if $interface =~ /^$IP$/; + return $interface if length $interface == 16; + croak "IO::Interface module not available; use IP addr for interface" + unless $sock->can('if_addr'); + croak "unknown or unconfigured interace $interface" + unless my $addr = $sock->if_addr($interface); + croak "interface is not multicast capable" + unless $interface eq 'any' or ($sock->if_flags($interface) & IFF_MULTICAST()); + return $addr; +} + +sub mcast_dest { + my $sock = shift; + my $prev = ${*$sock}{'io_socket_mcast_dest'}; + if (my $dest = shift) { + $dest = sockaddr_in($2,inet_aton($1)) if $dest =~ /^($IP):(\d+)$/; + croak "invalid destination address" unless length($dest) == 16; + ${*$sock}{'io_socket_mcast_dest'} = $dest; + } + return $prev; +} + +sub mcast_send { + my $sock = shift; + my $data = shift || croak 'usage: $sock->mcast_send($data [,$address])'; + $sock->mcast_dest(shift) if @_; + my $dest = $sock->mcast_dest || croak "no destination specified with mcast_send() or mcast_dest()"; + return send($sock,$data,0,$dest); +} + +bootstrap IO::Socket::Multicast $VERSION; + +1; + +__END__ + +=pod + +=head1 NAME + +IO::Socket::Multicast - Send and receive multicast messages + +=head1 SYNOPSIS + + use IO::Socket::Multicast; + + # create a new UDP socket ready to read datagrams on port 1100 + my $s = IO::Socket::Multicast->new(LocalPort=>1100); + + # Add a multicast group + $s->mcast_add('225.0.1.1'); + + # Add a multicast group to eth0 device + $s->mcast_add('225.0.0.2','eth0'); + + # now receive some multicast data + $s->recv($data,1024); + + # Drop a multicast group + $s->mcast_drop('225.0.0.1'); + + # Set outgoing interface to eth0 + $s->mcast_if('eth0'); + + # Set time to live on outgoing multicast packets + $s->mcast_ttl(10); + + # Turn off loopbacking + $s->mcast_loopback(0); + + # Multicast a message to group 225.0.0.1 + $s->mcast_send('hello world!','225.0.0.1:1200'); + $s->mcast_set('225.0.0.2:1200'); + $s->mcast_send('hello again!'); + +=head1 DESCRIPTION + +The IO::Socket::Multicast module subclasses IO::Socket::INET to enable +you to manipulate multicast groups. With this module (and an +operating system that supports multicasting), you will be able to +receive incoming multicast transmissions and generate your own +outgoing multicast packets. + +This module requires IO::Interface version 0.94 or higher. + +=head2 INTRODUCTION + +Multicasting is designed for streaming multimedia applications and for +conferencing systems in which one transmitting machines needs to +distribute data to a large number of clients. + +IP addresses in the range 224.0.0.0 and 239.255.255.255 are reserved +for multicasting. These addresses do not correspond to individual +machines, but to multicast groups. Messages sent to these addresses +will be delivered to a potentially large number of machines that have +registered their interest in receiving transmissions on these groups. +They work like TV channels. A program tunes in to a multicast group +to receive transmissions to it, and tunes out when it no longer +wishes to receive the transmissions. + +To receive transmissions B a multicast group, you will use +IO::Socket::Multicast->new() to create a UDP socket and bind it to a local +network port. You will then subscribe one or more multicast groups +using the mcast_add() method. Subsequent calls to the standard recv() +method will now receive messages incoming messages transmitted to the +subscribed groups using the selected port number. + +To send transmissions B a multicast group, you can use the +standard send() method to send messages to the multicast group and +port of your choice. The mcast_set() and mcast_send() methods are +provided as convenience functions. Mcast_set() will set a default +multicast destination for messages which you then send with +mcast_send(). + +To set the number of hops (routers) that outgoing multicast messages +will cross, call mcast_ttl(). To activate or deactivate the looping +back of multicast messages (in which a copy of the transmitted +messages is received by the local machine), call mcast_loopback(). + +=head2 CONSTRUCTORS + +=over 4 + +=item $socket = IO::Socket::Multicast->new([LocalPort=>$port,...]) + +The new() method is the constructor for the IO::Socket::Multicast +class. It takes the same arguments as IO::Socket::INET, except that +the B argument, rather than defaulting to "tcp", will default +to "udp", which is more appropriate for multicasting. + +To create a UDP socket suitable for sending outgoing multicast +messages, call new() without arguments (or with +C'udp'>). To create a UDP socket that can also receive +incoming multicast transmissions on a specific port, call new() with +the B argument. + +If you plan to run the client and server on the same machine, you may +wish to set the IO::Socket B argument to a true value. +This allows multiple multicast sockets to bind to the same address. + +=back + +=head2 METHODS + +=over 4 + +=item $success = $socket->mcast_add($multicast_address [,$interface]) + +The mcast_add() method will add the provided multicast address to the +list of subscribed multicast groups. The address may be provided +either as a dotted-quad decimal, or as a packed IP address (such as +produced by the inet_aton() function). On success, the method will +return a true value. + +The optional $interface argument can be used to specify on which +network interface to listen for incoming multicast messages. If the +IO::Interface module is installed, you may use the device name for the +interface (e.g. "tu0"). Otherwise, you must use the IP address of the +desired network interface. Either dotted quad form or packed IP +address is acceptable. If no interface is specified, then the +multicast group is joined on INADDR_ANY, meaning that multicast +transmissions received on B of the host's network interfaces will +be forwarded to the socket. + +Note that mcast_add() operates on the underlying interface(s) and not +on the socket. If you have multiple sockets listening on a port, and +you mcast_add() a group to one of those sockets, subsequently B +the sockets will receive mcast messages on this group. To filter +messages that can be received by a socket so that only those sent to a +particular multicast address are received, pass the B +option to the socket at the time you create it: + + my $socket = IO::Socket::Multicast->new(LocalPort=>2000, + LocalAddr=>226.1.1.2', + ReuseAddr=>1); + $socket->mcast_add('226.1.1.2'); + +By combining this technique with IO::Select, you can write +applications that listen to multiple multicast groups and distinguish +which group a message was addressed to by identifying which socket it +was received on. + +=item $success = $socket->mcast_drop($multicast_address) + +This reverses the action of mcast_add(), removing the indicated +multicast address from the list of subscribed groups. + +=item $loopback = $socket->mcast_loopback + +=item $previous = $socket->mcast_loopback($new) + +The mcast_loopback() method controls whether the socket will receive +its own multicast transmissions (default yes). Called without +arguments, the method returns the current state of the loopback +flag. Called with a boolean argument, the method will set the loopback +flag, and return its previous value. + +=item $ttl = $socket->mcast_ttl + +=item $previous = $socket->mcast_ttl($new) + +The mcast_ttl() method examines or sets the time to live (TTL) for +outgoing multicast messages. The TTL controls the numbers of routers +the packet can cross before being expired. The default TTL is 1, +meaning that the message is confined to the local area network. +Values between 0 and 255 are valid. + +Called without arguments, this method returns the socket's current +TTL. Called with a value, this method sets the TTL and returns its +previous value. + +=item $interface = $socket->mcast_if + +=item $previous = $socket->mcast_if($new) + +By default, the OS will pick the network interface to use for outgoing +multicasts automatically. You can control this process by using the +mcast_if() method to set the outgoing network interface explicitly. +Called without arguments, returns the current interface. Called with +the name of an interface, sets the outgoing interface and returns its +previous value. + +You can use the device name for the interface (e.g. "tu0") if the +IO::Interface module is present. Otherwise, you must use the +interface's dotted IP address. + +B: To set the interface used for B multicasts, use the +mcast_add() method. + +=item $dest = $socket->mcast_dest + +=item $previous = $socket->mcast_dest($new) + +The mcast_dest() method is a convenience function that allows you to +set the default destination group for outgoing multicasts. Called +without arguments, returns the current destination as a packed binary +sockaddr_in data structure. Called with a new destination address, +the method sets the default destination and returns the previous one, +if any. + +Destination addresses may be provided as packed sockaddr_in +structures, or in the form "XX.XX.XX.XX:YY" where the first part is +the IP address, and the second the port number. + +=item $bytes = $socket->mcast_send($data [,$dest]) + +Mcast_send() is a convenience function that simplifies the sending of +multicast messages. C<$data> is the message contents, and C<$dest> is +an optional destination group. You can use either the dotted IP form +of the destination address and its port number, or a packed +sockaddr_in structure. If the destination is not supplied, it will +default to the most recent value set in mcast_dest() or a previous +call to mcast_send(). + +The method returns the number of bytes successfully queued for +delivery. + +As a side-effect, the method will call mcast_dest() to remember the +destination address. + +Example: + + $socket->mcast_send('Hi there group members!','225.0.1.1:1900') || die; + $socket->mcast_send("How's the weather?") || die; + +Note that you may still call IO::Socket::Multicast->new() with a +B, and IO::Socket::INET will perform a connect(), creating a +default destination for calls to send(). + +=back + +=head1 EXAMPLE + +The following is an example of a multicast server. Every 10 seconds +it transmits the current time and the list of logged-in users to the +local network using multicast group 226.1.1.2, port 2000 (these are +chosen arbitrarily). + + #!/usr/bin/perl + # server + use strict; + use IO::Socket::Multicast; + + use constant DESTINATION => '226.1.1.2:2000'; + my $sock = IO::Socket::Multicast->new(Proto=>'udp',PeerAddr=>DESTINATION); + + while (1) { + my $message = localtime; + $message .= "\n" . `who`; + $sock->send($message) || die "Couldn't send: $!"; + } continue { + sleep 10; + } + +This is the corresponding client. It listens for transmissions on +group 226.1.1.2, port 2000, and echoes the messages to standard +output. + + #!/usr/bin/perl + # client + + use strict; + use IO::Socket::Multicast; + + use constant GROUP => '226.1.1.2'; + use constant PORT => '2000'; + + my $sock = IO::Socket::Multicast->new(Proto=>'udp',LocalPort=>PORT); + $sock->mcast_add(GROUP) || die "Couldn't set group: $!\n"; + + while (1) { + my $data; + next unless $sock->recv($data,1024); + print $data; + } + +=head2 EXPORT + +None by default. However, if you wish to call mcast_add(), +mcast_drop(), mcast_if(), mcast_loopback(), mcast_ttl, mcast_dest() +and mcast_send() as functions you may import them explicitly on the +B line or by importing the tag ":functions". + +=head2 BUGS + +The mcast_if(), mcast_ttl() and mcast_loopback() methods will cause a +crash on versions of Linux earlier than 2.2.0 because of a kernel bug +in the implementation of the multicast socket options. + +=head1 AUTHOR + +Lincoln Stein, lstein@cshl.org. + +This module is distributed under the same terms as Perl itself. + +=head1 SEE ALSO + +perl(1), IO::Socket(3), IO::Socket::INET(3). + +=cut From 256b1eb17c4de63a3aa795a7ac836348e9e3dfea Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 10 Feb 2017 23:21:23 -0600 Subject: [PATCH 23/27] Added lib/site/IO/Interface --- lib/site/IO/Interface.pm | 303 ++++++++++++++++++++++++++++++++ lib/site/IO/Interface/Simple.pm | 287 ++++++++++++++++++++++++++++++ 2 files changed, 590 insertions(+) create mode 100644 lib/site/IO/Interface.pm create mode 100644 lib/site/IO/Interface/Simple.pm diff --git a/lib/site/IO/Interface.pm b/lib/site/IO/Interface.pm new file mode 100644 index 000000000..419aa004b --- /dev/null +++ b/lib/site/IO/Interface.pm @@ -0,0 +1,303 @@ +package IO::Interface; + +require 5.005; +use strict; +use Carp; +use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD); + +use IO::Socket; + +require Exporter; +require DynaLoader; + +my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric + addr_to_interface if_index if_indextoname ); +my @flags = qw(IFF_ALLMULTI IFF_AUTOMEDIA IFF_BROADCAST + IFF_DEBUG IFF_LOOPBACK IFF_MASTER + IFF_MULTICAST IFF_NOARP IFF_NOTRAILERS + IFF_POINTOPOINT IFF_PORTSEL IFF_PROMISC + IFF_RUNNING IFF_SLAVE IFF_UP); +%EXPORT_TAGS = ( 'all' => [@functions,@flags], + 'functions' => \@functions, + 'flags' => \@flags, + ); + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +@EXPORT = qw( ); + +@ISA = qw(Exporter DynaLoader); +$VERSION = '1.09'; + +sub AUTOLOAD { + # This AUTOLOAD is used to 'autoload' constants from the constant() + # XS function. If a constant is not found then control is passed + # to the AUTOLOAD in AutoLoader. + + my $constname; + ($constname = $AUTOLOAD) =~ s/.*:://; + croak "&constant not defined" if $constname eq 'constant'; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/ || $!{EINVAL}) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined IO::Interface macro $constname"; + } + } + { + no strict 'refs'; + *$AUTOLOAD = sub { $val }; # *$AUTOLOAD = sub() { $val }; + } + goto &$AUTOLOAD; +} + +bootstrap IO::Interface $VERSION; + +# copy routines into IO::Socket +{ + no strict 'refs'; + *{"IO\:\:Socket\:\:$_"} = \&$_ foreach @functions; +} + +# Preloaded methods go here. + +sub if_list { + my %hash = map {$_=>undef} &_if_list; + sort keys %hash; +} + +sub addr_to_interface { + my ($sock,$addr) = @_; + return "any" if $addr eq '0.0.0.0'; + my @interfaces = $sock->if_list; + foreach (@interfaces) { + my $if_addr = $sock->if_addr($_) or next; + return $_ if $if_addr eq $addr; + } + return; # couldn't find it +} + +# Autoload methods go after =cut, and are processed by the autosplit program. +1; +__END__ + +=head1 NAME + +IO::Interface - Perl extension for access to network card configuration information + +=head1 SYNOPSIS + + # ====================== + # the new, preferred API + # ====================== + + use IO::Interface::Simple; + + my $if1 = IO::Interface::Simple->new('eth0'); + my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); + my $if3 = IO::Interface::Simple->new_from_index(1); + + my @interfaces = IO::Interface::Simple->interfaces; + + for my $if (@interfaces) { + print "interface = $if\n"; + print "addr = ",$if->address,"\n", + "broadcast = ",$if->broadcast,"\n", + "netmask = ",$if->netmask,"\n", + "dstaddr = ",$if->dstaddr,"\n", + "hwaddr = ",$if->hwaddr,"\n", + "mtu = ",$if->mtu,"\n", + "metric = ",$if->metric,"\n", + "index = ",$if->index,"\n"; + + print "is running\n" if $if->is_running; + print "is broadcast\n" if $if->is_broadcast; + print "is p-to-p\n" if $if->is_pt2pt; + print "is loopback\n" if $if->is_loopback; + print "is promiscuous\n" if $if->is_promiscuous; + print "is multicast\n" if $if->is_multicast; + print "is notrailers\n" if $if->is_notrailers; + print "is noarp\n" if $if->is_noarp; + } + + + # =========== + # the old API + # =========== + + use IO::Socket; + use IO::Interface qw(:flags); + + my $s = IO::Socket::INET->new(Proto => 'udp'); + my @interfaces = $s->if_list; + + for my $if (@interfaces) { + print "interface = $if\n"; + my $flags = $s->if_flags($if); + print "addr = ",$s->if_addr($if),"\n", + "broadcast = ",$s->if_broadcast($if),"\n", + "netmask = ",$s->if_netmask($if),"\n", + "dstaddr = ",$s->if_dstaddr($if),"\n", + "hwaddr = ",$s->if_hwaddr($if),"\n"; + + print "is running\n" if $flags & IFF_RUNNING; + print "is broadcast\n" if $flags & IFF_BROADCAST; + print "is p-to-p\n" if $flags & IFF_POINTOPOINT; + print "is loopback\n" if $flags & IFF_LOOPBACK; + print "is promiscuous\n" if $flags & IFF_PROMISC; + print "is multicast\n" if $flags & IFF_MULTICAST; + print "is notrailers\n" if $flags & IFF_NOTRAILERS; + print "is noarp\n" if $flags & IFF_NOARP; + } + + my $interface = $s->addr_to_interface('127.0.0.1'); + + +=head1 DESCRIPTION + +IO::Interface adds methods to IO::Socket objects that allows them to +be used to retrieve and change information about the network +interfaces on your system. In addition to the object-oriented access +methods, you can use a function-oriented style. + +THIS API IS DEPRECATED. Please see L for the +preferred way to get and set interface configuration information. + +=head2 Creating a Socket to Access Interface Information + +You must create a socket before you can access interface +information. The socket does not have to be connected to a remote +site, or even used for communication. The simplest procedure is to +create a UDP protocol socket: + + my $s = IO::Socket::INET->new(Proto => 'udp'); + +The various IO::Interface functions will now be available as methods +on this socket. + +=head2 Methods + +=over 4 + +=item @iflist = $s->if_list + +The if_list() method will return a list of active interface names, for +example "eth0" or "tu0". If no interfaces are configured and running, +returns an empty list. + +=item $addr = $s->if_addr($ifname [,$newaddr]) + +if_addr() gets or sets the interface address. Call with the interface +name to retrieve the address (in dotted decimal format). Call with a +new address to set the interface. In the latter case, the routine +will return a true value if the operation was successful. + + my $oldaddr = $s->if_addr('eth0'); + $s->if_addr('eth0','192.168.8.10') || die "couldn't set address: $!"; + +Special case: the address of the pseudo-device "any" will return the +IP address "0.0.0.0", which corresponds to the INADDR_ANY constant. + +=item $broadcast = $s->if_broadcast($ifname [,$newbroadcast] + +Get or set the interface broadcast address. If the interface does not +have a broadcast address, returns undef. + +=item $mask = $s->if_netmask($ifname [,$newmask]) + +Get or set the interface netmask. + +=item $dstaddr = $s->if_dstaddr($ifname [,$newdest]) + +Get or set the destination address for point-to-point interfaces. + +=item $hwaddr = $s->if_hwaddr($ifname [,$newhwaddr]) + +Get or set the hardware address for the interface. Currently only +ethernet addresses in the form "00:60:2D:2D:51:70" are accepted. + +=item $flags = $s->if_flags($ifname [,$newflags]) + +Get or set the flags for the interface. The flags are a bitmask +formed from a series of constants. See L below. + +=item $ifname = $s->addr_to_interface($ifaddr) + +Given an interface address in dotted form, returns the name of the +interface associated with it. Special case: the INADDR_ANY address, +0.0.0.0 will return a pseudo-interface name of "any". + +=back + +=head2 EXPORT + +IO::Interface exports nothing by default. However, you can import the +following symbol groups into your namespace: + + :functions Function-oriented interface (see below) + :flags Flag constants (see below) + :all All of the above + +=head2 Function-Oriented Interface + +By importing the ":functions" set, you can access IO::Interface in a +function-oriented manner. This imports all the methods described +above into your namespace. Example: + + use IO::Socket; + use IO::Interface ':functions'; + + my $sock = IO::Socket::INET->new(Proto=>'udp'); + my @interfaces = if_list($sock); + print "address = ",if_addr($sock,$interfaces[0]); + +=head2 Exportable constants + +The ":flags" constant imports the following constants for use with the +flags returned by if_flags(): + + IFF_ALLMULTI + IFF_AUTOMEDIA + IFF_BROADCAST + IFF_DEBUG + IFF_LOOPBACK + IFF_MASTER + IFF_MULTICAST + IFF_NOARP + IFF_NOTRAILERS + IFF_POINTOPOINT + IFF_PORTSEL + IFF_PROMISC + IFF_RUNNING + IFF_SLAVE + IFF_UP + +This example determines whether interface 'tu0' supports multicasting: + + use IO::Socket; + use IO::Interface ':flags'; + my $sock = IO::Socket::INET->new(Proto=>'udp'); + print "can multicast!\n" if $sock->if_flags & IFF_MULTICAST. + +=head1 AUTHOR + +Lincoln D. Stein +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + +=head1 SUPPORT + +For feature requests, bug reports and code contributions, please use +the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +=head1 SEE ALSO + +perl(1), IO::Socket(3), IO::Multicast(3), L + +=cut diff --git a/lib/site/IO/Interface/Simple.pm b/lib/site/IO/Interface/Simple.pm new file mode 100644 index 000000000..def0b1ebf --- /dev/null +++ b/lib/site/IO/Interface/Simple.pm @@ -0,0 +1,287 @@ +package IO::Interface::Simple; +use strict; +use IO::Socket; +use IO::Interface; + +use overload '""' => \&as_string, + eq => '_eq_', + fallback => 1; + +# class variable +my $socket; + +# class methods +sub interfaces { + my $class = shift; + my $s = $class->sock; + return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list; +} + +sub new { + my $class = shift; + my $if_name = shift; + my $s = $class->sock; + return unless defined $s->if_mtu($if_name); + return bless {s => $s, + name => $if_name},ref $class || $class; +} + +sub new_from_address { + my $class = shift; + my $addr = shift; + my $s = $class->sock; + my $name = $s->addr_to_interface($addr) or return; + return $class->new($name); +} + +sub new_from_index { + my $class = shift; + my $index = shift; + my $s = $class->sock; + my $name = $s->if_indextoname($index) or return; + return $class->new($name); +} + +sub sock { + my $self = shift; + if (ref $self) { + return $self->{s} ||= $socket; + } else { + return $socket ||= IO::Socket::INET->new(Proto=>'udp'); + } +} + +sub _eq_ { + return shift->name eq shift; +} + +sub as_string { + shift->name; +} + +sub name { + shift->{name}; +} + +sub address { + my $self = shift; + $self->sock->if_addr($self->name,@_); +} + +sub broadcast { + my $self = shift; + $self->sock->if_broadcast($self->name,@_); +} + +sub netmask { + my $self = shift; + $self->sock->if_netmask($self->name,@_); +} + +sub dstaddr { + my $self = shift; + $self->sock->if_dstaddr($self->name,@_); +} + +sub hwaddr { + my $self = shift; + $self->sock->if_hwaddr($self->name,@_); +} + +sub flags { + my $self = shift; + $self->sock->if_flags($self->name,@_); +} + +sub mtu { + my $self = shift; + $self->sock->if_mtu($self->name,@_); +} + +sub metric { + my $self = shift; + $self->sock->if_metric($self->name,@_); +} + +sub index { + my $self = shift; + return $self->sock->if_index($self->name); +} + +sub is_running { shift->_gettestflag(IO::Interface::IFF_RUNNING(),@_) } +sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(),@_) } +sub is_pt2pt { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(),@_) } +sub is_loopback { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(),@_) } +sub is_promiscuous { shift->_gettestflag(IO::Interface::IFF_PROMISC(),@_) } +sub is_multicast { shift->_gettestflag(IO::Interface::IFF_MULTICAST(),@_) } +sub is_notrailers { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(),@_) } +sub is_noarp { shift->_gettestflag(IO::Interface::IFF_NOARP(),@_) } + +sub _gettestflag { + my $self = shift; + my $bitmask = shift; + my $flags = $self->flags; + if (@_) { + $flags |= $bitmask; + $self->flags($flags); + } else { + return ($flags & $bitmask) != 0; + } +} + +1; + +=head1 NAME + +IO::Interface::Simple - Perl extension for access to network card configuration information + +=head1 SYNOPSIS + + use IO::Interface::Simple; + + my $if1 = IO::Interface::Simple->new('eth0'); + my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); + my $if3 = IO::Interface::Simple->new_from_index(1); + + my @interfaces = IO::Interface::Simple->interfaces; + + for my $if (@interfaces) { + print "interface = $if\n"; + print "addr = ",$if->address,"\n", + "broadcast = ",$if->broadcast,"\n", + "netmask = ",$if->netmask,"\n", + "dstaddr = ",$if->dstaddr,"\n", + "hwaddr = ",$if->hwaddr,"\n", + "mtu = ",$if->mtu,"\n", + "metric = ",$if->metric,"\n", + "index = ",$if->index,"\n"; + + print "is running\n" if $if->is_running; + print "is broadcast\n" if $if->is_broadcast; + print "is p-to-p\n" if $if->is_pt2pt; + print "is loopback\n" if $if->is_loopback; + print "is promiscuous\n" if $if->is_promiscuous; + print "is multicast\n" if $if->is_multicast; + print "is notrailers\n" if $if->is_notrailers; + print "is noarp\n" if $if->is_noarp; + } + + +=head1 DESCRIPTION + +IO::Interface::Simple allows you to interrogate and change network +interfaces. It has overlapping functionality with Net::Interface, but +might compile and run on more platforms. + +=head2 Class Methods + +=over 4 + +=item $interface = IO::Interface::Simple->new('eth0') + +Given an interface name, new() creates an interface object. + +=item @iflist = IO::Interface::Simple->interfaces; + +Returns a list of active interface objects. + +=item $interface = IO::Interface::Simple->new_from_address('192.168.0.1') + +Returns the interface object corresponding to the given address. + +=item $interface = IO::Interface::Simple->new_from_index(2) + +Returns the interface object corresponding to the given numeric +index. This is only supported on BSD-ish platforms. + +=back + +=head2 Object Methods + +=over 4 + +=item $name = $interface->name + +Get the name of the interface. The interface object is also overloaded +so that if you use it in a string context it is the same as calling +name(). + +=item $index = $interface->index + +Get the index of the interface. This is only supported on BSD-like +platforms. + +=item $addr = $interface->address([$newaddr]) + +Get or set the interface's address. + + +=item $addr = $interface->broadcast([$newaddr]) + +Get or set the interface's broadcast address. + +=item $addr = $interface->netmask([$newmask]) + +Get or set the interface's netmask. + +=item $addr = $interface->hwaddr([$newaddr]) + +Get or set the interface's hardware address. + +=item $addr = $interface->mtu([$newmtu]) + +Get or set the interface's MTU. + +=item $addr = $interface->metric([$newmetric]) + +Get or set the interface's metric. + +=item $flags = $interface->flags([$newflags]) + +Get or set the interface's flags. These can be ANDed with the IFF +constants exported by IO::Interface or Net::Interface in order to +interrogate the state and capabilities of the interface. However, it +is probably more convenient to use the broken-out methods listed +below. + +=item $flag = $interface->is_running([$newflag]) + +=item $flag = $interface->is_broadcast([$newflag]) + +=item $flag = $interface->is_pt2pt([$newflag]) + +=item $flag = $interface->is_loopback([$newflag]) + +=item $flag = $interface->is_promiscuous([$newflag]) + +=item $flag = $interface->is_multicast([$newflag]) + +=item $flag = $interface->is_notrailers([$newflag]) + +=item $flag = $interface->is_noarp([$newflag]) + +Get or set the corresponding configuration parameters. Note that the +operating system may not let you set some of these. + +=back + +=head1 AUTHOR + +Lincoln D. Stein +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + +=head1 SUPPORT + +For feature requests, bug reports and code contributions, please use +the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +=head1 SEE ALSO + +L, L, L), L, L + +=cut + From db89a90cc9ff1044a7aa7ae022bba0eba0fc6c59 Mon Sep 17 00:00:00 2001 From: waynieack Date: Mon, 20 Feb 2017 11:18:28 -0600 Subject: [PATCH 24/27] Removed requirement for IO::Socket::Multicast --- lib/AlexaBridge.pm | 92 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 73 insertions(+), 19 deletions(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 468501321..5a4893aac 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -62,7 +62,7 @@ The object can be defined in the user code or in a .mht file. In mht: - ALEX_BRIDGE, Alexa + ALEXA_BRIDGE, Alexa Or in user code: @@ -123,7 +123,7 @@ The module supports 300 devices which is the max supported by the Echo MHT examples: - ALEX_BRIDGE, Alexa + ALEXA_BRIDGE, Alexa ALEXABRIDGE_ITEM, AlexaItems, Alexa ALEXABRIDGE_ADD, AlexaItems, light1 light1, set, on, off, state # these are the defaults ALEXABRIDGE_ADD, AlexaItems, light1 # same as the line above @@ -241,9 +241,7 @@ IO::Compress::Gzip Time::HiRes Net::Address::Ethernet Storable -Socket IO::Socket::INET -IO::Socket::Multicast =over @@ -253,11 +251,7 @@ package AlexaBridge; @AlexaBridge::ISA = ('Generic_Item'); -use Carp; use IO::Socket::INET; -use Socket; -use IO::Socket::Multicast; - my ($LOCAL_IP, $LOCAL_MAC) = &DiscoverAddy unless ( (defined($::config_parms{'alexaMac'})) && (defined($::config_parms{'alexaHttpIp'})) ); $LOCAL_IP = $::config_parms{'alexaHttpIp'} if defined($::config_parms{'alexaHttpIp'}); @@ -301,8 +295,8 @@ sub open_port { || &main::print_log( "\nError: Could not start a udp alexa multicast notification sender on $notificationPort: $@\n\n" ) && return; setsockopt($ssdpNotificationSocket, - getprotobyname('ip'), - IP_MULTICAST_TTL, + getprotobyname('ip') || 0, + _constant('IP_MULTICAST_TTL'), pack 'I', 4); $::Socket_Ports{$ssdpNotificationName}{protocol} = 'udp'; $::Socket_Ports{$ssdpNotificationName}{datatype} = 'raw'; @@ -317,12 +311,18 @@ sub open_port { my $ssdpListenName = 'alexaSsdpListen'; - my $ssdpListenSocket = new IO::Socket::Multicast->new( - LocalPort => $SSDP_PORT, - Proto => 'udp', - Reuse => 1) - || &main::print_log( "\nError: Could not start a udp alexa multicast listen server on ". $SSDP_PORT .$@ ."\n\n" ) && return; - $ssdpListenSocket->mcast_add('239.255.255.250'); + my $ssdpListenSocket = new IO::Socket::INET->new( + LocalPort => $SSDP_PORT, + Proto => 'udp', + Reuse => 1) + || &main::print_log( "\nError: Could not start a udp alexa multicast listen server on ". $SSDP_PORT .$@ ."\n\n" ) && return; + + _mcast_add( $ssdpListenSocket, '239.255.255.250' ); + setsockopt($ssdpListenSocket, + getprotobyname('ip') || 0, + _constant('IP_MULTICAST_TTL'), + pack 'I', 4); + $::Socket_Ports{$ssdpListenName}{protocol} = 'udp'; $::Socket_Ports{$ssdpListenName}{datatype} = 'raw'; $::Socket_Ports{$ssdpListenName}{port} = $SSDP_PORT; @@ -355,6 +355,39 @@ sub http_ports { printf " - creating %-15s on %3s %5s %s\n", $AlexaHttpName, 'tcp', $AlexaHttpPort; } +sub _constant { + my $name = shift; + my %names = ( + IP_MULTICAST_TTL => 0, + IP_ADD_MEMBERSHIP => 1, + IP_MULTICAST_LOOP => 0, + ); + + my %constants = ( + MSWin32 => [10,12], + cygwin => [3,5], + darwin => [10,12], + linux => [33,35], + default => [33,35], + ); + + my $index = $names{$name}; + my $ref = $constants{ $^O } || $constants{default}; + return $ref->[ $index ]; +} + +sub _mcast_add { + my ( $sock, $addr ) = @_; + my $ip_mreq = inet_aton( $addr ) . INADDR_ANY; + + setsockopt( + $sock, + getprotobyname('ip') || 0, + _constant('IP_ADD_MEMBERSHIP'), + $ip_mreq + ) || warn "Unable to add IGMP membership: $!\n"; +} + sub check_for_data { my $alexa_http_sender = $AlexaGlobal->{http_sender}->{'alexa_http_sender'}; my $alexa_ssdp_listen = $AlexaGlobal->{ssdp_listen}; @@ -370,8 +403,9 @@ sub check_for_data { my $client_port = $alexa_listen->peer; $client_port =~ s/.*\://; $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}->{time} = time; + #push (@{ $AlexaGlobal->{http_client_queue} }, $client_ip_address.":".$client_port); # Put the request in queue so the response is sent in order $alexa_http_sender->start unless $alexa_http_sender->active; - $alexa_http_sender->set($alexa_data); + $alexa_http_sender->set($alexa_data); # Send data from client on our proxy port to MH http server } &_sendHttpData($alexa_listen, $alexa_http_sender); @@ -397,11 +431,31 @@ sub _sendHttpData { $client_ip_address =~ s/:.*//; my $client_port = $alexa_listen->peer; $client_port =~ s/.*\://; - delete $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port} if $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}; - $alexa_listen->set($alexa_sender_data); + $alexa_listen->set($alexa_sender_data); # Send data from the MH http server to the client on the proxy port } } + + +sub _sendHttpData_test { +my ($alexa_listen, $alexa_http_sender, $AlexaHttpName) = @_; + if ( $alexa_http_sender && ( my $alexa_sender_data = said $alexa_http_sender ) ) { + my $current_client_ip = @{ $AlexaGlobal->{http_client_queue} }[0]; + $current_client_ip =~ s/:.*//; + my $current_client_port = @{ $AlexaGlobal->{http_client_queue} }[0]; + $current_client_port =~ s/.*\://; + for my $ptr ( @{ $::Socket_Ports{$AlexaHttpName}{clients} } ) { + my ( $socka, $client_ip_address, $client_port, $data ) = @{$ptr}; + if ( ($client_ip_address eq $current_client_ip) && ($client_port eq $current_client_port)) { + &main::print_log( "[Alexa] Debug: Peer: $client_ip_address:$client_port Data OUT - $alexa_sender_data" ) if $main::Debug{'alexa'} >= 5; + delete $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port} if $AlexaGlobal->{http_client}->{$client_ip_address}->{$client_port}; + print $socka $alexa_sender_data; + splice(@{ $AlexaGlobal->{http_client_queue} }, 0, 1); # Delete served queue item (first item in the array) + } + } + } + +} sub _receiveSSDPEvent { my ( $buf, $peer ) = @_; From d55412ae3ef41e01b911e10f0e0598527b49129f Mon Sep 17 00:00:00 2001 From: waynieack Date: Mon, 20 Feb 2017 11:51:59 -0600 Subject: [PATCH 25/27] Added lib/site/Net/Address/Ethernet.pm --- lib/site/Net/Address/Ethernet.pm | 428 +++++++++++++++++++++++++++++++ 1 file changed, 428 insertions(+) create mode 100644 lib/site/Net/Address/Ethernet.pm diff --git a/lib/site/Net/Address/Ethernet.pm b/lib/site/Net/Address/Ethernet.pm new file mode 100644 index 000000000..d39d8b5e1 --- /dev/null +++ b/lib/site/Net/Address/Ethernet.pm @@ -0,0 +1,428 @@ + +package Net::Address::Ethernet; + +use warnings; +use strict; + +=head1 NAME + +Net::Address::Ethernet - find hardware ethernet address + +=head1 SYNOPSIS + + use Net::Address::Ethernet qw( get_address ); + my $sAddress = get_address; + +=head1 FUNCTIONS + +The following functions will be exported to your namespace if you request :all like so: + + use Net::Address::Ethernet qw( :all ); + +=over + +=cut + +use Carp; +use Data::Dumper; # for debugging only +use Exporter; +use Net::Domain; +use Net::Ifconfig::Wrapper qw( Ifconfig ); +use Regexp::Common; +use Sys::Hostname; + +use constant DEBUG_MATCH => 0; + +use vars qw( $DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS ); +use base 'Exporter'; + +$VERSION = 1.124; + +$DEBUG = 0 || $ENV{N_A_E_DEBUG}; + +%EXPORT_TAGS = ( 'all' => [ qw( get_address get_addresses canonical is_address ), ], ); +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +my @ahInfo; + +=item get_address + +Returns the 6-byte ethernet address in canonical form. +For example, '1A:2B:3C:4D:5E:6F'. + +When called in array context, returns a 6-element list representing +the 6 bytes of the address in decimal. For example, +(26,43,60,77,94,111). + +If any non-zero argument is given, +debugging information will be printed to STDERR. + +=cut + +sub get_address + { + if (0) + { + # If you know the name of the adapter, you can use this code to + # get its IP address: + use Socket qw/PF_INET SOCK_DGRAM inet_ntoa sockaddr_in/; + if (! socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('ip'))) + { + warn " WWW socket() failed\n"; + goto IFCONFIG_VERSION; + } # if + # use ioctl() interface with SIOCGIFADDR. + my $ifreq = pack('a32', 'enp1s0'); + if (! ioctl(SOCKET, 0x8915, $ifreq)) + { + warn " WWW ioctl failed\n"; + goto IFCONFIG_VERSION; + } # if + # Format the IP address from the output of ioctl(). + my $s = inet_ntoa((sockaddr_in((unpack('a16 a16', $ifreq))[1]))[1]); + if (! $s) + { + warn " WWW inet_ntoa failed\n"; + goto IFCONFIG_VERSION; + } # if + use Data::Dumper; + warn Dumper($s); exit 88; # for debugging + } # if 0 + IFCONFIG_VERSION: + my @a = get_addresses(@_); + _debug(" DDD in get_address, a is ", Dumper(\@a)); + # Even if none are active, we'll return the first one: + my $sAddr = $a[0]->{sEthernet}; + # Look through the list, returning the first active one that has a + # non-loopback IP address assigned to it: + TRY_ADDR: + foreach my $rh (@a) + { + my $sName = $rh->{sAdapter}; + _debug(" DDD inspecting interface $sName...\n"); + if (! $rh->{iActive}) + { + _debug(" DDD but it is not active.\n"); + next TRY_ADDR; + } # if + _debug(" DDD it is active...\n"); + if (! exists $rh->{sIP}) + { + _debug(" DDD but it has no IP address.\n"); + next TRY_ADDR; + } # if + if (! defined $rh->{sIP}) + { + _debug(" DDD but its IP address is undefined.\n"); + next TRY_ADDR; + } # if + if ($rh->{sIP} eq '') + { + _debug(" DDD but its IP address is empty.\n"); + next TRY_ADDR; + } # if + if ($rh->{sIP} =~ /127\.0\.0\.1/) + { + _debug(" DDD but it's the loopback.\n"); + next TRY_ADDR; + } # if + if (! exists $rh->{sEthernet}) + { + _debug(" DDD but it has no ethernet address.\n"); + next TRY_ADDR; + } # if + if (! defined $rh->{sEthernet}) + { + _debug(" DDD but its ethernet address is undefined.\n"); + next TRY_ADDR; + } # if + if ($rh->{sEthernet} eq q{}) + { + _debug(" DDD but its ethernet address is empty.\n"); + next TRY_ADDR; + } # if + $sAddr = $rh->{sEthernet}; + _debug(" DDD and its ethernet address is $sAddr.\n"); + last TRY_ADDR; + } # foreach TRY_ADDR + return wantarray ? map { hex } split(/[-:]/, $sAddr) : $sAddr; + } # get_address + + +=item get_addresses + +Returns an array of hashrefs. +Each hashref describes one Ethernet adapter found in the current hardware configuration, +with the following entries filled in to the best of our ability to determine: + +=over + +=item sEthernet -- The MAC address in canonical form. + +=item rasIP -- A reference to an array of all the IP addresses on this adapter. + +=item sIP -- The "first" IP address on this adapter. + +=item sAdapter -- The name of this adapter. + +=item iActive -- Whether this adapter is active. + +=back + +For example: + + { + 'sAdapter' => 'Ethernet adapter Local Area Connection', + 'sEthernet' => '12:34:56:78:9A:BC', + 'rasIP' => ['111.222.33.44',], + 'sIP' => '111.222.33.44', + 'iActive' => 1, + }, + +If any non-zero argument is given, +debugging information will be printed to STDERR. + +=cut + +sub get_addresses + { + $DEBUG ||= shift; + # Short-circuit if this function has already been called: + if (! $DEBUG && @ahInfo) + { + goto ALL_DONE; + } # if + my $sAddr = undef; + my $rh = Ifconfig('list', '', '', ''); + if (! defined $rh || (! scalar keys %$rh)) + { + warn " EEE Ifconfig failed: $@"; + } # if + _debug(" DDD raw output from Ifconfig is ", Dumper($rh)); + # Convert their hashref to our array format: + foreach my $key (keys %$rh) + { + my %hash; + _debug(" DDD working on key $key...\n"); + my $sAdapter = $key; + if ($key =~ m!\A\{.+}\z!) + { + $sAdapter = $rh->{$key}->{descr}; + } # if + $hash{sAdapter} = $sAdapter; + my @asIP = keys %{$rh->{$key}->{inet}}; + # Thanks to Sergey Kotenko for the array idea: + $hash{rasIP} = \@asIP; + $hash{sIP} = $asIP[0]; + my $sEther = $rh->{$key}->{ether} || ''; + if ($sEther eq '') + { + $sEther = _find_mac($sAdapter, $hash{sIP}); + } # if + $hash{sEthernet} = canonical($sEther); + $hash{iActive} = 0; + if (defined $rh->{$key}->{status} && ($rh->{$key}->{status} =~ m!\A(1|UP)\z!i)) + { + $hash{iActive} = 1; + } # if + push @ahInfo, \%hash; + } # foreach + ALL_DONE: + return @ahInfo; + } # get_addresses + + +# Attempt other ways of finding the MAC Address: +sub _find_mac + { + my $sAdapter = shift || return; + my $sIP = shift || ''; + # No hope on some OSes: + return if ($^O eq 'MSWIn32'); + my @asARP = qw( /usr/sbin/arp /sbin/arp /bin/arp /usr/bin/arp ); + my $sHostname = hostname || Net::Domain::hostname || ''; + my $sHostfqdn = Net::Domain::hostfqdn || ''; + my @asHost = ($sHostname, $sHostfqdn, ''); + ARP: + foreach my $sARP (@asARP) + { + next ARP if ! -x $sARP; + HOSTNAME: + foreach my $sHost (@asHost) + { + $sHost ||= q{}; + next HOSTNAME if ($sHost eq q{}); + my $sCmd = qq{$sARP $sHost}; + # print STDERR " DDD trying ==$sCmd==\n"; + my @as = qx{$sCmd}; + LINE_OF_CMD: + while (@as) + { + my $sLine = shift @as; + DEBUG_MATCH && print STDERR " DDD output line of cmd ==$sLine==\n"; + if ($sLine =~ m!\(($RE{net}{IPv4})\)\s+AT\s+($RE{net}{MAC})\b!i) + { + # Looks like arp on Solaris. + my ($sIPFound, $sEtherFound) = ($1, $2); + # print STDERR " DDD found IP =$sIPFound=, found ether =$sEtherFound=\n"; + return $sEtherFound if ($sIPFound eq $sIP); + # print STDERR " DDD does NOT match the one I wanted =$sIP=\n"; + } # if + if ($sLine =~ m!($RE{net}{IPv4})\s+ETHER\s+($RE{net}{MAC})\b!i) + { + # Looks like arp on Solaris. + return $2 if ($1 eq $sIP); + } # if + } # while LINE_OF_CMD + } # foreach HOSTNAME + } # foreach ARP + } # _find_mac + +=item is_address + +Returns a true value if its argument looks like an ethernet address. + +=cut + +sub is_address + { + my $s = uc(shift || ''); + # Convert all non-hex digits to colon: + $s =~ s![^0-9A-F]+!:!g; + return ($s =~ m!\A$RE{net}{MAC}\Z!i); + } # is_address + + +=item canonical + +Given a 6-byte ethernet address, converts it to canonical form. +Canonical form is 2-digit uppercase hexadecimal numbers with colon +between the bytes. The address to be converted can have any kind of +punctuation between the bytes, the bytes can be 1-digit, and the bytes +can be lowercase; but the bytes must already be hex. + +=cut + +sub canonical + { + my $s = shift; + return '' if ! is_address($s); + # Convert all non-hex digits to colon: + $s =~ s![^0-9a-fA-F]+!:!g; + my @as = split(':', $s); + # Cobble together 2-digit hex bytes: + $s = ''; + map { $s .= length() < 2 ? "0$_" : $_; $s .= ':' } @as; + chop $s; + return uc $s; + } # canonical + +sub _debug + { + return if ! $DEBUG; + print STDERR @_; + } # _debug + +=back + +=head1 NOTES + +=head1 SEE ALSO + +arp, ifconfig, ipconfig + +=head1 BUGS + +Please tell the author if you find any! And please show me the output +of `arp ` +or `ifconfig` +or `ifconfig -a` +from your system. + +=head1 AUTHOR + +Martin 'Kingpin' Thurn, C, L. + +=head1 LICENSE + +This software is released under the same license as Perl itself. + +=cut + +1; + +__END__ + +=pod + +#### This is an example of @ahInfo on MSWin32: +( + { + 'sAdapter' => 'Ethernet adapter Local Area Connection', + 'sEthernet' => '00-0C-F1-EE-F0-39', + 'sIP' => '16.25.10.14', + 'iActive' => 1, + }, + { + 'sAdapter' => 'Ethernet adapter Wireless Network Connection', + 'sEthernet' => '00-33-BD-F3-33-E3', + 'sIP' => '19.16.20.12', + 'iActive' => 1, + }, + { + 'sAdapter' => '{gobbledy-gook}', + 'sDesc' => 'PPP adapter Verizon Online', + 'sEthernet' => '00-53-45-00-00-00', + 'sIP' => '71.24.23.85', + 'iActive' => 1, + }, +) + +#### This is Solaris 8: + +> /usr/sbin/arp myhost +myhost (14.81.16.10) at 03:33:ba:46:f2:ef permanent published + +#### This is Solaris 8: + +> /usr/sbin/ifconfig -a +lo0: flags=1000849 mtu 8232 index 1 + inet 127.0.0.1 netmask ff000000 +bge0: flags=1000843 mtu 1500 index 2 + inet 14.81.16.10 netmask ffffff00 broadcast 14.81.16.255 + +#### This is Fedora Core 6: + +$ /sbin/arp +Address HWtype HWaddress Flags Mask Iface +19.16.11.11 ether 03:53:53:e3:43:93 C eth0 + +#### This is amd64-freebsd: + +$ ifconfig +fwe0: flags=108802 mtu 1500 + options=8 + ether 02:31:38:31:35:35 + ch 1 dma -1 +vr0: flags=8843 mtu 1500 + inet6 fe8d::2500:bafd:fecd:cdcd%vr0 prefixlen 64 scopeid 0x2 + inet 19.16.12.52 netmask 0xffffff00 broadcast 19.16.12.255 + ether 00:53:b3:c3:3d:39 + media: Ethernet autoselect (100baseTX ) + status: active +nfe0: flags=8843 mtu 1500 + options=8 + inet6 fe8e::21e:31ef:fee1:26eb%nfe0 prefixlen 64 scopeid 0x3 + ether 00:13:33:53:23:13 + media: Ethernet autoselect (100baseTX ) + status: active +plip0: flags=108810 mtu 1500 +lo0: flags=8049 mtu 16384 + inet6 ::1 prefixlen 128 + inet6 fe80::1%lo0 prefixlen 64 scopeid 0x5 + inet 127.0.0.1 netmask 0xff000000 + inet 127.0.0.2 netmask 0xffffffff + inet 127.0.0.3 netmask 0xffffffff +tun0: flags=8051 mtu 1492 + inet 83.173.73.3 --> 233.131.83.3 netmask 0xffffffff + Opened by PID 268 From 837b68cfded63a2e1b58c9cf4b1f0d3a93b910c0 Mon Sep 17 00:00:00 2001 From: waynieack Date: Mon, 20 Feb 2017 12:16:25 -0600 Subject: [PATCH 26/27] Eval check for Net::Address::Ethernet as its only used for discovering the local IP and can be manually defined in the ini. --- lib/AlexaBridge.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/AlexaBridge.pm b/lib/AlexaBridge.pm index 5a4893aac..2e0012b25 100644 --- a/lib/AlexaBridge.pm +++ b/lib/AlexaBridge.pm @@ -906,7 +906,11 @@ sub _GetChunk { sub DiscoverAddy { - use Net::Address::Ethernet qw( :all ); + eval "use Net::Address::Ethernet qw( :all )"; + if ($@) { + print "\n [Alexa] Error: Net::Address::Ethernet is not installed... Please install it or define the local IP and mac in alexaHttpIp/alexaMac\n\n"; + return ('127.0.0.1','9aa645cc40aa'); # return localhost as we dont know the real address + } my @a = get_addresses(@_); foreach my $adapter (@a) { next unless ($adapter->{iActive} eq 1); From 5529f2b110f1541edde2b03d32d755a125d7d1f5 Mon Sep 17 00:00:00 2001 From: waynieack Date: Mon, 20 Feb 2017 12:17:46 -0600 Subject: [PATCH 27/27] Removed lib/site/Net/Address/Ethernet.pm --- lib/site/Net/Address/Ethernet.pm | 428 ------------------------------- 1 file changed, 428 deletions(-) delete mode 100644 lib/site/Net/Address/Ethernet.pm diff --git a/lib/site/Net/Address/Ethernet.pm b/lib/site/Net/Address/Ethernet.pm deleted file mode 100644 index d39d8b5e1..000000000 --- a/lib/site/Net/Address/Ethernet.pm +++ /dev/null @@ -1,428 +0,0 @@ - -package Net::Address::Ethernet; - -use warnings; -use strict; - -=head1 NAME - -Net::Address::Ethernet - find hardware ethernet address - -=head1 SYNOPSIS - - use Net::Address::Ethernet qw( get_address ); - my $sAddress = get_address; - -=head1 FUNCTIONS - -The following functions will be exported to your namespace if you request :all like so: - - use Net::Address::Ethernet qw( :all ); - -=over - -=cut - -use Carp; -use Data::Dumper; # for debugging only -use Exporter; -use Net::Domain; -use Net::Ifconfig::Wrapper qw( Ifconfig ); -use Regexp::Common; -use Sys::Hostname; - -use constant DEBUG_MATCH => 0; - -use vars qw( $DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS ); -use base 'Exporter'; - -$VERSION = 1.124; - -$DEBUG = 0 || $ENV{N_A_E_DEBUG}; - -%EXPORT_TAGS = ( 'all' => [ qw( get_address get_addresses canonical is_address ), ], ); -@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); - -my @ahInfo; - -=item get_address - -Returns the 6-byte ethernet address in canonical form. -For example, '1A:2B:3C:4D:5E:6F'. - -When called in array context, returns a 6-element list representing -the 6 bytes of the address in decimal. For example, -(26,43,60,77,94,111). - -If any non-zero argument is given, -debugging information will be printed to STDERR. - -=cut - -sub get_address - { - if (0) - { - # If you know the name of the adapter, you can use this code to - # get its IP address: - use Socket qw/PF_INET SOCK_DGRAM inet_ntoa sockaddr_in/; - if (! socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('ip'))) - { - warn " WWW socket() failed\n"; - goto IFCONFIG_VERSION; - } # if - # use ioctl() interface with SIOCGIFADDR. - my $ifreq = pack('a32', 'enp1s0'); - if (! ioctl(SOCKET, 0x8915, $ifreq)) - { - warn " WWW ioctl failed\n"; - goto IFCONFIG_VERSION; - } # if - # Format the IP address from the output of ioctl(). - my $s = inet_ntoa((sockaddr_in((unpack('a16 a16', $ifreq))[1]))[1]); - if (! $s) - { - warn " WWW inet_ntoa failed\n"; - goto IFCONFIG_VERSION; - } # if - use Data::Dumper; - warn Dumper($s); exit 88; # for debugging - } # if 0 - IFCONFIG_VERSION: - my @a = get_addresses(@_); - _debug(" DDD in get_address, a is ", Dumper(\@a)); - # Even if none are active, we'll return the first one: - my $sAddr = $a[0]->{sEthernet}; - # Look through the list, returning the first active one that has a - # non-loopback IP address assigned to it: - TRY_ADDR: - foreach my $rh (@a) - { - my $sName = $rh->{sAdapter}; - _debug(" DDD inspecting interface $sName...\n"); - if (! $rh->{iActive}) - { - _debug(" DDD but it is not active.\n"); - next TRY_ADDR; - } # if - _debug(" DDD it is active...\n"); - if (! exists $rh->{sIP}) - { - _debug(" DDD but it has no IP address.\n"); - next TRY_ADDR; - } # if - if (! defined $rh->{sIP}) - { - _debug(" DDD but its IP address is undefined.\n"); - next TRY_ADDR; - } # if - if ($rh->{sIP} eq '') - { - _debug(" DDD but its IP address is empty.\n"); - next TRY_ADDR; - } # if - if ($rh->{sIP} =~ /127\.0\.0\.1/) - { - _debug(" DDD but it's the loopback.\n"); - next TRY_ADDR; - } # if - if (! exists $rh->{sEthernet}) - { - _debug(" DDD but it has no ethernet address.\n"); - next TRY_ADDR; - } # if - if (! defined $rh->{sEthernet}) - { - _debug(" DDD but its ethernet address is undefined.\n"); - next TRY_ADDR; - } # if - if ($rh->{sEthernet} eq q{}) - { - _debug(" DDD but its ethernet address is empty.\n"); - next TRY_ADDR; - } # if - $sAddr = $rh->{sEthernet}; - _debug(" DDD and its ethernet address is $sAddr.\n"); - last TRY_ADDR; - } # foreach TRY_ADDR - return wantarray ? map { hex } split(/[-:]/, $sAddr) : $sAddr; - } # get_address - - -=item get_addresses - -Returns an array of hashrefs. -Each hashref describes one Ethernet adapter found in the current hardware configuration, -with the following entries filled in to the best of our ability to determine: - -=over - -=item sEthernet -- The MAC address in canonical form. - -=item rasIP -- A reference to an array of all the IP addresses on this adapter. - -=item sIP -- The "first" IP address on this adapter. - -=item sAdapter -- The name of this adapter. - -=item iActive -- Whether this adapter is active. - -=back - -For example: - - { - 'sAdapter' => 'Ethernet adapter Local Area Connection', - 'sEthernet' => '12:34:56:78:9A:BC', - 'rasIP' => ['111.222.33.44',], - 'sIP' => '111.222.33.44', - 'iActive' => 1, - }, - -If any non-zero argument is given, -debugging information will be printed to STDERR. - -=cut - -sub get_addresses - { - $DEBUG ||= shift; - # Short-circuit if this function has already been called: - if (! $DEBUG && @ahInfo) - { - goto ALL_DONE; - } # if - my $sAddr = undef; - my $rh = Ifconfig('list', '', '', ''); - if (! defined $rh || (! scalar keys %$rh)) - { - warn " EEE Ifconfig failed: $@"; - } # if - _debug(" DDD raw output from Ifconfig is ", Dumper($rh)); - # Convert their hashref to our array format: - foreach my $key (keys %$rh) - { - my %hash; - _debug(" DDD working on key $key...\n"); - my $sAdapter = $key; - if ($key =~ m!\A\{.+}\z!) - { - $sAdapter = $rh->{$key}->{descr}; - } # if - $hash{sAdapter} = $sAdapter; - my @asIP = keys %{$rh->{$key}->{inet}}; - # Thanks to Sergey Kotenko for the array idea: - $hash{rasIP} = \@asIP; - $hash{sIP} = $asIP[0]; - my $sEther = $rh->{$key}->{ether} || ''; - if ($sEther eq '') - { - $sEther = _find_mac($sAdapter, $hash{sIP}); - } # if - $hash{sEthernet} = canonical($sEther); - $hash{iActive} = 0; - if (defined $rh->{$key}->{status} && ($rh->{$key}->{status} =~ m!\A(1|UP)\z!i)) - { - $hash{iActive} = 1; - } # if - push @ahInfo, \%hash; - } # foreach - ALL_DONE: - return @ahInfo; - } # get_addresses - - -# Attempt other ways of finding the MAC Address: -sub _find_mac - { - my $sAdapter = shift || return; - my $sIP = shift || ''; - # No hope on some OSes: - return if ($^O eq 'MSWIn32'); - my @asARP = qw( /usr/sbin/arp /sbin/arp /bin/arp /usr/bin/arp ); - my $sHostname = hostname || Net::Domain::hostname || ''; - my $sHostfqdn = Net::Domain::hostfqdn || ''; - my @asHost = ($sHostname, $sHostfqdn, ''); - ARP: - foreach my $sARP (@asARP) - { - next ARP if ! -x $sARP; - HOSTNAME: - foreach my $sHost (@asHost) - { - $sHost ||= q{}; - next HOSTNAME if ($sHost eq q{}); - my $sCmd = qq{$sARP $sHost}; - # print STDERR " DDD trying ==$sCmd==\n"; - my @as = qx{$sCmd}; - LINE_OF_CMD: - while (@as) - { - my $sLine = shift @as; - DEBUG_MATCH && print STDERR " DDD output line of cmd ==$sLine==\n"; - if ($sLine =~ m!\(($RE{net}{IPv4})\)\s+AT\s+($RE{net}{MAC})\b!i) - { - # Looks like arp on Solaris. - my ($sIPFound, $sEtherFound) = ($1, $2); - # print STDERR " DDD found IP =$sIPFound=, found ether =$sEtherFound=\n"; - return $sEtherFound if ($sIPFound eq $sIP); - # print STDERR " DDD does NOT match the one I wanted =$sIP=\n"; - } # if - if ($sLine =~ m!($RE{net}{IPv4})\s+ETHER\s+($RE{net}{MAC})\b!i) - { - # Looks like arp on Solaris. - return $2 if ($1 eq $sIP); - } # if - } # while LINE_OF_CMD - } # foreach HOSTNAME - } # foreach ARP - } # _find_mac - -=item is_address - -Returns a true value if its argument looks like an ethernet address. - -=cut - -sub is_address - { - my $s = uc(shift || ''); - # Convert all non-hex digits to colon: - $s =~ s![^0-9A-F]+!:!g; - return ($s =~ m!\A$RE{net}{MAC}\Z!i); - } # is_address - - -=item canonical - -Given a 6-byte ethernet address, converts it to canonical form. -Canonical form is 2-digit uppercase hexadecimal numbers with colon -between the bytes. The address to be converted can have any kind of -punctuation between the bytes, the bytes can be 1-digit, and the bytes -can be lowercase; but the bytes must already be hex. - -=cut - -sub canonical - { - my $s = shift; - return '' if ! is_address($s); - # Convert all non-hex digits to colon: - $s =~ s![^0-9a-fA-F]+!:!g; - my @as = split(':', $s); - # Cobble together 2-digit hex bytes: - $s = ''; - map { $s .= length() < 2 ? "0$_" : $_; $s .= ':' } @as; - chop $s; - return uc $s; - } # canonical - -sub _debug - { - return if ! $DEBUG; - print STDERR @_; - } # _debug - -=back - -=head1 NOTES - -=head1 SEE ALSO - -arp, ifconfig, ipconfig - -=head1 BUGS - -Please tell the author if you find any! And please show me the output -of `arp ` -or `ifconfig` -or `ifconfig -a` -from your system. - -=head1 AUTHOR - -Martin 'Kingpin' Thurn, C, L. - -=head1 LICENSE - -This software is released under the same license as Perl itself. - -=cut - -1; - -__END__ - -=pod - -#### This is an example of @ahInfo on MSWin32: -( - { - 'sAdapter' => 'Ethernet adapter Local Area Connection', - 'sEthernet' => '00-0C-F1-EE-F0-39', - 'sIP' => '16.25.10.14', - 'iActive' => 1, - }, - { - 'sAdapter' => 'Ethernet adapter Wireless Network Connection', - 'sEthernet' => '00-33-BD-F3-33-E3', - 'sIP' => '19.16.20.12', - 'iActive' => 1, - }, - { - 'sAdapter' => '{gobbledy-gook}', - 'sDesc' => 'PPP adapter Verizon Online', - 'sEthernet' => '00-53-45-00-00-00', - 'sIP' => '71.24.23.85', - 'iActive' => 1, - }, -) - -#### This is Solaris 8: - -> /usr/sbin/arp myhost -myhost (14.81.16.10) at 03:33:ba:46:f2:ef permanent published - -#### This is Solaris 8: - -> /usr/sbin/ifconfig -a -lo0: flags=1000849 mtu 8232 index 1 - inet 127.0.0.1 netmask ff000000 -bge0: flags=1000843 mtu 1500 index 2 - inet 14.81.16.10 netmask ffffff00 broadcast 14.81.16.255 - -#### This is Fedora Core 6: - -$ /sbin/arp -Address HWtype HWaddress Flags Mask Iface -19.16.11.11 ether 03:53:53:e3:43:93 C eth0 - -#### This is amd64-freebsd: - -$ ifconfig -fwe0: flags=108802 mtu 1500 - options=8 - ether 02:31:38:31:35:35 - ch 1 dma -1 -vr0: flags=8843 mtu 1500 - inet6 fe8d::2500:bafd:fecd:cdcd%vr0 prefixlen 64 scopeid 0x2 - inet 19.16.12.52 netmask 0xffffff00 broadcast 19.16.12.255 - ether 00:53:b3:c3:3d:39 - media: Ethernet autoselect (100baseTX ) - status: active -nfe0: flags=8843 mtu 1500 - options=8 - inet6 fe8e::21e:31ef:fee1:26eb%nfe0 prefixlen 64 scopeid 0x3 - ether 00:13:33:53:23:13 - media: Ethernet autoselect (100baseTX ) - status: active -plip0: flags=108810 mtu 1500 -lo0: flags=8049 mtu 16384 - inet6 ::1 prefixlen 128 - inet6 fe80::1%lo0 prefixlen 64 scopeid 0x5 - inet 127.0.0.1 netmask 0xff000000 - inet 127.0.0.2 netmask 0xffffffff - inet 127.0.0.3 netmask 0xffffffff -tun0: flags=8051 mtu 1492 - inet 83.173.73.3 --> 233.131.83.3 netmask 0xffffffff - Opened by PID 268