fhem-mirror/fhem/contrib/00_ZWDongle.pm

##############################################
# $Id: 00_ZWDongle.pm 1721 2012-07-11 14:48:24Z rudolfkoenig $
# Handling a ZWave (USB) Dongle
package main;

use strict;
use warnings;
use Time::HiRes qw(gettimeofday);

sub ZWDongle_Parse($$$);
sub ZWDongle_Read($@);
sub ZWDongle_ReadAnswer($$$);
sub ZWDongle_Ready($);
sub ZWDongle_Write($$$);


# See also:
# http://www.digiwave.dk/en/programming/an-introduction-to-the-z-wave-protocol/
# http://open-zwave.googlecode.com/svn-history/r426/trunk/cpp/src/Driver.cpp
# http://buzzdavidson.com/?p=68
my %sets = (
  "learnMode" => "50%02x",     # ZW_SET_LEARN_MODE
  "sendData"  => "13%02x%s",   # ZW_SEND_DATA
  # 032001000500/032001FF0500 (off/on) 
);

my %gets = (
  "caps"      => "07",     # SERIAL_API_GET_CAPABILITIES
  "ctrlCaps"  => "05",     # ZW_GET_CONTROLLER_CAPS
  "devInfo"   => "41%02x", # ZW_GET_NODE_PROTOCOL_INFO
  "devList"   => "02",     # SERIAL_API_GET_INIT_DATA
  "homeId"    => "20",     # MEMORY_GET_ID
  "version"   => "15",     # ZW_GET_VERSION
);

