diff --git a/fhem/FHEM/98_freezemon.pm b/fhem/FHEM/98_freezemon.pm index ae66965f9..453be9476 100644 --- a/fhem/FHEM/98_freezemon.pm +++ b/fhem/FHEM/98_freezemon.pm @@ -22,8 +22,11 @@ # ############################################################################## # Changelog: +# 0.0.17: fixed Warning when fm_logFile is not maintained +# Freeze-Handling non-blocking +# New attribute fm_whitelistSub # 0.0.16: Minor Logging changes -# AUto-delete Logfiles via fm_logKeep +# Auto-delete Logfiles via fm_logKeep # 0.0.15: New InternalTimer Handling (#81365) - Thanks to Ansgar (noansi) # New logging function (fm_logFile, fm_logExtraSeconds) incl. get function - Thanks Andy (gandy) # Fixed unescaped characters in commandref (helmut, #84992) @@ -79,8 +82,9 @@ use POSIX; use Time::HiRes qw(gettimeofday); use Time::HiRes qw(tv_interval); use B qw(svref_2object); +use Blocking; -my $version = "0.0.16"; +my $version = "0.0.17"; my @logqueue = (); ################################### @@ -91,7 +95,7 @@ sub freezemon_Initialize($) { # Module specific attributes my @freezemon_attr = ( -"fm_forceApptime:0,1 fm_freezeThreshold disable:0,1 fm_log fm_ignoreDev fm_ignoreMode:off,single,all fm_extDetail:0,1 fm_logExtraSeconds fm_logFile fm_logKeep" +"fm_forceApptime:0,1 fm_freezeThreshold disable:0,1 fm_log fm_ignoreDev fm_ignoreMode:off,single,all fm_extDetail:0,1 fm_logExtraSeconds fm_logFile fm_logKeep fm_whitelistSub" ); $hash->{GetFn} = "freezemon_Get"; @@ -151,6 +155,7 @@ sub freezemon_Undefine($$) { my ( $hash, $name ) = @_; RemoveInternalTimer($hash); + BlockingKill( $hash->{helper}{blocking}{pid} ) if ( defined( $hash->{helper}{blocking}{pid} ) ); return undef; } @@ -166,6 +171,34 @@ sub freezemon_Notify($$) { freezemon_start($hash); } +################################### +sub freezemon_processFreeze($) { + + #my ($name) = @_; + my ($hash) = @_; + my $name = $hash->{NAME}; + + #my $hash = $defs{$name}; + my $log = freezemon_dump_log( $hash, $hash->{helper}{TIMER}, $hash->{helper}{msg} ); + + return $name; +} +################################### +sub freezemon_freezeDone($) { + my ($name) = @_; + my $hash = $defs{$name}; + Log3 $name, 5, "[Freezemon] $name: Blocking Call with PID $hash->{helper}{blocking}{pid} ended"; + delete( $hash->{helper}{blocking} ); +} + +################################### +sub freezemon_freezeAbort($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + Log3 $name, 3, "[Freezemon] $name: Blocking Call with PID $hash->{helper}{blocking}{pid} aborted due to timeout"; + delete( $hash->{helper}{blocking} ); +} + ################################### sub freezemon_ProcessTimer($) { my ($hash) = @_; @@ -178,6 +211,12 @@ sub freezemon_ProcessTimer($) { #Check Freezes if ( $freeze > AttrVal( $name, "fm_freezeThreshold", 1 ) ) { + delete $hash->{helper}{logqueue}; + $hash->{helper}{logqueue} = \@logqueue; + $hash->{helper}{now} = $now; + $hash->{helper}{freeze} = $freeze; + my $now = $hash->{helper}{now}; + my $freeze = $hash->{helper}{freeze}; my ( $seconds, $microseconds ) = gettimeofday(); my $t0 = [gettimeofday]; my @t = localtime($seconds); @@ -277,12 +316,21 @@ sub freezemon_ProcessTimer($) { } # Create Log( - my $msg = strftime( - "[Freezemon] $name: possible freeze starting at %H:%M:%S, delay is $freeze possibly caused by $dev", + $hash->{helper}{msg} = + strftime( + "[Freezemon] $name: possible freeze starting at %H:%M:%S, delay is $freeze possibly caused by: $dev", localtime( $hash->{helper}{TIMER} ) ); - my $log = freezemon_dump_log( $hash, $hash->{helper}{TIMER}, $msg ); - Log3 $name, $loglevel, $msg; + my @t = localtime($seconds); + my $log = ResolveDateWildcards( AttrVal( $name, "fm_logFile", undef ), @t ); + $hash->{helper}{logfile} = $log; + + $hash->{helper}{blocking} = + BlockingCall( "freezemon_processFreeze", $hash, "freezemon_freezeDone", 300, "freezemon_freezeAbort", + $hash ); + Log3 $name, 5, "[Freezemon] $name: Blocking Call started with PID " . $hash->{helper}{blocking}{pid}; + + Log3 $name, $loglevel, $hash->{helper}{msg}; # Build hash with 20 last freezes my @freezes = (); @@ -323,7 +371,6 @@ sub freezemon_ProcessTimer($) { ); my $ms = tv_interval($t0); Log3 $name, 5, "[Freezemon] $name: ----------- Ending Freeze handling at $tim after $ms --------"; - } freezemon_purge_log_before( $hash, $hash->{helper}{TIMER} - AttrVal( $name, "fm_logExtraSeconds", 0 ) ) if ( AttrVal( $name, "fm_logFile", "" ) ne "" ); @@ -380,8 +427,8 @@ sub freezemon_ProcessTimer($) { ################################### sub freezemon_Set($@) { my ( $hash, $name, $cmd, @args ) = @_; - my $usage = "Unknown argument $cmd, choose one of active:noArg inactive:noArg clear:noArg"; - + my $usage = "Unknown argument $cmd, choose one of active:noArg inactive:noArg clear:noArg"; + return "\"set $name\" needs at least one argument" unless ( defined($cmd) ); if ( $cmd eq "inactive" ) { @@ -426,7 +473,7 @@ sub freezemon_Get($@) { my $ret = ""; my $usage = 'Unknown argument $a[1], choose one of freeze:noArg log:'; - return "\"get $name\" needs at least one argument" unless ( defined($a[1]) ); + return "\"get $name\" needs at least one argument" unless ( defined( $a[1] ) ); #get the logfiles my @fl = freezemon_getLogFiles($name); @@ -517,7 +564,7 @@ sub freezemon_Attr($) { } } elsif ( $aName eq "fm_logKeep" ) { - if ( !looks_like_number($aVal) or $aVal <= 0) { + if ( !looks_like_number($aVal) or $aVal <= 0 ) { return "Attribute " . $aName . " has to be a number > 0"; } @@ -613,6 +660,8 @@ sub freezemon_apptime($) { my $n = int(@intAtA); # @intAtA is sorted ascending by time my $i = -1; + my %blacklist = map { $_ => 1 } split( ",", AttrVal( $name, "fm_whitelistSub", "" ) ); + #foreach my $i (@intAtSort) { while ( ++$i < $n ) { @@ -631,6 +680,8 @@ sub freezemon_apptime($) { #$fn = $intAt{$i}{FN}; $fn = $intAtA[$i]->{FN}; + next if exists( $blacklist{$fn} ); + if ( ref($fn) ne "" ) { $cv = svref_2object($fn); $fnname = $cv->GV->NAME; @@ -653,14 +704,15 @@ sub freezemon_apptime($) { if ( AttrVal( $name, "fm_extDetail", 0 ) == 1 ) { if ( $fn eq "BlockingKill" or $fn eq "BlockingStart" ) { $shortarg = $shortarg->{abortArg}{NAME}; - Log3 $name, 5, "[Freezemon] $name found $fn " . Dumper($shortarg); } elsif ( $fn eq "HttpUtils_Err" ) { - $shortarg = $shortarg->{hash}{hash}{NAME}; + if ( defined( $shortarg->{hash}{hash}{NAME} ) ) { + $shortarg = $shortarg->{hash}{hash}{NAME}; + } + } + elsif ( $fn = "FileLog_dailySwitch" ) { + $shortarg = $shortarg->{NotifyFn}; } - elsif ( $fn="FileLog_dailySwitch") { - $shortarg = $shortarg->{NotifyFn}; - } else { Log3 $name, 5, "[Freezemon] $name found something without a name $fn" . Dumper($shortarg); $shortarg = "N/A"; @@ -687,7 +739,7 @@ sub freezemon_apptime($) { #Log3 $name, 3, "[Freezemon] $name found something that's not a HASH $fn ".ref($shortarg)." ".Dumper($shortarg); $shortarg = "N/A"; } - if ( !$shortarg ) { + if ( !defined($shortarg) ) { Log3 $name, 5, "Freezemon: something went wrong $fn " . Dumper($arg); $shortarg = ""; } @@ -791,22 +843,24 @@ sub freezemon_purge_log_before($$) { ################################### sub freezemon_dump_log($$$) { my ( $hash, $start, $msg ) = @_; - return unless scalar @logqueue; - my $name = $hash->{NAME}; + my $name = $hash->{NAME}; + my @queue = @{ $hash->{helper}{logqueue} }; + + return unless scalar @queue; my ( $seconds, $microseconds ) = gettimeofday(); - my @t = localtime($seconds); - my $currlogfile = ResolveDateWildcards( AttrVal( $name, "fm_logFile", undef ), @t ); + + my $currlogfile = $hash->{helper}{logfile}; return unless defined($currlogfile) && $currlogfile ne ""; - Log3 $hash, 3, "[Freezemon] $name: dumping " . ( scalar @logqueue ) . " log entries to $currlogfile"; + Log3 $hash, 3, "[Freezemon] $name: dumping " . ( scalar @queue ) . " log entries to $currlogfile"; open( fm_LOG, ">>$currlogfile" ) || return ("Can't open $currlogfile: $!"); print fm_LOG "=========================================================\n"; print fm_LOG $msg . "\n"; my $last_ts; - foreach my $entry (@logqueue) { + foreach my $entry (@queue) { my ( $ts, $dev, $loglevel, $text ) = @$entry; my $seconds = int($ts); my $microseconds = int( 1e6 * ( $ts - $seconds ) ); @@ -834,6 +888,7 @@ sub freezemon_dump_log($$$) { ################################### sub freezemon_logLink($$) { my ( $name, $link ) = @_; + return "" if !$link; my $ret = " [Log]"; return $ret; } @@ -950,6 +1005,7 @@ sub freezemon_getLogPath($) {