HowTo: Ein einfacher Trick zum exakten Identifizieren von (blocking) Perl Code

[hasselh]

Falls ihr schon immer wissen wolltet, welcher Perl Code (z.B. in den Modulen) blocking Probleme bereitet - also zum temporären Einfrieren der Instanz führt - dann habe ich hier etwas für Euch...

Ja, ich weiß, es gibt freezemon... aber der freezemon macht bei mir gleich mehrere Probleme:

1.    Bei längerer Benutzung von freezemon steigt bei mir der Speicherverbrauch meiner FHEM Instanz über die Zeit linear an (evtl. ein Memory Leak ?)
2.    Die Ausgaben waren bei mir nicht wirklich zielführend, da freezemon nicht die Programmzeile anzeigt, der für den Freeze verantwortlich ist.
3.    Und zu guter Letzt stand bei mir im Log dann häufig nur: possibly caused by: no bad guy found

Nun möchte ich auch nicht einfach https://metacpan.org/pod/Devel::Trace anwerfen, da das Modul (zumindest bei mir) innerhalb von wenigen Sekunden Megabytes an Logs erzeugt. Also habe ich (angeregt durch https://www.effectiveperlprogramming.com/2011/11/trace-your-perl-programs/) einen etwas anderen Weg gewählt. Kurz gesagt: Ich lasse FHEM im debug modus laufen, gebe aber nur den Code im FHEM-Log aus, der mehr als xx Millisekunden benötigt.

Hier die benötigten Schritte (Definition von 3 Shellvariablen und Starten von Perl -d unter dem user fhem):

Code Auswählen Erweitern

# Nur Statements > TRACE_MS protokollieren. Default: Alle
export TRACE_MS=5

# Regex von Ausgaben die herausgefiltert werden. Default: Keine
export TRACE_FILTER=':/usr/|fhem.pl\[733]|DevIo.pm\[116]'

# Trace Logik in DB::DB. Wird durch perl mit Debug Flag aufgerufen
export PERL5DB='
use Time::HiRes qw(time);
use POSIX qw(strftime);

sub DB::DB {
    our $last_t ||= time;

    my $now = time;
    my $delta_ms = ($now - $last_t) * 1000;
    $last_t = $now;

    my ($p, $f, $l) = caller;
    my $code = \@{"::_<$f"};
    my $stmt = our $last_c;
    $last_c = "pid=$$:$f\[$l\]: $code->[$l]" // "";

    my $min_ms = $ENV{TRACE_MS} // 0;
    my $filter = $ENV{TRACE_FILTER};

    return if $delta_ms < $min_ms;
    return if defined $filter && $stmt =~ /$filter/;

    my $ts = strftime("%Y.%m.%d %H:%M:%S", localtime);
    printf STDERR "%s    %.1f ms,%s", $ts, $delta_ms, $stmt;
}
'
# Und jetzt kann man FHEM im -d (debug) Modus starten
cd /opt/fhem; /usr/bin/perl -d fhem.pl fhem.cfg

Die entsprechende Ausgabe findet ihr dann zusätzlich im FHEM log.

Das Debugging läuft bei mir ohne Probleme auf meiner Produktivinstanz - auch über einen langen Zeitraum (Stunden). So lassen sich relativ schnell diejenigen Programmzeilen identifizieren, in denen blocking Perl Aufrufe gemacht werden und wie lange die freezes gedauert haben. libdevel-trace-perl muss hierfür NICHT installiert werden. Die CPU Last von dem FHEM-Prozess steigt bei mir durch das zusätzliche Debugging um den Faktor 4 (das ist kein Wunder, denn DB::DB wird ja für JEDES Perl Statement durchlaufen) und die Antwortzeit steigt um den Faktor 2 (bei mir von 4 auf 8 Millisekunden). Für meinem Raspi 5 mit einem "Zoo" von z.Zt. 146 an FHEM angeschlossenen physischen Geräten ist das überhaupt kein Thema.

