Support morercpthosts.cdb

config now takes an extra "type" parameter.  If it's "map" then a
  reference to a tied hash will be returned.


git-svn-id: https://svn.perl.org/qpsmtpd/trunk@131 958fd67b-6ff1-0310-b445-bb7760255be9

Changes

@@ -1,3 +1,11 @@
+0.26-dev
+
+  Support morercpthosts.cdb
+
+  config now takes an extra "type" parameter.  If it's "map" then a
+  reference to a tied hash will be returned.
+
+
 0.25 - 2003/03/18
 
   Use the proper RFC2822 date format in the Received headers. (Somehow

lib/Qpsmtpd.pm

@@ -1,7 +1,7 @@
 package Qpsmtpd;
 use strict;
 
-$Qpsmtpd::VERSION = "0.25";
+$Qpsmtpd::VERSION = "0.26-dev";
 sub TRACE_LEVEL { 6 }
 
 use Sys::Hostname;
@@ -24,7 +24,7 @@ sub log {
 # database or whatever.
 #
 sub config {
-  my ($self, $c) = @_;
+  my ($self, $c, $type) = @_;
 
   #warn "SELF->config($c) ", ref $self;
 
@@ -37,18 +37,18 @@ sub config {
   @config = () unless $rc == OK;
 
   if (wantarray) {
-      @config = $self->get_qmail_config($c) unless @config;
+      @config = $self->get_qmail_config($c, $type) unless @config;
       @config = @{$defaults{$c}} if (!@config and $defaults{$c});
       return @config;
   } 
   else {
-      return ($config[0] || $self->get_qmail_config($c) || $defaults{$c});
+      return ($config[0] || $self->get_qmail_config($c, $type) || $defaults{$c});
    }
 }
 
 
 sub get_qmail_config {
-  my ($self, $config) = (shift, shift);
+  my ($self, $config, $type) = @_;
   $self->log(8, "trying to get config for $config");
   if ($self->{_config_cache}->{$config}) {
     return wantarray ? @{$self->{_config_cache}->{$config}} : $self->{_config_cache}->{$config}->[0];
@@ -56,7 +56,28 @@ sub get_qmail_config {
   my $configdir = '/var/qmail/control';
   my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
   $configdir = "$name/config" if (-e "$name/config/$config");
-  open CF, "<$configdir/$config" or warn "$$ could not open configfile $config: $!", return;
+
+  my $configfile = "$configdir/$config";
+
+  if ($type and $type eq "map")  {
+    warn "MAP!";
+    return +{} unless -e $configfile;
+    eval { require CDB_File };
+
+    if ($@) {
+      $self->log(0, "No $configfile.cdb support, could not load CDB_File module: $@");
+    }
+    my %h;
+    unless (tie(%h, 'CDB_File', "$configfile.cdb")) {
+      $self->log(0, "tie of $configfile.cdb failed: $!");
+      return DECLINED;
+    }
+    #warn Data::Dumper->Dump([\%h], [qw(h)]);
+    # should we cache this?
+    return \%h;
+  }
+
+  open CF, "<$configfile" or warn "$$ could not open configfile $configfile: $!", return;
   my @config = <CF>;
   chomp @config;
   @config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/} @config;

plugins/check_relay

@@ -28,5 +28,9 @@ sub check_relay {
     return (OK) if $host eq lc $allowed;
     return (OK) if substr($allowed,0,1) eq "." and $host =~ m/\Q$allowed\E$/i;
   }
+
+  my $more_rcpt_hosts = $self->qp->config('morercpthosts', 'map');
+  return (OK) if exists $more_rcpt_hosts->{$host};
+
   return (DENY);
 }

qpsmtpd

@@ -1,4 +1,4 @@
-#!/usr/bin/perl -Tw
+#!/home/perl/bin/perl -Tw
 # Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details.
 # The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/
 #