############################################## # $Id$ package main; use strict; use warnings; use Time::HiRes qw(gettimeofday); use HttpUtils; sub FHEM2FHEM_Read($); sub FHEM2FHEM_Ready($); sub FHEM2FHEM_OpenDev($$); sub FHEM2FHEM_CloseDev($); sub FHEM2FHEM_Disconnected($); sub FHEM2FHEM_Define($$); sub FHEM2FHEM_Undef($$); sub FHEM2FHEM_Initialize($) { my ($hash) = @_; # Provider $hash->{ReadFn} = "FHEM2FHEM_Read"; $hash->{WriteFn} = "FHEM2FHEM_Write"; $hash->{ReadyFn} = "FHEM2FHEM_Ready"; $hash->{SetFn} = "FHEM2FHEM_Set"; $hash->{AttrFn} = "FHEM2FHEM_Attr"; $hash->{noRawInform} = 1; # Normal devices $hash->{DefFn} = "FHEM2FHEM_Define"; $hash->{UndefFn} = "FHEM2FHEM_Undef"; no warnings 'qw'; my @attrList = qw( addStateEvent:1,0 disable:0,1 disabledForIntervals dummy:1,0 eventOnly:1,0 excludeEvents loopThreshold keepaliveInterval reportConnected:1,0 setState ); use warnings 'qw'; $hash->{AttrList} = join(" ", @attrList); } ##################################### sub FHEM2FHEM_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); if(@a < 4 || @a > 5 || !($a[3] =~ m/^(LOG|RAW):(.*)$/)) { my $msg = "wrong syntax: define FHEM2FHEM host[:port][:SSL] ". "[LOG:regexp|RAW:device] {portpasswort}"; Log3 $hash, 2, $msg; return $msg; } $hash->{informType} = $1; if($1 eq "LOG") { $hash->{regexp} = $2; } else { my $rdev = $2; my $iodev = $defs{$rdev}; return "Undefined local device $rdev" if(!$iodev); $hash->{rawDevice} = $rdev; my $iomod = $modules{$iodev->{TYPE}}; $hash->{Clients} = $iodev->{Clients} ? $iodev->{Clients} :$iomod->{Clients}; $hash->{MatchList} = $iomod->{MatchList} if($iomod->{MatchList}); } my $dev = $a[2]; if($dev =~ m/^(.*):SSL$/) { $dev = $1; $hash->{SSL} = 1; } if($dev !~ m/^.+:[0-9]+$/) { # host:port $dev = "$dev:7072"; $hash->{Host} = $dev; } if($hash->{OLDDEF} && $hash->{OLDDEF} =~ m/^([^ \t]+)/) {; # Forum #30242 delete($readyfnlist{"$hash->{NAME}.$1"}); } $hash->{Host} = $dev; $hash->{portpassword} = $a[4] if(@a == 5); FHEM2FHEM_CloseDev($hash); # Modify... return FHEM2FHEM_OpenDev($hash, 0); } ##################################### sub FHEM2FHEM_Undef($$) { my ($hash, $arg) = @_; FHEM2FHEM_CloseDev($hash); return undef; } sub FHEM2FHEM_Write($$) { my ($hash,$fn,$msg) = @_; my $dev = $hash->{Host}; if(!$hash->{TCPDev2}) { my $conn; if($hash->{SSL}) { $conn = IO::Socket::SSL->new(PeerAddr => $dev); } else { $conn = IO::Socket::INET->new(PeerAddr => $dev); } return if(!$conn); # Hopefuly it is reported elsewhere $hash->{TCPDev2} = $conn; F2F_sw($hash->{TCPDev2}, $hash->{portpassword} . "\n") if($hash->{portpassword}); } my $rdev = $hash->{rawDevice}; F2F_sw($hash->{TCPDev2}, "iowrite $rdev $fn $msg\n"); } ##################################### # called from the global loop, when the select for hash->{FD} reports data sub FHEM2FHEM_Read($) { my ($hash) = @_; my $buf; my $res = sysread($hash->{TCPDev}, $buf, 256); if($hash->{SSL} && !defined($res) && $! == EWOULDBLOCK) { my $es = $hash->{TCPDev}->errstr; $hash->{wantWrite} = 1 if($es == &IO::Socket::SSL::SSL_WANT_WRITE); $hash->{wantRead} = 1 if($es == &IO::Socket::SSL::SSL_WANT_READ); return ""; } if(!defined($buf) || length($buf) == 0) { FHEM2FHEM_Disconnected($hash); return; } $buf = Encode::decode('UTF-8', $buf) if($unicodeEncoding); my $name = $hash->{NAME}; return if(IsDisabled($name)); my $excl = AttrVal($name, "excludeEvents", undef); my $threshold = AttrVal($name, "loopThreshold", 0); # 122300 my $data = $hash->{PARTIAL}; #Log3 $hash, 5, "FHEM2FHEM/RAW: $data/$buf"; $data .= $buf; if($data =~ m/\0/) { if($data !~ m/^(.*)\0(.*)\0(.*)$/s) { $hash->{PARTIAL} = $data; return; } my $resp = $2; if($hash->{".lcmd"}) { Log3 $name, 4, "Remote command response:$resp"; asyncOutput($hash->{".lcmd"}, $resp); delete($hash->{".lcmd"}); } else { Log3 $name, 3, "Remote command response:$resp"; } $hash->{cmdResponse} = $resp; $data = $1.$3; # Continue with the rest } while($data =~ m/\n/) { my $rmsg; ($rmsg,$data) = split("\n", $data, 2); $rmsg =~ s/\r//; if($hash->{informType} eq "LOG") { my ($type, $rname, $msg) = split(" ", $rmsg, 3); next if(!defined($msg)); # Bogus data my $re = $hash->{regexp}; next if($re && !($rname =~ m/^$re$/ || "$rname:$msg" =~ m/^$re$/)); next if($excl && ($rname =~ m/^$excl$/ || "$rname:$msg" =~ m/^$excl$/)); Log3 $name, 4, "$rname: $rmsg"; if(!$defs{$rname}) { $defs{$rname}{NAME} = $rname; $defs{$rname}{TYPE} = $type; $defs{$rname}{STATE} = $msg; $defs{$rname}{FAKEDEVICE} = 1; # Avoid set/attr/delete/etc in notify $defs{$rname}{TEMPORARY} = 1; # Do not save it DoTrigger($rname, $msg); delete($defs{$rname}); delete($attr{$rname}); # Forum #73490 } else { if(AttrVal($name,"eventOnly",0)) { DoTrigger($rname, $msg); } else { my $reading = "state"; if($msg =~ m/^([^:]*): (.*)$/) { $reading = $1; $msg = $2; } my $age = ($threshold ? ReadingsAge($rname,$reading,undef) : 99999); if(defined($age) && $age < $threshold) { Log3 $name, 4, "$name: ignoring $rname $reading $msg, ". "threshold $threshold, age:$age"; next; } if($reading eq "state" && AttrVal($name, "setState", 0)) { AnalyzeCommand($hash, "set $rname $msg"); } else { readingsSingleUpdate($defs{$rname}, $reading, $msg, 1); } } } } else { # RAW my ($type, $rname, $msg) = split(" ", $rmsg, 3); my $rdev = $hash->{rawDevice}; next if($rname ne $rdev); Log3 $name, 4, "$name: $rmsg"; Dispatch($defs{$rdev}, $msg, undef); } } $hash->{PARTIAL} = $data; } ##################################### sub FHEM2FHEM_Ready($) { my ($hash) = @_; return FHEM2FHEM_OpenDev($hash, 1); } ######################## sub FHEM2FHEM_CloseDev($) { my ($hash) = @_; my $name = $hash->{NAME}; my $dev = $hash->{Host}; return if(!$dev); $hash->{TCPDev}->close() if($hash->{TCPDev}); $hash->{TCPDev2}->close() if($hash->{TCPDev2}); delete($hash->{NEXT_OPEN}); delete($hash->{TCPDev}); delete($hash->{TCPDev2}); delete($selectlist{"$name.$dev"}); delete($readyfnlist{"$name.$dev"}); delete($hash->{FD}); } ######################## sub FHEM2FHEM_OpenDev($$) { my ($hash, $reopen) = @_; my $dev = $hash->{Host}; my $name = $hash->{NAME}; $hash->{PARTIAL} = ""; Log3 $name, 3, "FHEM2FHEM opening $name at $dev" if(!$reopen); return if($hash->{NEXT_OPEN} && time() <= $hash->{NEXT_OPEN}); return if(IsDisabled($name)); my $doTailWork = sub($$$) { my ($h, $err, undef) = @_; if($err) { Log3($name, 3, "Can't connect to $dev: $!") if(!$reopen); $readyfnlist{"$name.$dev"} = $hash; $hash->{STATE} = "disconnected"; $hash->{NEXT_OPEN} = time()+60; return; } my $conn = $h->{conn}; delete($hash->{NEXT_OPEN}); $conn->setsockopt(SOL_SOCKET, SO_KEEPALIVE, 1); $hash->{TCPDev} = $conn; $hash->{FD} = $conn->fileno(); delete($readyfnlist{"$name.$dev"}); $selectlist{"$name.$dev"} = $hash; if($reopen) { Log3 $name, 1, "FHEM2FHEM $dev reappeared ($name)"; } else { Log3 $name, 3, "FHEM2FHEM device opened ($name)"; } $hash->{STATE}= "connected"; DoTrigger($name, "CONNECTED") if($reopen); F2F_sw($hash->{TCPDev}, $hash->{portpassword} . "\n") if($hash->{portpassword}); my $type = AttrVal($hash->{NAME},"addStateEvent",0) ? "onWithState" : "on"; my $msg = $hash->{informType} eq "LOG" ? "inform $type $hash->{regexp}" : "inform raw"; F2F_sw($hash->{TCPDev}, $msg . "\n"); F2F_sw($hash->{TCPDev}, "trigger global CONNECTED $name\n") if(AttrVal($name, "reportConnected", 0)); my $ki = AttrVal($hash->{NAME}, "keepaliveInterval", 0); InternalTimer(gettimeofday()+$ki, "FHEM2FHEM_keepalive", $hash) if($ki); }; return HttpUtils_Connect({ # Nonblocking url => $hash->{SSL} ? "https://$dev/" : "http://$dev/", NAME => $name, noConn2 => 1, callback=> $doTailWork }); } sub FHEM2FHEM_Disconnected($) { my $hash = shift; my $dev = $hash->{Host}; my $name = $hash->{NAME}; return if(!defined($hash->{FD})); # Already deleted Log3 $name, 1, "$dev disconnected, waiting to reappear"; FHEM2FHEM_CloseDev($hash); $readyfnlist{"$name.$dev"} = $hash; # Start polling $hash->{STATE} = "disconnected"; return if(IsDisabled($name)); #Forum #39386 # 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 F2F_sw($$) { my ($io, $buf) = @_; $buf = Encode::encode('UTF-8', $buf) if($unicodeEncoding); return syswrite($io, $buf); } sub FHEM2FHEM_Set($@) { my ($hash, @a) = @_; my %sets = ( reopen=>"noArg", cmd=>"textField" ); return "set needs at least one parameter" if(@a < 2); return "Unknown argument $a[1], choose one of ". join(" ", map {"$_:$sets{$_}"} sort keys %sets) if(!$sets{$a[1]}); return "$a[1] needs at least one parameter" if(@a < 3 && $sets{$a[1]} ne "noArg"); if($a[1] eq "reopen") { FHEM2FHEM_CloseDev($hash); FHEM2FHEM_OpenDev($hash, 0); } if($a[1] eq "cmd") { return "Not connected" if(!$hash->{TCPDev}); my $cmd = join(" ",@a[2..$#a]); $cmd = '{my $r=fhem("'.$cmd.'");; defined($r) ? "\\0$r\\0" : $r}'."\n"; F2F_sw($hash->{TCPDev}, $cmd); $hash->{".lcmd"} = $hash->{CL}; } return undef; } sub FHEM2FHEM_Attr(@) { my ($type, $devName, $attrName, @param) = @_; my $hash = $defs{$devName}; if($attrName eq "addStateEvent") { $attr{$devName}{$attrName} = 1; FHEM2FHEM_CloseDev($hash); FHEM2FHEM_OpenDev($hash, 1); } if($attrName eq "keepaliveInterval") { return "Numeric argument expected" if($param[0] !~ m/^\d+$/); InternalTimer(gettimeofday()+$param[0], "FHEM2FHEM_keepalive", $hash) if($param[0] && $hash->{TCPDev}); } return undef; } sub FHEM2FHEM_keepalive($) { my ($hash) = @_; my $name = $hash->{NAME}; my $ki = AttrVal($name, "keepaliveInterval", 0); return if(!$ki || !$hash->{TCPDev}); HttpUtils_Connect({ url => "http://$hash->{Host}/", noConn2 => 1, callback=> sub { my ($h, $err, undef) = @_; if($err) { Log3 $name, 4, "$name keepalive: $err"; return FHEM2FHEM_Disconnected($hash); } $h->{conn}->close(); InternalTimer(gettimeofday()+$ki, "FHEM2FHEM_keepalive", $hash); } }); } 1; =pod =item helper =item summary connect two FHEM instances =item summary_DE verbindet zwei FHEM Installationen =begin html

FHEM2FHEM

=end html =begin html_DE

FHEM2FHEM

=end html_DE =cut