Ganz wichtig: Wenn im Log jetzt z.B. ein sleep(1) mit 1000.1 ms Laufzeit auftaucht, heißt das nicht automatisch, dass FHEM in diesem Moment "eingefroren" ist. So kann es gut sein, dass dieser Code innerhalb eines BlockingCall() Aufrufs - also in einem anderen Prozess - ausgeführt wird, der in das gleiche Log schreibt. Hier ist die pid des FHEM Prozesses wichtig. Diese steht im Log unter "Server started [...] pid:". Eine Liste aller potentiell problematischen Aufrufe seit dem letzten Start, erhaltet ihr somit folgendermaßen:

Code Auswählen Erweitern

fhem@fhem:~$ grep 3179486 /opt/fhem/log/fhem-2026-03.log
2026.03.29 13:01:04    175.6 ms,pid=3179486:./FHEM/10_EnOcean.pm[41]: use SetExtensions;
2026.03.29 13:01:05    6.3 ms,pid=3179486:./FHEM/10_IT.pm[20]: use SetExtensions;
2026.03.29 13:01:06    13.7 ms,pid=3179486:./FHEM/50_TelegramBot.pm[238]: use DevIo;
2026.03.29 13:01:06    54.8 ms,pid=3179486:FHEM/HttpUtils.pm[627]:          my $nfound = select($rin, undef, undef, $hash->{timeout}); #blocking
2026.03.29 13:01:06    22.7 ms,pid=3179486:FHEM/HttpUtils.pm[1175]:    my $nfound = select($rout=$rin, undef, undef, $hash->{timeout});
2026.03.29 13:01:06    10.4 ms,pid=3179486:FHEM/GPUtils.pm[89]:    *{$pkg.'::'.$_} = *{'main::'.$_};
2026.03.29 13:01:08    100.1 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:11    3003.0 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:13    2065.4 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:16    3003.0 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:16    16.7 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:16    14.3 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:16    42.5 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:16    49.5 ms,pid=3179486:./FHEM/00_CUL.pm[568]:      my $nfound = select($rin, undef, undef, $to);
2026.03.29 13:01:18    750.1 ms,pid=3179486:./FHEM/00_TCM.pm[146]:  usleep(750 * 1000);
2026.03.29 13:01:20    47.7 ms,pid=3179486:FHEM/HttpUtils.pm[627]:          my $nfound = select($rin, undef, undef, $hash->{timeout}); #blocking
2026.03.29 13:01:21    24.0 ms,pid=3179486:FHEM/HttpUtils.pm[1175]:    my $nfound = select($rout=$rin, undef, undef, $hash->{timeout});
2026.03.29 13:01:21    62.1 ms,pid=3179486:FHEM/HttpUtils.pm[627]:          my $nfound = select($rin, undef, undef, $hash->{timeout}); #blocking
2026.03.29 13:01:21    36.5 ms,pid=3179486:FHEM/HttpUtils.pm[1175]:    my $nfound = select($rout=$rin, undef, undef, $hash->{timeout});
2026.03.29 13:01:21    33.0 ms,pid=3179486:FHEM/HttpUtils.pm[627]:          my $nfound = select($rin, undef, undef, $hash->{timeout}); #blocking
2026.03.29 13:01:21    24.1 ms,pid=3179486:FHEM/HttpUtils.pm[1175]:    my $nfound = select($rout=$rin, undef, undef, $hash->{timeout});
2026.03.29 13:01:21    31.2 ms,pid=3179486:FHEM/HttpUtils.pm[627]:          my $nfound = select($rin, undef, undef, $hash->{timeout}); #blocking
2026.03.29 13:01:21    24.1 ms,pid=3179486:FHEM/HttpUtils.pm[1175]:    my $nfound = select($rout=$rin, undef, undef, $hash->{timeout});
2026.03.29 13:01:22 0: Server started with 269 defined entities (fhem.pl:30719/2026-01-11 perl:5.036000 os:linux user:fhem pid:3179486)

@rudolfkoenig, ich denke man könnte den Start der FHEM Instanz noch um einiges (bei mir um ca.. 8-9 Sekunden - siehe Log) beschleunigen, wenn du beim select() in Zeile 568 in der 00_CUL.pm ein kürzeres Timeout mitgeben könntest, oder besser: Wenn du CUL_ReadAnswer() gleich non-blocking machst. 🙏

hasselh