# Known controller function. 
# Note: Known != implemented, see %sets & %gets for the implemented ones.
my %func_id= (
  '02'  => 'SERIAL_API_GET_INIT_DATA',
  '03'  => 'SERIAL_API_APPL_NODE_INFORMATION',
  '04'  => 'APPLICATION_COMMAND_HANDLER',
  '05'  => 'ZW_GET_CONTROLLER_CAPABILITIES',
  '06'  => 'SERIAL_API_SET_TIMEOUTS',
  '07'  => 'SERIAL_API_GET_CAPABILITIES',
  '08'  => 'SERIAL_API_SOFT_RESET',
  '10'  => 'ZW_SET_R_F_RECEIVE_MODE',
  '11'  => 'ZW_SET_SLEEP_MODE',
  '12'  => 'ZW_SEND_NODE_INFORMATION',
  '13'  => 'ZW_SEND_DATA',
  '14'  => 'ZW_SEND_DATA_MULTI',
  '15'  => 'ZW_GET_VERSION',
  '16'  => 'ZW_SEND_DATA_ABORT',
  '17'  => 'ZW_R_F_POWER_LEVEL_SET',
  '18'  => 'ZW_SEND_DATA_META',
  '20'  => 'MEMORY_GET_ID',
  '21'  => 'MEMORY_GET_BYTE',
  '22'  => 'MEMORY_PUT_BYTE',
  '23'  => 'MEMORY_GET_BUFFER',
  '24'  => 'MEMORY_PUT_BUFFER',
  '30'  => 'CLOCK_SET',
  '31'  => 'CLOCK_GET',
  '32'  => 'CLOCK_COMPARE',
  '33'  => 'RTC_TIMER_CREATE',
  '34'  => 'RTC_TIMER_READ',
  '35'  => 'RTC_TIMER_DELETE',
  '36'  => 'RTC_TIMER_CALL',
  '41'  => 'ZW_GET_NODE_PROTOCOL_INFO',
  '42'  => 'ZW_SET_DEFAULT',
  '44'  => 'ZW_REPLICATION_COMMAND_COMPLETE',
  '45'  => 'ZW_REPLICATION_SEND_DATA',
  '46'  => 'ZW_ASSIGN_RETURN_ROUTE',
  '47'  => 'ZW_DELETE_RETURN_ROUTE',
  '48'  => 'ZW_REQUEST_NODE_NEIGHBOR_UPDATE',
  '49'  => 'ZW_APPLICATION_UPDATE',
  '4a'  => 'ZW_ADD_NODE_TO_NETWORK',
  '4b'  => 'ZW_REMOVE_NODE_FROM_NETWORK',
  '4c'  => 'ZW_CREATE_NEW_PRIMARY',
  '4d'  => 'ZW_CONTROLLER_CHANGE',
  '50'  => 'ZW_SET_LEARN_MODE',
  '51'  => 'ZW_ASSIGN_SUC_RETURN_ROUTE',
  '52'  => 'ZW_ENABLE_SUC',
  '53'  => 'ZW_REQUEST_NETWORK_UPDATE',
  '54'  => 'ZW_SET_SUC_NODE_ID',
  '55'  => 'ZW_DELETE_SUC_RETURN_ROUTE',
  '56'  => 'ZW_GET_SUC_NODE_ID',
  '57'  => 'ZW_SEND_SUC_ID',
  '59'  => 'ZW_REDISCOVERY_NEEDED',
  '60'  => 'ZW_REQUEST_NODE_INFO',
  '61'  => 'ZW_REMOVE_FAILED_NODE_ID',
  '62'  => 'ZW_IS_FAILED_NODE',
  '63'  => 'ZW_REPLACE_FAILED_NODE',
  '70'  => 'TIMER_START',
  '71'  => 'TIMER_RESTART',
  '72'  => 'TIMER_CANCEL',
  '73'  => 'TIMER_CALL',
  '80'  => 'GET_ROUTING_TABLE_LINE',
  '81'  => 'GET_T_X_COUNTER',
  '82'  => 'RESET_T_X_COUNTER',
  '83'  => 'STORE_NODE_INFO',
  '84'  => 'STORE_HOME_ID',
  '90'  => 'LOCK_ROUTE_RESPONSE',
  '91'  => 'ZW_SEND_DATA_ROUTE_DEMO',
  '95'  => 'SERIAL_API_TEST',
  'a0'  => 'SERIAL_API_SLAVE_NODE_INFO',
  'a1'  => 'APPLICATION_SLAVE_COMMAND_HANDLER',
  'a2'  => 'ZW_SEND_SLAVE_NODE_INFO',
  'a3'  => 'ZW_SEND_SLAVE_DATA',
  'a4'  => 'ZW_SET_SLAVE_LEARN_MODE',
  'a5'  => 'ZW_GET_VIRTUAL_NODES',
  'a6'  => 'ZW_IS_VIRTUAL_NODE',
  'bb'  => 'ZW_GET_NEIGHBOR_COUNT',
  'bc'  => 'ZW_ARE_NODES_NEIGHBOURS',
  'bd'  => 'ZW_TYPE_LIBRARY',
  'd0'  => 'ZW_SET_PROMISCUOUS_MODE',
);


sub
ZWDongle_Initialize($)
{
  my ($hash) = @_;

  require "$attr{global}{modpath}/FHEM/DevIo.pm";

# Provider
  $hash->{ReadFn}  = "ZWDongle_Read";
  $hash->{WriteFn} = "ZWDongle_Write";
  $hash->{ReadyFn} = "ZWDongle_Ready";

# Normal devices
  $hash->{DefFn}   = "ZWDongle_Define";
  $hash->{SetFn}   = "ZWDongle_Set";
  $hash->{GetFn}   = "ZWDongle_Get";
  $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
                     "showtime:1,0 model:ZWDongle loglevel:0,1,2,3,4,5,6 ";
}

#####################################
sub
ZWDongle_Define($$)
{
  my ($hash, $def) = @_;
  my @a = split("[ \t][ \t]*", $def);

  if(@a != 3) {
    my $msg = "wrong syntax: define <name> ZWDongle {none | ".
                        "devicename[\@baudrate] | ".
                        "devicename\@directio | ".
                        "hostname:port}";
    return $msg;
  }

  DevIo_CloseDev($hash);

  my $name = $a[0];
  my $dev = $a[2];

  $hash->{Clients} = ":ZWave:";
  my %matchList = ( "1:ZWave" => "^........ ...*" );
  $hash->{MatchList} = \%matchList;

  if($dev eq "none") {
    Log 1, "$name device is none, commands will be echoed only";
    $attr{$name}{dummy} = 1;
    return undef;

  } elsif($dev !~ m/@/ && $dev !~ m/:/) {
    $def .= "\@115200";  # default baudrate

  }

  $hash->{DeviceName} = $dev;
  my $ret = DevIo_OpenDev($hash, 0, "ZWDongle_DoInit");
  return $ret;
}


