SHARE
TWEET

s20.pl

vartik Oct 20th, 2015 (edited) 1,178 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl -w
  2. #
  3. # Based on
  4. #  http://forums.ninjablocks.com/index.php?
  5. #   p=/discussion/2931/aldi-remote-controlled-power-points-5-july-2014/p1
  6. #  and
  7. #   http://pastebin.ca/2818088
  8. #  and
  9. #   https://github.com/franc-carter/bauhn-wifi/blob/master/bauhn.pl
  10. #
  11. # Tuned for Orvibo S20 by Branislav Vartik
  12.  
  13. use strict;
  14. use IO::Socket;
  15. use IO::Select;
  16. use Data::Dumper;
  17. use Net::Ping;
  18.  
  19. my $debug = 1; # Change this to 0 to avoid debug messages
  20. my $port = 10000;
  21.  
  22. my $fbk_preamble = pack('C*', (0x68,0x64,0x00,0x1e,0x63,0x6c));
  23. my $ctl_preamble = pack('C*', (0x68,0x64,0x00,0x17,0x64,0x63));
  24. my $ctl_on       = pack('C*', (0x00,0x00,0x00,0x00,0x01));
  25. my $ctl_off      = pack('C*', (0x00,0x00,0x00,0x00,0x00));
  26. my $twenties     = pack('C*', (0x20,0x20,0x20,0x20,0x20,0x20));
  27. my $onoff        = pack('C*', (0x68,0x64,0x00,0x17,0x73,0x66));
  28. my $subscribed   = pack('C*', (0x68,0x64,0x00,0x18,0x63,0x6c));
  29.  
  30. sub findS20($)
  31. {
  32.  
  33.     my ($mac) = @_;
  34.  
  35.     my $s20;
  36.     my $reversed_mac = scalar(reverse($mac));
  37.     my $subscribe    = $fbk_preamble.$mac.$twenties.$reversed_mac.$twenties;
  38.  
  39.     my $socket = IO::Socket::INET->new(Proto=>'udp', LocalPort=>$port, Broadcast=>1) ||
  40.                      die "Could not create listen socket: $!\n";
  41.     $socket->autoflush();
  42.     my $select = IO::Select->new($socket) ||
  43.                      die "Could not create Select: $!\n";
  44.  
  45. #    my $to_addr = sockaddr_in($port, INADDR_BROADCAST);
  46.     my $iaddr = inet_aton($ARGV[0]) || die 'Unable to resolve';
  47.     my $to_addr = sockaddr_in($port, $iaddr);
  48.  
  49.  
  50.     $socket->send($subscribe, 0, $to_addr) ||
  51.         die "Send error: $!\n";
  52.  
  53.     my $n = 1;
  54.     while($n <= 3) {
  55.  
  56.     print "DEBUG: Waiting for status $n\n" if $debug;
  57.         my @ready = $select->can_read(1);
  58.         foreach my $fh (@ready) {
  59.             my $packet;
  60.             my $from = $socket->recv($packet,1024) || die "recv: $!";
  61.             if ((substr($packet,0,6) eq $subscribed) && (substr($packet,6,6) eq $mac)) {
  62.                 my ($port, $iaddr) = sockaddr_in($from);
  63.                 $s20->{mac}      = $mac;
  64.                 $s20->{saddr}    = $from;
  65.                 $s20->{socket}   = $socket;
  66.                 $s20->{on}       = (substr($packet,-1,1) eq chr(1));
  67.                 return $s20;
  68.             }
  69.         }
  70.         $n++;
  71.     }
  72.     close($socket);
  73.     return undef;
  74. }
  75.  
  76. sub controlS20($$)
  77. {
  78.     my ($s20,$action) = @_;
  79.  
  80.  
  81.    my $mac = $s20->{mac};
  82.  
  83.     if ($action eq "on") {
  84.         $action   = $ctl_preamble.$mac.$twenties.$ctl_on;
  85.     }
  86.     if ($action eq "off") {
  87.         $action   = $ctl_preamble.$mac.$twenties.$ctl_off;
  88.     }
  89.  
  90.     my $select = IO::Select->new($s20->{socket}) ||
  91.                      die "Could not create Select: $!\n";
  92.  
  93.     my $n = 0;
  94.     while($n < 2) {
  95.         $s20->{socket}->send($action, 0, $s20->{saddr}) ||
  96.             die "Send error: $!\n";
  97.  
  98.         my @ready = $select->can_read(0.5);
  99.         foreach my $fh (@ready) {
  100.             my $packet;
  101.             my $from = $s20->{socket}->recv($packet,1024) ||
  102.                            die "recv: $!";
  103.             my @data = unpack("C*", $packet);
  104.             my @packet_mac = @data[6..11];
  105.             if (($onoff eq substr($packet,0,6)) && ($mac eq substr($packet,6,6))) {
  106.                 return 1;
  107.             }
  108.         }
  109.         $n++;
  110.     }
  111.     return 0;
  112. }
  113.  
  114. my $usage = "Usage: $0 <IP> <XX:XX:XX:XX:XX:XX> <on|off|status>\n";
  115.  
  116. ($#ARGV > 1) || die $usage;
  117.  
  118. my @mac = split(':', $ARGV[1]);
  119. ($#mac == 5) || die $usage;
  120.  
  121. @mac = map { hex("0x".$_) } split(':', $ARGV[1]);
  122. my $mac = pack('C*', @mac);
  123.  
  124. my $n = 1;
  125. my $p = Net::Ping->new('icmp', 1);
  126. do {
  127.     print "DEBUG: Ping $n\n" if $debug;
  128.     ( $n == 120 ) && die "Could not ping S20 with IP of $ARGV[0]\n";
  129.     $n++;
  130. } until ($p->ping($ARGV[0]));
  131. $p->close();
  132.  
  133. my $s20 = findS20($mac);
  134. unless (defined($s20)) {
  135.     print "DEBUG: Sleeping for retry\n" if $debug;
  136.     sleep(1);
  137.     $s20 = findS20($mac);
  138.     defined($s20) || die "Could not find S20 with mac of $ARGV[1]\n";
  139.     }
  140. if ($ARGV[2] eq "status") {
  141.     print $s20->{on} ? "on\n" : "off\n";
  142.     exit(0);
  143. }
  144. ($ARGV[2] ne "on" && $ARGV[2] ne "off") && die $usage;
  145.  
  146. for(my $n=1; $n<=3; $n++) {
  147.     print "DEBUG: Waiting for confirmation $n\n" if $debug;
  148.     controlS20($s20, $ARGV[2]) && exit(0); # FIXME: Print DEBUG info
  149. }
  150. die "Could not change S20 to $ARGV[2]\n";
RAW Paste Data
Pastebin PRO Summer Special!
Get 40% OFF on Pastebin PRO accounts!
Top