Emit detailed warning on unuseable default db dirs

lib/Qpsmtpd/DB/File/DBM.pm

@@ -186,14 +186,41 @@ sub dir {
         return $self->{dir} = $dir;
     }
     return $self->{dir} if $self->{dir};
+    my @err;
     for my $d ( $self->candidate_dirs ) {
         # Ignore invalid directories for static default directories
         my $is_valid;
         eval { $is_valid = $self->validate_dir($d); };
-        next if $@;
+        if ($@) {
-        next if !$is_valid;
+            push @err, $@;
-        return $self->{dir} = $d; # first match wins
+            next;
         }
+        else {
+            $self->{dir} = $d; # first match wins
+            last;
+        }
+    }
+    if ( !$self->{dir} ) {
+        my $err = join "\n",
+          "Unable to find a useable database directory!",
+          "",
+          @err;
+        die $err;
+    }
+    if (@err) {
+        my $err = join "\n",
+          "Encountered errors while selecting database directory:",
+          "",
+          @err,
+          "Selected database directory: $self->{dir}. Data is now stored in:",
+          "",
+          $self->path,
+          "",
+          "It is recommended to manually specify a useable database directory",
+          "and move any important data into this directory.\n";
+        warn $err;
+    }
+    return $self->{dir};
 }
 
 sub candidate_dirs {

t/plugin_tests/greylisting

@@ -358,9 +358,10 @@ sub test_init_dbm {
     my ($self) = @_;
     delete $self->{db};
     delete $self->{_args}{redis};
+    $self->{_args}{db_dir} = 't/tmp';
     $self->init_db;
     is( $self->db->name, 'greylist', 'init_dbm() sets correct db name' );
-    is( $self->db->path, 't/config/greylist.dbm', 'init_dbm() sets correct path' );
+    is( $self->db->path, 't/tmp/greylist.dbm', 'init_dbm() sets correct path' );
     is( ref $self->db, 'Qpsmtpd::DB::File::DBM', 'init_dbm() gives DBM object' );
 }
 

t/qpsmtpd-db-file-dbm.t

@@ -145,6 +145,10 @@ sub __validate_dir {
 
 sub __dir {
     my $db2 = Qpsmtpd::DB::File::DBM->new( name => 'dirtest' );
+    {
+        local $SIG{__WARN__} = sub {
+            warn @_ if $_[0] !~ /selecting database directory/;
+        };
         is( $db2->dir(), 't/config', 'default directory' );
         delete $db2->{dir};
         $db2->candidate_dirs('_invalid','t/Test');
@@ -157,6 +161,37 @@ sub __dir {
         is( $db2->dir, 't/config', 'invalid candidate dirs reverts to default' );
         eval { $db2->dir('_invalid'); };
         is( $@, "DB directory '_invalid' does not exist\n", 'die on invalid dir' );
+    }
+    {
+        delete $db2->{dir};
+        my $warned;
+        local $SIG{__WARN__} = sub {
+            warn @_ if $_[0] !~ /selecting database directory/;
+            $warned .= join '', @_;
+        };
+        $db2->candidate_dirs('_invalid2','t/Test');
+        is( $db2->dir(), 't/Test', 'default directory' );
+        my $expected_warning =
+          "Encountered errors while selecting database directory:
+
+DB directory '_invalid2' does not exist
+
+Selected database directory: t/Test. Data is now stored in:
+
+t/Test/dirtest.dbm
+
+It is recommended to manually specify a useable database directory
+and move any important data into this directory.\n";
+        is( $warned, $expected_warning, 'Emit warning on bad directories' );
+        delete $db2->{dir};
+        $db2->{candidate_dirs} = ['/___invalid___'];
+        my $expected_err =
+          "Unable to find a useable database directory!
+
+DB directory '/___invalid___' does not exist\n";
+        eval { $db2->dir() };
+        is( $@, $expected_err, 'Die on no valid directories' );
+    }
 }
 
 sub __untie_gotcha {