#####################################
sub
ZWDongle_Set($@)
{
  my ($hash, @a) = @_;
  my $name = shift @a;

  return "\"set ZWDongle\" needs at least one parameter" if(@a < 1);
  my $type = shift @a;

  return "Unknown argument $type, choose one of " . join(" ", sort keys %sets)
  	if(!defined($sets{$type}));
  my $nargs = int(split("%", $sets{$type}, -1))-1;
  return "set $name $type needs $nargs arguments" if($nargs != int(@a));

  ZWDongle_Write($hash,  "00", sprintf($sets{$type}, @a));
  return undef;
}


#####################################
sub
ZWDongle_Get($@)
{
  my ($hash, @a) = @_;
  my $name = shift @a;

  return "\"get $name\" needs at least one parameter" if(@a < 1);
  my $type = shift @a;

  return "Unknown argument $type, choose one of " . join(" ", sort keys %gets)
  	if(!defined($gets{$type}));

  my $nargs = int(split("%", $gets{$type}, -1))-1;
  return "get $name $type needs $nargs arguments" if($nargs != int(@a));

  return "No $a[1] for dummies" if(IsDummy($name));

  ZWDongle_Write($hash,  "00", sprintf($gets{$type}, @a));
  my $re = "^01".substr($gets{$type},0,2);  # Start with <01><len><01><CMD>
  my $ret = ZWDongle_ReadAnswer($hash, "get $name $type", $re);

  my $msg="";
  $msg = $ret if($ret);
  my @r = map { ord($_) } split("", pack('H*', $ret)) if(defined($ret));

  if($type eq "devList") {                     ############################
    return "$name: Bogus data received" if(int(@r) != 36);
    my @list;
    for my $byte (0..28) {
      my $bits = $r[5+$byte];
      for my $bit (0..7) {
        push @list, $byte*8+$bit+1 if($bits & (1<<$bit));
      }
    }
    $msg = join(",", @list);

  } elsif($type eq "caps") {                    ############################
    $msg  = sprintf("Vers:%d Rev:%d ",       $r[2], $r[3]);
    $msg .= sprintf("ManufID:%02x%02x ",     $r[4], $r[5]);
    $msg .= sprintf("ProductType:%02x%02x ", $r[6], $r[7]);
    $msg .= sprintf("ProductID:%02x%02x",    $r[8], $r[9]);
    my @list;
    for my $byte (0..31) {
      my $bits = $r[10+$byte];
      for my $bit (0..7) {
        my $fn = $func_id{sprintf("%02x", $byte*8+$bit)};
        push @list, $fn if(($bits & (1<<$bit)) && $fn);
      }
    }
    $msg .= " ".join(",",@list);

  } elsif($type eq "homeId") {                  ############################
    $msg = sprintf("HomeId:%s CtrlNodeId:%s", 
                substr($ret,4,8), substr($ret,12,2));
    $hash->{HomeId} = substr($ret,4,8);

  } elsif($type eq "version") {                 ############################
    $msg = join("",  map { chr($_) } @r[2..13]);
    my @type = qw( STATIC_CONTROLLER CONTROLLER ENHANCED_SLAVE
                   SLAVE INSTALLER NO_INTELLIGENT_LIFE BRIDGE_CONTROLLER);
    my $idx = $r[14]-1;
    $msg .= " $type[$idx]" if($idx >= 0 && $idx <= $#type);

  } elsif($type eq "ctrlCaps") {                ############################
    my @type = qw(SECONDARY OTHER MEMBER PRIMARY SUC);
    my @list;
    for my $bit (0..7) {
      push @list, $type[$bit] if(($r[2] & (1<<$bit)) && $bit < @type);
    }
    $msg = join(" ", @list);

  } elsif($type eq "devInfo") {                 ############################
    my $id = sprintf("%02x", $r[6]);
    if($id eq "00") {
      $msg = "node $a[0] is not present";
    } else {
      my @list;
      my @type5 = qw( CONTROLLER STATIC_CONTROLLER SLAVE ROUTING_SLAVE);
      my %type6 = (
        '01' => 'GENERIC_CONTROLLER',    '12' => 'SWITCH_REMOTE',
        '02' => 'STATIC_CONTROLLER',     '13' => 'SWITCH_TOGGLE',
        '03' => 'AV_CONTROL_POINT',      '20' => 'SENSOR_BINARY',
        '06' => 'DISPLAY',               '21' => 'SENSOR_MULTILEVEL',
        '07' => 'GARAGE_DOOR',           '22' => 'WATER_CONTROL',
        '08' => 'THERMOSTAT',            '30' => 'METER_PULSE',
        '09' => 'WINDOW_COVERING',       '40' => 'ENTRY_CONTROL',
        '0F' => 'REPEATER_SLAVE',        '50' => 'SEMI_INTEROPERABLE',
        '10' => 'SWITCH_BINARY',         'ff' => 'NON_INTEROPERABLE',
        '11' => 'SWITCH_MULTILEVEL',
      );

      push @list, $type5[$r[5]-1] if($r[5]>0 && $r[5] <= @type5);
      push @list, $type6{$id} if($type6{$id});
      push @list, ($r[2] & 0x80) ? "listening" : "sleeping";
      push @list, "routing"   if($r[2] & 0x40);
      push @list, "40kBaud"   if(($r[2] & 0x38) == 0x10);
      push @list, "Vers:" . (($r[2]&0x7)+1);
      push @list, "Security:" . ($r[3]&0x1);
      $msg = join(" ", @list);
    }
  }

  $type .= "_".join("_", @a) if(@a);
  $hash->{READINGS}{$type}{VAL} = $msg;
  $hash->{READINGS}{$type}{TIME} = TimeNow();

  return "$name $type => $msg";
}

#####################################
sub
ZWDongle_Clear($)
{
  my $hash = shift;

  # Clear the pipe
  $hash->{RA_Timeout} = 0.3;
  for(;;) {
    my ($err, undef) = ZWDongle_ReadAnswer($hash, "Clear", undef);
    last if($err && $err =~ m/^Timeout/);
  }
  delete($hash->{RA_Timeout});
}

#####################################
sub
ZWDongle_DoInit($)
{
  my $hash = shift;
  my $name = $hash->{NAME};

  DevIo_SetHwHandshake($hash);
  ZWDongle_Clear($hash);
  ZWDongle_Get($hash, $name, "devList"); # Make the following query faster (?)
  ZWDongle_Get($hash, $name, "homeId");
  $hash->{PARTIAL} = "";
  $hash->{STATE} = "Initialized";
  return undef;
}

#####################################
sub
ZWDongle_CheckSum($)
{
  my ($data) = @_;
  my $cs = 0xff;
  map { $cs ^= ord($_) } split("", pack('H*', $data));
  return sprintf("%02x", $cs);
}


#####################################
sub
ZWDongle_Write($$$)
{
  my ($hash,$fn,$msg) = @_;

  $msg = "$fn$msg";
  $msg = sprintf("%02x%s", length($msg)/2+1, $msg);
  $msg = "01$msg" . ZWDongle_CheckSum($msg);
  DevIo_SimpleWrite($hash, $msg, 1);
}

#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
ZWDongle_Read($@)
{
  my ($hash, $local, $regexp) = @_;

  my $buf = (defined($local) ? $local : DevIo_SimpleRead($hash));
  return "" if(!defined($buf));

  my $name = $hash->{NAME};
  my $ll5 = GetLogLevel($name,5);

  $buf = unpack('H*', $buf);

  # The dongle looses data over USB(?), and dropping the old buffer after a
  # timeout is my only idea of solving this problem.
  my $ts   = gettimeofday();
  my $data = ($hash->{READ_TS} && $ts-$hash->{READ_TS} > 1) ?
                        "" : $hash->{PARTIAL};
  $hash->{READ_TS} = $ts;      # Flush old data.


  Log 5, "ZWDongle/RAW: $data/$buf";
  $data .= $buf;
  my $msg;

  while(length($data) > 0) {
    my $fb = substr($data, 0, 2);

    if($fb eq "06") {   # ACK
      $data = substr($data, 2);
      next;
    }
    if($fb eq "15") {   # NACK
      Log 1, "$name: NACK received";
      $data = substr($data, 2);
      next;
    }
    if($fb ne "01") {   # SOF
      Log 1, "$name: SOF missing (got $fb instead of 01)";
      last;
    }

    my $len = substr($data, 2, 2);
    my $l = hex($len)*2;
    last if(!$l || length($data) < $l+4);       # Message not yet complete

    $msg = substr($data, 4, $l-2);
    my $rcs  = substr($data, $l+2, 2);          # Received Checksum
    $data = substr($data, $l+4);

    my $ccs = ZWDongle_CheckSum("$len$msg");    # Computed Checksum
    if($rcs ne $ccs) {
      Log 1, "$name: wrong checksum: received $rcs, computed $ccs";
      next;
    }
    DevIo_SimpleWrite($hash, "06", 1);          # Send ACK
    Log $ll5, "ZWDongle_Read $name: $msg";
    last if(defined($local) && (!defined($regexp) || ($msg =~ m/$regexp/)));
    ZWDongle_Parse($hash, $name, $msg);
  }
  $hash->{PARTIAL} = $data;
  return $msg if(defined($local));
  return undef;
}

#####################################
# This is a direct read for commands like get
sub
ZWDongle_ReadAnswer($$$)
{
  my ($hash, $arg, $regexp) = @_;
  return ("No FD", undef)
        if(!$hash || ($^O !~ /Win/ && !defined($hash->{FD})));

  my $to = ($hash->{RA_Timeout} ? $hash->{RA_Timeout} : 3);

  for(;;) {

    my $buf;
    if($^O =~ m/Win/ && $hash->{USBDev}) {
      $hash->{USBDev}->read_const_time($to*1000); # set timeout (ms)
      # Read anstatt input sonst funzt read_const_time nicht.
      $buf = $hash->{USBDev}->read(999);
      return ("Timeout reading answer for get $arg", undef)
        if(length($buf) == 0);

    } else {
      return ("Device lost when reading answer for get $arg", undef)
        if(!$hash->{FD});
      my $rin = '';
      vec($rin, $hash->{FD}, 1) = 1;
      my $nfound = select($rin, undef, undef, $to);
      if($nfound < 0) {
        next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
        my $err = $!;
        DevIo_Disconnected($hash);
        return("ZWDongle_ReadAnswer $arg: $err", undef);
      }
      return ("Timeout reading answer for get $arg", undef)
        if($nfound == 0);
      $buf = DevIo_SimpleRead($hash);
      return ("No data", undef) if(!defined($buf));

    }

    my $ret = ZWDongle_Read($hash, $buf, $regexp);
    return $ret if(defined($ret));
  }

}

sub
ZWDongle_Parse($$$)
{
  my ($hash, $name, $rmsg) = @_;

  $hash->{"${name}_MSGCNT"}++;
  $hash->{"${name}_TIME"} = TimeNow();
  $hash->{RAWMSG} = $rmsg;

  my %addvals = (RAWMSG => $rmsg);
  my $homeId = $hash->{HomeId};
  if(!$homeId) {
    Log 1, "ERROR: $name HomeId is not set!" if(!$hash->{errReported});
    $hash->{errReported} = 1;
    return;
  }
  Dispatch($hash, "$homeId $rmsg", \%addvals);
}


#####################################
sub
ZWDongle_Ready($)
{
  my ($hash) = @_;

  return DevIo_OpenDev($hash, 1, "ZWDongle_DoInit")
                if($hash->{STATE} eq "disconnected");

  # This is relevant for windows/USB only
  my $po = $hash->{USBDev};
  my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
  return ($InBytes>0);
}

1;