From fa7bdf4c84e162d43cb6ba5b43f89cc230ebcc30 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 20 Dec 2019 14:38:15 +0000 Subject: [PATCH] stop userfile decode/thaw crashes --- Changes | 2 ++ perl/DXUser.pm | 4 ++-- perl/QSL.pm | 10 +++++++++- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/Changes b/Changes index dca614a7..14be428b 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +21Sep19======================================================================= +1. Harden userfile decode / thaw to stop crashes from corrupt records 10Sep19======================================================================= 1. Improve DXSql database filtering to exclude most via type reports. diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 25672f96..c611fac3 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -247,7 +247,7 @@ sub get # search for it unless ($dbm->get($call, $data)) { - $ref = decode($data); + $ref = eval{decode($data)}; if ($ref) { if (!UNIVERSAL::isa($ref, 'DXUser')) { dbg("DXUser::get: got strange answer from decode of $call". ref $ref. " ignoring"); @@ -255,7 +255,7 @@ sub get } # we have a reference and it *is* a DXUser } else { - dbg("DXUser::get: no reference returned from decode of $call $!"); + dbg("DXUser::get: no reference returned from decode of $call $! $@"); return undef; } $lru->put($call, $ref); diff --git a/perl/QSL.pm b/perl/QSL.pm index 1031c953..d8a75c7f 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -115,9 +115,17 @@ sub get my $r = $dbm->get($key, $value); return undef if $r; - return thaw($value); + my $v; + eval { $v = thaw($value) }; + if ($@) { + LogDbg("Error thawing DXQSL key '$key' (now deleted): $@"); + eval {$dbm->del($key)}; + return undef; + } + return $v; } + sub put { return unless $dbm; -- 2.43.0