############################################## # $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->{noRawInform} = 1; # Normal devices $hash->{DefFn} = "FHEM2FHEM_Define"; $hash->{UndefFn} = "FHEM2FHEM_Undef"; $hash->{AttrList}= "dummy:1,0 disable:0,1 disabledForIntervals"; } ##################################### 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; $hash->{Clients} = $iodev->{Clients}; $hash->{Clients} = $modules{$iodev->{TYPE}}{Clients} if(!$hash->{Clients}); } 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; syswrite($hash->{TCPDev2}, $hash->{portpassword} . "\n") if($hash->{portpassword}); } my $rdev = $hash->{rawDevice}; syswrite($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 = FHEM2FHEM_SimpleRead($hash); my $name = $hash->{NAME}; ########### # Lets' try again: Some drivers return len(0) on the first read... if(defined($buf) && length($buf) == 0) { $buf = FHEM2FHEM_SimpleRead($hash); } if(!defined($buf) || length($buf) == 0) { FHEM2FHEM_Disconnected($hash); return; } return if(IsDisabled($name)); my $data = $hash->{PARTIAL}; #Log3 $hash, 5, "FHEM2FHEM/RAW: $data/$buf"; $data .= $buf; while($data =~ m/\n/) { my $rmsg; ($rmsg,$data) = split("\n", $data, 2); $rmsg =~ s/\r//; if($hash->{informType} eq "LOG") { my ($type, $name, $msg) = split(" ", $rmsg, 3); next if(!defined($msg)); # Bogus data my $re = $hash->{regexp}; next if($re && !($name =~ m/^$re$/ || "$name:$msg" =~ m/^$re$/)); Log3 $name, 4, "$name: $rmsg"; if(!$defs{$name}) { #LoadModule($type); Why do we need this line? $defs{$name}{NAME} = $name; $defs{$name}{TYPE} = $type; $defs{$name}{STATE} = $msg; $defs{$name}{FAKEDEVICE} = 1; # Avoid set/attr/delete/etc in notify $defs{$name}{TEMPORARY} = 1; # Do not save it DoTrigger($name, $msg); delete($defs{$name}); } else { DoTrigger($name, $msg); } } 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); syswrite($hash->{TCPDev}, $hash->{portpassword} . "\n") if($hash->{portpassword}); my $msg = $hash->{informType} eq "LOG" ? "inform on $hash->{regexp}" : "inform raw"; syswrite($hash->{TCPDev}, $msg . "\n"); }; 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 FHEM2FHEM_SimpleRead($) { my ($hash) = @_; my $buf; if(!defined(sysread($hash->{TCPDev}, $buf, 256))) { FHEM2FHEM_Disconnected($hash); return undef; } return $buf; } sub FHEM2FHEM_Set($@) { my ($hash, @a) = @_; return "set needs at least one parameter" if(@a < 2); return "Unknown argument $a[1], choose one of reopen:noArg" if($a[1] ne "reopen"); FHEM2FHEM_CloseDev($hash); FHEM2FHEM_OpenDev($hash, 0); return undef; } 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