From 5c1bd33d4b805cbc912deda1a756266da70834f8 Mon Sep 17 00:00:00 2001
From: martinp876 <>
Date: Wed, 1 Jan 2014 19:05:41 +0000
Subject: [PATCH] Hacker Attack indication, bug fixing with action detector

git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@4520 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
 FHEM/10_CUL_HM.pm | 67 ++++++++++++++++++++++++++++-------------------
 FHEM/98_HMinfo.pm | 50 +++++++++++++++++++++++++----------
 2 files changed, 76 insertions(+), 41 deletions(-)

diff --git a/FHEM/10_CUL_HM.pm b/FHEM/10_CUL_HM.pm
index 78412efcd..943bcba84 100755
--- a/FHEM/10_CUL_HM.pm
+++ b/FHEM/10_CUL_HM.pm
@@ -32,7 +32,7 @@ my $culHmChanSets         =\%HMConfig::culHmChanSets;
 my $culHmFunctSets        =\%HMConfig::culHmFunctSets;
 my $culHmBits             =\%HMConfig::culHmBits;
 my $culHmCmdFlags         =\@HMConfig::culHmCmdFlags;
-my $K_actDetID            =\$HMConfig::K_actDetID;
+my $K_actDetID            ="000000";
 
 ############################################################
 
