mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 18:59:33 +00:00
KNXTUL: First Commit of KNXTUL for Communication with KNX Module
git-svn-id: https://svn.fhem.de/fhem/trunk@20852 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
jewuma
parent
36219591de
commit
7490d048a2
688
fhem/FHEM/00_KNXTUL.pm
Normal file
688
fhem/FHEM/00_KNXTUL.pm
Normal file
@ -0,0 +1,688 @@
|
|||||||
|
##############################################
|
||||||
|
#$Id$
|
||||||
|
#31.01.2019: Checked Message Format to prevent FHEM-Crash
|
||||||
|
#13.03.2019: Let only normal (no System-Messages) pass to prevent Creating Fake-Devices
|
||||||
|
|
||||||
|
package main;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Time::HiRes qw(gettimeofday);
|
||||||
|
use IO::Socket::INET;
|
||||||
|
|
||||||
|
my $KNXTUL_hasMulticast = 1;
|
||||||
|
|
||||||
|
sub KNXTUL_Attr(@);
|
||||||
|
sub KNXTUL_Clear($);
|
||||||
|
sub KNXTUL_Parse($$$$$);
|
||||||
|
sub KNXTUL_Read($);
|
||||||
|
sub KNXTUL_Ready($);
|
||||||
|
sub KNXTUL_Write($$$);
|
||||||
|
|
||||||
|
sub KNXTUL_OpenDev($$);
|
||||||
|
sub KNXTUL_CloseDev($);
|
||||||
|
sub KNXTUL_Disconnected($);
|
||||||
|
sub KNXTUL_Shutdown($);
|
||||||
|
|
||||||
|
my %gets = ( # Name, Data to send to the TUL, Regexp for the answer
|
||||||
|
"raw" => ["r", '.*'],
|
||||||
|
);
|
||||||
|
|
||||||
|
my %sets = (
|
||||||
|
"raw" => "",
|
||||||
|
);
|
||||||
|
|
||||||
|
sub KNXTUL_Initialize($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
eval("use IO::Socket::Multicast");
|
||||||
|
$KNXTUL_hasMulticast = 0 if($@);
|
||||||
|
|
||||||
|
# Provider
|
||||||
|
$hash->{ReadFn} = "KNXTUL_Read";
|
||||||
|
$hash->{WriteFn} = "KNXTUL_Write";
|
||||||
|
$hash->{ReadyFn} = "KNXTUL_Ready";
|
||||||
|
|
||||||
|
# Normal devices
|
||||||
|
$hash->{DefFn} = "KNXTUL_Define";
|
||||||
|
$hash->{UndefFn} = "KNXTUL_Undef";
|
||||||
|
$hash->{StateFn} = "KNXTUL_SetState";
|
||||||
|
$hash->{AttrFn} = "KNXTUL_Attr";
|
||||||
|
|
||||||
|
$hash->{AttrList}= "do_not_notify:1,0 " .
|
||||||
|
"dummy:1,0 " .
|
||||||
|
"showtime:1,0 " .
|
||||||
|
"verbose:0,1,2,3,4,5 ";
|
||||||
|
$hash->{ShutdownFn} = "KNXTUL_Shutdown";
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_Define($$)
|
||||||
|
{
|
||||||
|
my ($hash, $def) = @_;
|
||||||
|
my @a = split("[ \t][ \t]*", $def);
|
||||||
|
my $argcount=scalar(@a);
|
||||||
|
if($argcount < 3)
|
||||||
|
{
|
||||||
|
my $msg = "wrong syntax: define <name> KNXTUL <knx addr>";
|
||||||
|
return $msg;
|
||||||
|
}
|
||||||
|
return "install IO::Socket::Multicast to use KNXTUL" if(!$KNXTUL_hasMulticast);
|
||||||
|
$hash->{"HAS_IO::Socket::Multicast"} = $KNXTUL_hasMulticast;
|
||||||
|
|
||||||
|
KNXTUL_CloseDev($hash);
|
||||||
|
|
||||||
|
my $name = $a[0];
|
||||||
|
my $devaddr = KNXTUL_str2hex($a[2]);
|
||||||
|
$hash->{DeviceAddress} = $devaddr;
|
||||||
|
if ($argcount<4) {
|
||||||
|
$hash->{IPAddress} = "224.0.23.12";
|
||||||
|
$hash->{UseDirectConnection}=0;
|
||||||
|
} else {
|
||||||
|
$hash->{IPAddress}= $a[3];
|
||||||
|
$hash->{UseDirectConnection}=1;
|
||||||
|
}
|
||||||
|
$hash->{Port} = 3671;
|
||||||
|
$hash->{Clients} = "KNX";
|
||||||
|
|
||||||
|
my $ret = KNXTUL_OpenDev($hash, 0);
|
||||||
|
return $ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
########################
|
||||||
|
sub KNXTUL_OpenDev($$)
|
||||||
|
{
|
||||||
|
my ($hash, $reopen) = @_;
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
my $host = $hash->{IPAddress};
|
||||||
|
my $port = $hash->{Port};
|
||||||
|
my $UseDirectConnection = $hash->{UseDirectConnection};
|
||||||
|
$hash->{PARTIAL} = "";
|
||||||
|
Log 3, "KNXTUL opening $name" if(!$reopen);
|
||||||
|
|
||||||
|
# This part is called every time the timeout (5sec) is expired _OR_
|
||||||
|
# somebody is communicating over another TCP connection. As the connect
|
||||||
|
# for non-existent devices has a delay of 3 sec, we are sitting all the
|
||||||
|
# time in this connect. NEXT_OPEN tries to avoid this problem.
|
||||||
|
return if($hash->{NEXT_OPEN} && time() < $hash->{NEXT_OPEN});
|
||||||
|
my $conn=0;
|
||||||
|
if ($UseDirectConnection) {
|
||||||
|
$conn = new IO::Socket::INET(PeerHost => $host,PeerPort=>$port,Proto=>'udp') or Log3($name,0,"Connection to ".$host." can't be established");
|
||||||
|
} else {
|
||||||
|
$conn = IO::Socket::Multicast->new(Proto=>'udp',LocalPort=>$port,LocalAddr=>$host,ReuseAddr=>1);
|
||||||
|
$conn->mcast_add($host) || Log3 ($name, 3,"Can't set group: $host");
|
||||||
|
$conn->mcast_dest($host.":".$port);
|
||||||
|
}
|
||||||
|
if($conn)
|
||||||
|
{
|
||||||
|
delete($hash->{NEXT_OPEN})
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
Log3 ($name, 3, "Can't connect: $!") if(!$reopen);
|
||||||
|
$readyfnlist{"$name"} = $hash;
|
||||||
|
$hash->{STATE} = "disconnected";
|
||||||
|
$hash->{NEXT_OPEN} = time()+60;
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
$hash->{CD} = $conn;
|
||||||
|
$hash->{FD} = $conn->fileno();
|
||||||
|
delete($readyfnlist{"$name"});
|
||||||
|
$selectlist{"$name"} = $hash;
|
||||||
|
if($reopen)
|
||||||
|
{
|
||||||
|
Log3 ($name, 1, "KNXTUL reappeared ($name)");
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
Log3 ($name, 3, "KNXTUL device opened");
|
||||||
|
}
|
||||||
|
|
||||||
|
$hash->{STATE}=""; # Allow InitDev to set the state
|
||||||
|
my $ret = KNXTUL_DoInit($hash);
|
||||||
|
|
||||||
|
if($ret)
|
||||||
|
{
|
||||||
|
KNXTUL_CloseDev($hash);
|
||||||
|
Log (1, "OpenDev: Cannot init KNXTUL-Device, ignoring it");
|
||||||
|
}
|
||||||
|
|
||||||
|
DoTrigger($name, "CONNECTED") if($reopen);
|
||||||
|
return $ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
# called from the global loop, when the select for hash->{FD} reports data
|
||||||
|
sub KNXTUL_Read($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
#reset the refused flag, so we can check if a telegram was refused
|
||||||
|
$hash->{REFUSED} = undef;
|
||||||
|
my $buf = "";
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
my $outbuf="";
|
||||||
|
my $len=$hash->{CD}->recv($buf, 1024);
|
||||||
|
Log3($name,5,"KNXTUL - Read started");
|
||||||
|
if (defined($hash->{CHUNK}))
|
||||||
|
{
|
||||||
|
$buf=$hash->{CHUNK}.$buf;
|
||||||
|
$hash->{CHUNK}=undef;
|
||||||
|
}
|
||||||
|
if( !defined($len) || !$len ) {
|
||||||
|
Log3($name,1,"KNXTUL - No Data at Read");
|
||||||
|
} else {
|
||||||
|
my $header_size=unpack("C",$buf);
|
||||||
|
if (length($buf)<$header_size)
|
||||||
|
{
|
||||||
|
$hash->{CHUNK}=$buf;
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
my $total_length=unpack("x4n",$buf);
|
||||||
|
if (length($buf)<$total_length)
|
||||||
|
{
|
||||||
|
$hash->{CHUNK}=$buf;
|
||||||
|
return "";
|
||||||
|
} elsif (length($buf)>$total_length) {
|
||||||
|
$hash->{CHUNK}=substr($buf,$total_length);
|
||||||
|
$buf=substr($buf,0,$total_length);
|
||||||
|
}
|
||||||
|
my $message=substr($buf,$header_size);
|
||||||
|
my $hexmessage=unpack("H*",$message);
|
||||||
|
if (length($message)<11) {
|
||||||
|
Log3($name,5,"Received Message too short: ".$hexmessage);
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
if (substr($hexmessage,0,6) ne "2900bc") {
|
||||||
|
Log3($name,5,"No useable Messageheader: ".substr($hexmessage,0,4));
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
Log3($name,5,"RawMessage read: ".unpack("H*",$message));
|
||||||
|
#8Bit ControlByte, 16 Bit SourceAddress, 16 Bit TargetAddress, 1 Bit 1=Groupaddress 0=physical Address, 3 Bit Rounting Count, 4 Bit length of Information
|
||||||
|
my $bindata=unpack("B*",$message);
|
||||||
|
my ($ctrlbyte,$src,$dst,$len,$data)=unpack("x3aa2a2B8a*",$message);
|
||||||
|
my $rcvmessage=$src.$dst.$data;
|
||||||
|
$len=oct("0b0000".substr($len,4,4))+1;
|
||||||
|
if ($len!=length($data)) {
|
||||||
|
Log3($name,1,"Data-Length invalid: should be ".$len." is ".length($data));
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
Log3($name,5,"Message read - CtrlByte: ".unpack("B*",$ctrlbyte)." Source: ".unpack("H*",$src)." Dest: ".unpack("H*",$dst)." Data: ".unpack("H*",$data));
|
||||||
|
my $eibdata=KNXTUL_decode_eibd($rcvmessage);
|
||||||
|
my $type = $eibdata->{'type'};
|
||||||
|
$dst = $eibdata->{'dst'};
|
||||||
|
$src = $eibdata->{'src'};
|
||||||
|
my @bindata = @{$eibdata->{'data'}};
|
||||||
|
$data = "";
|
||||||
|
|
||||||
|
# convert bin data to hex
|
||||||
|
foreach my $c (@bindata)
|
||||||
|
{
|
||||||
|
$data .= sprintf ("%02x", $c);
|
||||||
|
}
|
||||||
|
|
||||||
|
$outbuf = $src;
|
||||||
|
if ($type eq "write") {$outbuf .= "w";}
|
||||||
|
elsif ($type eq "read") {$outbuf .= "r";}
|
||||||
|
else {$outbuf .= "p";}
|
||||||
|
$outbuf .= $dst;
|
||||||
|
$outbuf .= $data;
|
||||||
|
}
|
||||||
|
# check if refused
|
||||||
|
if(defined($hash->{REFUSED}))
|
||||||
|
{
|
||||||
|
Log3 ($name, 3,"KNXTUL $name refused message: $hash->{REFUSED}");
|
||||||
|
$hash->{REFUSED} = undef;
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
if(!defined($buf) || length($buf) == 0)
|
||||||
|
{
|
||||||
|
KNXTUL_Disconnected($hash);
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
|
||||||
|
#place KNX-Message
|
||||||
|
KNXTUL_Parse($hash, $hash, $name, "C".$outbuf, $hash->{initString});
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_Undef($$)
|
||||||
|
{
|
||||||
|
my ($hash, $arg) = @_;
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
|
||||||
|
foreach my $d (sort keys %defs)
|
||||||
|
{
|
||||||
|
if(defined($defs{$d}) && defined($defs{$d}{IODev}) && $defs{$d}{IODev} == $hash)
|
||||||
|
{
|
||||||
|
my $lev = ($reread_active ? 4 : 2);
|
||||||
|
Log (GetLogLevel($name,$lev), "deleting port for $d");
|
||||||
|
delete $defs{$d}{IODev};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
KNXTUL_CloseDev($hash);
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_Shutdown($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
KNXTUL_CloseDev($hash);
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_SetState($$$$)
|
||||||
|
{
|
||||||
|
my ($hash, $tim, $vt, $val) = @_;
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub KNXTUL_Clear($)
|
||||||
|
{
|
||||||
|
my $hash = shift;
|
||||||
|
|
||||||
|
#Clear the pipe
|
||||||
|
#TUL has no pipe....
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_DoInit($)
|
||||||
|
{
|
||||||
|
my $hash = shift;
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
my $err;
|
||||||
|
|
||||||
|
KNXTUL_Clear($hash);
|
||||||
|
|
||||||
|
$hash->{STATE} = "Initialized" if(!$hash->{STATE});
|
||||||
|
|
||||||
|
# Reset the counter
|
||||||
|
delete($hash->{XMIT_TIME});
|
||||||
|
delete($hash->{NR_CMD_LAST_H});
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_Parse($$$$$)
|
||||||
|
{
|
||||||
|
my ($hash, $iohash, $name, $rmsg, $initstr) = @_;
|
||||||
|
|
||||||
|
# there is nothing specal to do at the moment.
|
||||||
|
# just dispatch
|
||||||
|
|
||||||
|
my $dmsg = $rmsg;
|
||||||
|
$hash->{"${name}_MSGCNT"}++;
|
||||||
|
$hash->{"${name}_TIME"} = TimeNow();
|
||||||
|
$hash->{RAWMSG} = $rmsg;
|
||||||
|
my %addvals = (RAWMSG => $rmsg);
|
||||||
|
|
||||||
|
Dispatch($hash, $dmsg, \%addvals);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
sub KNXTUL_Ready($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
return KNXTUL_OpenDev($hash, 1) if($hash->{STATE} eq "disconnected");
|
||||||
|
}
|
||||||
|
|
||||||
|
########################
|
||||||
|
sub KNXTUL_Write($$$)
|
||||||
|
{
|
||||||
|
my ($hash,$fn,$msg) = @_;
|
||||||
|
return if(!$hash);
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
Log3($name,5,"KNXTUL - Write started");
|
||||||
|
return if(!defined($fn));
|
||||||
|
|
||||||
|
# Discard message if TUL is disconnected
|
||||||
|
return if($hash->{STATE} eq "disconnected");
|
||||||
|
|
||||||
|
Log3 ($name, 5, "KNXTUL: sending $fn $msg");
|
||||||
|
$msg = "$fn$msg";
|
||||||
|
|
||||||
|
# Msg must have the format B(w,r,p)g1g2g3v....
|
||||||
|
# w-> write, r-> read, p-> reply
|
||||||
|
# g1,g2,g3 are the hex parts of the group name
|
||||||
|
# v is a simple (1 Byte) or complex value (n bytes)
|
||||||
|
if ($msg =~ /^[BC](.)(.{5})(.*)$/)
|
||||||
|
{
|
||||||
|
my $eibmsg;
|
||||||
|
if($1 eq "w")
|
||||||
|
{
|
||||||
|
$eibmsg->{'type'} = 'write';
|
||||||
|
}
|
||||||
|
elsif ($1 eq "r")
|
||||||
|
{
|
||||||
|
$eibmsg->{'type'} = 'read';
|
||||||
|
}
|
||||||
|
elsif ($1 eq "p")
|
||||||
|
{
|
||||||
|
$eibmsg->{'type'} = 'reply';
|
||||||
|
}
|
||||||
|
|
||||||
|
$eibmsg->{'dst'} = $2;
|
||||||
|
my $hexvalues = $3;
|
||||||
|
|
||||||
|
#The array has to have a given length. During Hex-conversion Trailing
|
||||||
|
#0 are recognizes for warnings.
|
||||||
|
#Therefore we backup the length, trim, and reappend the 0
|
||||||
|
#
|
||||||
|
#save length and trim right side
|
||||||
|
my $strLen = length ($hexvalues) / 2;
|
||||||
|
$hexvalues =~ s/\s+$//;
|
||||||
|
#convert hex-string to array with dezimal values
|
||||||
|
my @data = map hex($_), $hexvalues =~ /(..)/g;
|
||||||
|
#re-append 0x00
|
||||||
|
for (my $i=0; $strLen - scalar @data; $i++)
|
||||||
|
{
|
||||||
|
push (@data, 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
# check: first byte is only allowed to contain data in the lower 6bits
|
||||||
|
# to make sure all is fine, we mask the first byte
|
||||||
|
$data[0] = $data[0] & 0x3f if(defined($data[0]));
|
||||||
|
|
||||||
|
$eibmsg->{'data'} = \@data;
|
||||||
|
|
||||||
|
KNXTUL_sendGroup($hash, $eibmsg);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
Log3 ($hash->{NAME}, 1,"Could not parse message $msg");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
select(undef, undef, undef, 0.001);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub KNXTUL_sendGroup($$)
|
||||||
|
{
|
||||||
|
my ($hash,$msgref) = @_;
|
||||||
|
my $dst = $msgref->{'dst'};
|
||||||
|
my $src = $hash->{DeviceAddress};
|
||||||
|
$msgref->{'src'} = $src;
|
||||||
|
my @encmsg = KNXTUL_encode_eibd($hash,$msgref);
|
||||||
|
|
||||||
|
Log3($hash->{NAME},5,"KNXTUL_sendGroup: dst: $dst, msg: @encmsg \n");
|
||||||
|
|
||||||
|
my $str=pack("nCC*", @encmsg);
|
||||||
|
my $host = $hash->{IPAddress};
|
||||||
|
my $port = $hash->{Port};
|
||||||
|
my $size = length($str);
|
||||||
|
my $completemsg=pack("H*","06100530").pack("n",$size+12).pack("H*","2900BCD0").pack("n",$size).$str;
|
||||||
|
Log3 ($hash->{NAME},5,"KNXTUL_sendRequest: ".$host.":".$port." msg: ".unpack("H*",$completemsg). "\n");
|
||||||
|
return undef unless $hash->{CD}->mcast_send($completemsg,$host.":".$port);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
########################
|
||||||
|
sub KNXTUL_CloseDev($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
my $dev = $hash->{DeviceName};
|
||||||
|
|
||||||
|
return if(!$dev);
|
||||||
|
|
||||||
|
if($hash->{FD})
|
||||||
|
{
|
||||||
|
$hash->{FD}->close();
|
||||||
|
delete($hash->{FD});
|
||||||
|
}
|
||||||
|
elsif($hash->{USBDev})
|
||||||
|
{
|
||||||
|
$hash->{USBDev}->close() ;
|
||||||
|
delete($hash->{USBDev});
|
||||||
|
}
|
||||||
|
|
||||||
|
delete($selectlist{"$name.$dev"});
|
||||||
|
delete($readyfnlist{"$name.$dev"});
|
||||||
|
delete($hash->{FD});
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
########################
|
||||||
|
sub KNXTUL_Disconnected($)
|
||||||
|
{
|
||||||
|
my $hash = shift;
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
|
||||||
|
return if(!defined($hash->{FD})); # Already deleted or RFR
|
||||||
|
|
||||||
|
Log3 ($name, 1, "KNXTUL disconnected, waiting to reappear");
|
||||||
|
KNXTUL_CloseDev($hash);
|
||||||
|
$readyfnlist{"$name"} = $hash; # Start polling
|
||||||
|
$hash->{STATE} = "disconnected";
|
||||||
|
|
||||||
|
# Without the following sleep the open of the device causes a SIGSEGV,
|
||||||
|
# and following opens block infinitely. Only a reboot helps.
|
||||||
|
sleep(5);
|
||||||
|
|
||||||
|
DoTrigger($name, "DISCONNECTED");
|
||||||
|
}
|
||||||
|
|
||||||
|
########################
|
||||||
|
sub KNXTUL_Attr(@)
|
||||||
|
{
|
||||||
|
my ($cmd,$name,$aName,$aVal) = @_;
|
||||||
|
|
||||||
|
Log3 ($name, 5, "changing value, ATTR: $aName, VALUE: $aVal");
|
||||||
|
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Utility functions
|
||||||
|
sub KNXTUL_hex2addr
|
||||||
|
{
|
||||||
|
my $str = lc($_[0]);
|
||||||
|
if ($str =~ /([0-9a-f]{2})([0-9a-f])([0-9a-f]{2})/)
|
||||||
|
{
|
||||||
|
return (hex($1) << 11) | (hex($2) << 8) | hex($3);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub KNXTUL_addr2hex
|
||||||
|
{
|
||||||
|
my $a = $_[0];
|
||||||
|
my $b = $_[1]; # 1 if local (group) address, else physical address
|
||||||
|
my $str ;
|
||||||
|
|
||||||
|
if ($b == 1)
|
||||||
|
{
|
||||||
|
#logical address used
|
||||||
|
$str = sprintf "%02x%01x%02x", ($a >> 11) & 0x1f, ($a >> 8) & 0x7, $a & 0xff;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$str = sprintf "%02x%01x%02x", $a >> 12, ($a >> 8) & 0xf, $a & 0xff;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $str;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub KNXTUL_str2hex
|
||||||
|
{
|
||||||
|
my $str = $_[0];
|
||||||
|
my $hex;
|
||||||
|
|
||||||
|
if (($str =~ /(\d+)\/(\d+)\/(\d+)/) or ($str =~ /(\d+)\.(\d+)\.(\d+)/))
|
||||||
|
{
|
||||||
|
# logical address
|
||||||
|
$hex = sprintf("%02x%01x%02x",$1,$2,$3);
|
||||||
|
return $hex;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# For mapping between APCI symbols and values
|
||||||
|
my @apcicodes = ('read', 'reply', 'write');
|
||||||
|
my %apcivalues = ('read' => 0, 'reply' => 1, 'write' => 2,);
|
||||||
|
|
||||||
|
# decode: unmarshall a string with an EIB message into a hash
|
||||||
|
# The hash has the follwing fields:
|
||||||
|
# - type: APCI (symbolic value)
|
||||||
|
# - src: source address
|
||||||
|
# - dst: destiniation address
|
||||||
|
# - data: array of integers; one for each byte of data
|
||||||
|
sub KNXTUL_decode_eibd($)
|
||||||
|
{
|
||||||
|
my ($buf) = @_;
|
||||||
|
my $drl = 0xe1; # dummy value
|
||||||
|
my %msg;
|
||||||
|
my @data;
|
||||||
|
my ($src, $dst,$bytes) = unpack("nnxa*", $buf);
|
||||||
|
my $apci;
|
||||||
|
|
||||||
|
$apci = vec($bytes, 3, 2);
|
||||||
|
# mask out apci bits, so we can use the whole byte as data:
|
||||||
|
vec($bytes, 3, 2) = 0;
|
||||||
|
if ($apci >= 0 && $apci <= $#apcicodes)
|
||||||
|
{
|
||||||
|
$msg{'type'} = $apcicodes[$apci];
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$msg{'type'} = 'apci ' . $apci;
|
||||||
|
}
|
||||||
|
$msg{'src'} = KNXTUL_addr2hex($src,0);
|
||||||
|
$msg{'dst'} = KNXTUL_addr2hex($dst,1);
|
||||||
|
|
||||||
|
@data = unpack ("C" . length($bytes), $bytes);
|
||||||
|
my $datalen = @data;
|
||||||
|
Log (5, "KNXTUL_decode_eibd: byte len: " . length($bytes) . " array size: $datalen");
|
||||||
|
|
||||||
|
# in case of data len > 1, the first byte (the one with apci) seems not to be used
|
||||||
|
# and only the following byte are of interest.
|
||||||
|
if($datalen>1)
|
||||||
|
{
|
||||||
|
shift @data;
|
||||||
|
}
|
||||||
|
|
||||||
|
$msg{'data'} = \@data;
|
||||||
|
return \%msg;
|
||||||
|
}
|
||||||
|
|
||||||
|
# encode: marshall a hash into a EIB message string
|
||||||
|
sub KNXTUL_encode_eibd($$)
|
||||||
|
{
|
||||||
|
my ($hash,$mref) = @_;
|
||||||
|
my @msg;
|
||||||
|
my $APCI;
|
||||||
|
my @data;
|
||||||
|
|
||||||
|
$APCI = $apcivalues{$mref->{'type'}};
|
||||||
|
if (!(defined $APCI))
|
||||||
|
{
|
||||||
|
Log3($hash->{NAME},3,"KNXTUL_encode_eibd: Bad KNX message type $mref->{'type'}\n");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
@data = @{$mref->{'data'}};
|
||||||
|
|
||||||
|
@data = (0x0) if(!@data || !defined($data[0])); #make sure data has at least one element
|
||||||
|
my $datalen = @data;
|
||||||
|
Log3 ($hash->{NAME},5,"KNXTUL_encode_eibd: dst: $mref->{'dst'} apci: $APCI datalen: $datalen data: @data");
|
||||||
|
@msg = (
|
||||||
|
KNXTUL_hex2addr( $mref->{'dst'}), # Destination address
|
||||||
|
$datalen,
|
||||||
|
0x0 | ($APCI >> 2), # TPDU type, Sequence no, APCI (msb)
|
||||||
|
(($APCI & 0x3) << 6) | $data[0],
|
||||||
|
);
|
||||||
|
if ($datalen > 1)
|
||||||
|
{
|
||||||
|
shift(@data);
|
||||||
|
push @msg, @data;
|
||||||
|
}
|
||||||
|
return @msg;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
=pod
|
||||||
|
=begin html
|
||||||
|
|
||||||
|
<a name="KNXTUL"></a>
|
||||||
|
<h3>KNXTUL</h3>
|
||||||
|
<ul>
|
||||||
|
The KNXTUL module is the representation of a EIB / KNX connector in FHEM without the need for knxd or similar.
|
||||||
|
<a href="#KNX">KNX</a> instances represent the EIB / KNX devices and will need a KNXTUL as IODev to communicate with the EIB / KNX network.<br>
|
||||||
|
The TUL module is designed to connect to KNX network via Standard Multicast Address (224.0.23.12)
|
||||||
|
Note: This module requires Perl Module IO::Socket::Multicast which needs to be installed before use.
|
||||||
|
|
||||||
|
<a name="KNXTULdefine"></a>
|
||||||
|
<b>Define</b>
|
||||||
|
<ul>
|
||||||
|
<code>define <name> KNXTUL <physical address></code> <br>
|
||||||
|
<br>
|
||||||
|
<ul>
|
||||||
|
<br><br>
|
||||||
|
Example:<br>
|
||||||
|
<code>define tul KNXTUL 1.1.249</code>
|
||||||
|
</ul>
|
||||||
|
<br>
|
||||||
|
The physical address is used as the source address of telegrams sent to EIB network.
|
||||||
|
</ul>
|
||||||
|
<br>
|
||||||
|
|
||||||
|
<a name="TULattr"></a>
|
||||||
|
<b>Attributes</b>
|
||||||
|
<ul>
|
||||||
|
<li><a href="#do_not_notify">do_not_notify</a></li><br>
|
||||||
|
<li><a href="#attrdummy">dummy</a></li><br>
|
||||||
|
<li><a href="#showtime">showtime</a></li><br>
|
||||||
|
<li><a href="#verbose">verbose</a></li><br>
|
||||||
|
</ul>
|
||||||
|
<br>
|
||||||
|
</ul>
|
||||||
|
|
||||||
|
=end html
|
||||||
|
=device
|
||||||
|
=item summary Connects FHEM to KNX-Bus (Base-device)
|
||||||
|
=item summary_DE Verbindet FHEM mit dem KNX-Bus (Basisger¨at)
|
||||||
|
=begin html_DE
|
||||||
|
|
||||||
|
<a name="KNXTUL"></a>
|
||||||
|
<h3>KNXTUL</h3>
|
||||||
|
<ul>
|
||||||
|
|
||||||
|
Das Modul KNXTUL stellt die Verbindung von FHEM zu KNX dar.
|
||||||
|
<a href="#KNX">KNX</a> Instanzen stellen die Vrbindung zu den KNX-Gruppen dar und benötigen ein TUL-Device als IO-Schnittstelle.<br>
|
||||||
|
Das Modul KNXTUL kommuniziert mit dem KNX über die KNX-Multicast-Adresse 224.0.23.12. Voraussetzung ist ein KNX/IP-Router im selben Netztwerk wie die FHEM-Instanz.
|
||||||
|
|
||||||
|
Anmerkung: das Modul benötigt das Perl Modul IO::Socket::Multicast.
|
||||||
|
<a name="KNXTULdefine"></a>
|
||||||
|
<b>Define</b>
|
||||||
|
<ul>
|
||||||
|
<code>define <name> KNXTUL <Physikalische KNX-Adresse></code> <br>
|
||||||
|
<br>
|
||||||
|
Beispiel:<br>
|
||||||
|
<code>define tul KNXTUL 1.1.249</code>
|
||||||
|
<br>
|
||||||
|
Die physikalische Adresse wird als Absender für KNX-Telegramme genutzt.
|
||||||
|
</ul>
|
||||||
|
<br>
|
||||||
|
|
||||||
|
<a name="TULattr"></a>
|
||||||
|
<b>Attribute</b>
|
||||||
|
<ul>
|
||||||
|
<li><a href="#do_not_notify">do_not_notify</a></li><br>
|
||||||
|
<li><a href="#attrdummy">dummy</a></li><br>
|
||||||
|
<li><a href="#showtime">showtime</a></li><br>
|
||||||
|
<li><a href="#verbose">verbose</a></li><br>
|
||||||
|
</ul>
|
||||||
|
<br>
|
||||||
|
</ul>
|
||||||
|
|
||||||
|
=end html_DE
|
||||||
|
|
||||||
|
=cut
|
||||||
Loading…
Reference in New Issue
Block a user