stop userfile decode/thaw crashes

diff --git a/Changes b/Changes
index dca614a729a424f1fb2a1943ac94b8fbc842e9a5..14be428ba1450df734ef2189070d67b21a8b04f8 100644 (file)
--- 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 <locator> type 
    reports.

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 25672f969d7f8502160b1c941f9490c3f0eb4cf5..c611fac376ca54605fa6967dd6e43d87d68dc787 100644 (file)
--- 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 1031c953eaa9523142c19b8b7ea55faf2c578e0d..d8a75c7f9d78441839642d79e89672b9d6defef9 100644 (file)
--- 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;