@@ -550,33 +550,47 @@ sub CUL_HM_Parse($$) {##############################
   my $ioName = $iohash->{NAME};
   my ($msg,$msgStat,$myRSSI,$msgIO) = split(":",$msgIn,4);
   # Msg format: Allnnffttssssssddddddpp...
-  $msg =~ m/A(..)(..)(..)(..)(......)(......)(.*)/;
-  my ($len,$mNo,$mFlg,$mTp,$src,$dst,$p) = ($1,$2,$3,$4,$5,$6,$7);
+  my (undef,$len,$mNo,$mFlg,$mTp,$src,$dst,$p) = unpack 'A1A2A2A2A2A6A6A*',$msg;
   $p = "" if(!defined($p));
   my @mI = unpack '(A2)*',$p; # split message info to bytes
-
-  return "" if(  ($msgStat && $msgStat eq 'NACK')# lowlevel error
-               ||($src eq $id));                 # mirrored messages
+  return "" if($msgStat && $msgStat eq 'NACK');# lowlevel error
   # $shash will be replaced for multichannel commands
-  my $shash = $modules{CUL_HM}{defptr}{$src};
-  my $dhash = $modules{CUL_HM}{defptr}{$dst};
+  my $shash = CUL_HM_id2Hash($src);
+  my $dhash = CUL_HM_id2Hash($dst);
   CUL_HM_statCnt($ioName,"r");
+  my $dname = ($dst eq "000000") ? "broadcast" :
+                                   ($dhash ? $dhash->{NAME} :
+                                             ($dst eq $id ? $ioName :
+                                                            $dst));
+
+  if(!$shash && $mTp eq "00") { # generate device
+    my $md = substr($p, 2, 4);
+    $md = $culHmModel->{$md}{name}  ?
+              $culHmModel->{$md}{name} :
+              "ID_".$md;
+    my $sname = "CUL_HM_".$md."_$src";
+    $sname =~ s/-/_/g;
+    Log3 undef, 3, "CUL_HM Unknown device $sname, please define it";
+    return "UNDEFINED $sname CUL_HM $src $msg";
+  }
+  ####################  attack alarm detection#####################
+  if (   $dhash 
+      && !CUL_HM_getAttrInt($dname,"ignore")
+      && ($mTp eq '01' || $mTp eq '11')){
+    my $ioId = AttrVal($dhash->{IODev}{NAME},"hmId","-");
+    CUL_HM_eventP($dhash,"ErrIoId_$src")if($ioId ne $src);
+    Log 1,"General ErrIoAttack ".$dhash->{NAME}.":$msg"
+          ."\n                         ".$dhash->{helper}{cSnd}    
+         if(defined $dhash->{helper}{cSnd} && $dhash->{helper}{cSnd} ne substr($msg,7));
+    CUL_HM_eventP($dhash,"ErrIoAttack")
+         if(defined $dhash->{helper}{cSnd} && $dhash->{helper}{cSnd} ne substr($msg,7));
+  }
+  ###########
+
+  #  return "" if($src eq $id);# mirrored messages - covered by !$shash
+  return "" if(!$shash);    # Unknown source
 
   $respRemoved = 0;  #set to 'no response in this message' at start
-  if(!$shash) {      #  Unknown source
-    # Generate an UNKNOWN event for pairing requests, ignore everything else
-    if($mTp eq "00") {
-      my $md = substr($p, 2, 4);
-      $md = $culHmModel->{$md}{name}  ?
-                $culHmModel->{$md}{name} :
-                "ID_".$md;
-      my $sname = "CUL_HM_".$md."_$src";
-      $sname =~ s/-/_/g;
-      Log3 undef, 3, "CUL_HM Unknown device $sname, please define it";
-      return "UNDEFINED $sname CUL_HM $src $msg";
-    }
-   return "";
-  }
   my @event;    #events to be posted for main entity
   my @entities; #additional entities with events to be notifies
 
@@ -592,10 +606,6 @@ sub CUL_HM_Parse($$) {##############################
   }
   CUL_HM_eventP($shash,"Evt_$msgStat")if ($msgStat);#log io-events
   CUL_HM_eventP($shash,"Rcv");
-  my $dname = ($dst eq "000000") ? "broadcast" :
-                                   ($dhash ? $dhash->{NAME} :
-                                             ($dst eq $id ? $ioName :
-                                                            $dst));
   my $target = " (to $dname)";
   my $st = AttrVal($name, "subType", "");
   my $md = AttrVal($name, "model"  , "");
@@ -3718,6 +3728,7 @@ sub CUL_HM_responseSetup($$) {#store all we need to handle the response
       else{
         CUL_HM_respWaitSu ($hash,"cmd:=$cmd","mNo:=$mNo","reSent:=$rss");
       }
+      $hash->{helper}{cSnd} = substr($cmd,8);
     }
     elsif($mTp eq '11' && $chn =~ m/^(02|81)$/){#!!! chn is subtype!!!
 #      CUL_HM_qStateUpdatIfEnab($dst.$subType);# subtype actually is channel
@@ -3727,6 +3738,7 @@ sub CUL_HM_responseSetup($$) {#store all we need to handle the response
         $to = "timedOn:=1";
       }
       CUL_HM_respWaitSu ($hash,"cmd:=$cmd","mNo:=$mNo","reSent:=$rss",$to);
+      $hash->{helper}{cSnd} = substr($cmd,8);
     }
     elsif($mTp eq '12' && $mFlg & 0x10){#wakeup with burst
       # response setup - do not repeat, set counter to 250
@@ -4305,7 +4317,8 @@ sub CUL_HM_id2Name($) { #in: name or HMid out: name
 sub CUL_HM_id2Hash($) {#in: id, out:hash
   my ($id) = @_;
   return $modules{CUL_HM}{defptr}{$id} if ($modules{CUL_HM}{defptr}{$id});
-  return $modules{CUL_HM}{defptr}{substr($id,0,6)}; # could be chn 01 of dev
+  $id = substr($id,0,6);
+  return $modules{CUL_HM}{defptr}{$id}?($modules{CUL_HM}{defptr}{$id}):undef;
 }
 sub CUL_HM_getDeviceHash($) {#in: hash out: devicehash
   my ($hash) = @_;
diff --git a/FHEM/98_HMinfo.pm b/FHEM/98_HMinfo.pm
index 0d9f7d019..161e07ca6 100644
--- a/FHEM/98_HMinfo.pm
+++ b/FHEM/98_HMinfo.pm
@@ -205,7 +205,8 @@ sub HMinfo_peerCheck(@) { #####################################################
 }
 sub HMinfo_burstCheck(@) { ####################################################
   my @entities = @_;
-  my @peerIDsNeed;
+  my @needBurstMiss;
+  my @needBurstFail;
   my @peerIDsCond;
   foreach my $eName (@entities){
     next if (!$defs{$eName}{helper}{role}{chn});#device has no channels
@@ -223,7 +224,10 @@ sub HMinfo_burstCheck(@) { ####################################################
       my $prxt = CUL_HM_getRxType($defs{$pn});
       
       next if (!($prxt & 0x82)); # not a burst peer
-      push @peerIDsNeed," $eName for peer $pn" if (ReadingsVal($eName,"R-$pn-peerNeedsBurst","") !~ m /on/);
+      my $pnb = ReadingsVal($eName,"R-$pn-peerNeedsBurst",undef);
+      if (!$pnb)           {push @needBurstMiss, $eName;}
+      elsif($pnb !~ m /on/){push @needBurstFail, $eName;}
+
       if ($prxt & 0x80){# conditional burst - is it on?
         my $pDevN = CUL_HM_getDeviceName($pn);
         push @peerIDsCond," $pDevN for remote $eName" if (ReadingsVal($pDevN,"R-burstRx","") !~ m /on/);
@@ -231,8 +235,9 @@ sub HMinfo_burstCheck(@) { ####################################################
     }
   }
   my $ret = "";
-  $ret .="\n\n peerNeedsBurst not set"  ."\n    ".(join "\n    ",sort @peerIDsNeed) if(@peerIDsNeed);
-  $ret .="\n\n conditionalBurst not set"."\n    ".(join "\n    ",sort @peerIDsCond) if(@peerIDsCond);
+  $ret .="\n\n peerNeedsBurst cannot be determined"  ."\n    ".(join "\n    ",sort @needBurstMiss) if(@needBurstMiss);
+  $ret .="\n\n peerNeedsBurst not set"               ."\n    ".(join "\n    ",sort @needBurstFail) if(@needBurstFail);
+  $ret .="\n\n conditionalBurst not set"             ."\n    ".(join "\n    ",sort @peerIDsCond)   if(@peerIDsCond);
   return  $ret;
 }
 sub HMinfo_paramCheck(@) { ####################################################
@@ -778,10 +783,13 @@ sub HMinfo_status($){##########################################################
   }
   #--- used for IO, protocol  and communication (e.g. rssi)
   my @IOdev;
-  my %protE  = (NACK =>0,IOerr =>0,ResndFail  =>0,CmdDel  =>0);
+
+  my %protC = (ErrIoId_ =>0,ErrIoAttack =>0);
+  my %protE = (NACK =>0,IOerr =>0,ResndFail =>0,CmdDel =>0);
   my %protW = (Resnd =>0,CmdPend =>0);
-  my @protNamesE;    # devices with current protocol events
-  my @protNamesW;    # devices with current protocol events
+  my @protNamesC;    # devices with current protocol Critical
+  my @protNamesE;    # devices with current protocol Errors
+  my @protNamesW;    # devices with current protocol Warnings
   my @Anames;        # devices with ActionDetector events
   my %rssiMin;
   my %rssiMinCnt = ("99>"=>0,"80>"=>0,"60>"=>0,"59<"=>0);
@@ -811,7 +819,17 @@ sub HMinfo_status($){##########################################################
       $nbrD++;
       push @IOdev,$ehash->{IODev}{NAME} if($ehash->{IODev} && $ehash->{IODev}{NAME});
       push @Anames,$eName if ($attr{$eName}{actStatus} && $attr{$eName}{actStatus} ne "alive");
-      foreach (grep {$ehash->{"prot".$_}} keys %protE){#protocol events reported
+
+      foreach (grep /ErrIoId_/, keys %{$ehash}){# detect addtional critical entries
+        my $k = $_;
+        $k =~ s/^prot//;
+        $protC{$k} = 0 if(!defined $protC{$_});
+      }
+      foreach (grep {$ehash->{"prot".$_}} keys %protC){#protocol critical alarms
+        $protC{$_}++;
+        push @protNamesC,$eName;
+      }
+      foreach (grep {$ehash->{"prot".$_}} keys %protE){#protocol errors
         $protE{$_}++;
         push @protNamesE,$eName;
       }
@@ -861,16 +879,20 @@ sub HMinfo_status($){##########################################################
   # ------- what about protocol events ------
   # Current Events are Rcv,NACK,IOerr,Resend,ResendFail,Snd
   # additional variables are protCmdDel,protCmdPend,protState,protLastRcv
-  my @tp;
-  push @tp,"$_:$protE{$_}" foreach (grep {$protE{$_}} keys(%protE));
-  push @updates,"ERR__protocol:".join",",@tp        if(@tp);
+  my @tpc;
+  push @tpc,"$_:$protC{$_}" foreach (grep {$protC{$_}} keys(%protC));
+  if(@tpc){push @updates,"CRIT__protocol:".join",",@tpc;} else{delete $hash->{READINGS}{CRIT__protocol} };
+  my @tpe;
+  push @tpe,"$_:$protE{$_}" foreach (grep {$protE{$_}} keys(%protE));
+  if(@tpe){push @updates,"ERR__protocol:".join",",@tpe;} else{ delete $hash->{READINGS}{ERR__protocol} };
   my @tpw;
   push @tpw,"$_:$protW{$_}" foreach (grep {$protW{$_}} keys(%protW));
-  push @updates,"W__protocol:".join",",@tpw       if(@tpw);
+  if(@tpw){push @updates,"W__protocol:".join",",@tpw  ;} else{ delete $hash->{READINGS}{W__protocol} };
 
-  @protNamesE = grep !/^$/,HMinfo_noDup(@protNamesE);;
+  @protNamesC = grep !/^$/,HMinfo_noDup(@protNamesC);
+  $hash->{CRI__protoNames} = join",",@protNamesC if(@protNamesC);
+  @protNamesE = grep !/^$/,HMinfo_noDup(@protNamesE);
   $hash->{ERR__protoNames} = join",",@protNamesE if(@protNamesE);
-
   @protNamesW = grep !/^$/,HMinfo_noDup(@protNamesW);
   $hash->{W__protoNames} = join",",@protNamesW if(@protNamesW);