vartik

s20.pl

Oct 20th, 2015
1,785
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

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×