semi working plugin stuff

git-svn-id: https://svn.perl.org/qpsmtpd/branches/v010@30 958fd67b-6ff1-0310-b445-bb7760255be9

lib/Qpsmtpd.pm

@@ -5,6 +5,7 @@ use Carp;
 use Qpsmtpd::Connection;
 use Qpsmtpd::Transaction;
 use Qpsmtpd::Constants;
+use Qpsmtpd::Plugin;
 
 use Mail::Address ();
 use Mail::Header ();
@@ -100,7 +101,7 @@ sub fault {
 
 sub start_conversation {
     my $self = shift;
-    $self->respond(220, $self->config('me') ." qpsmtpd ". $self->version ." Service ready, send me all your stuff!");
+    $self->respond(220, $self->config('me') ." ESMTP qpsmtpd ". $self->version ." ready; send us your mail, but not your spam.");
 }
 
 sub transaction {
@@ -170,7 +171,7 @@ sub mail {
       and return $self->respond(450, $from->host ? "Could not resolve ". $from->host : "FQDN required in the envelope sender");
 
     $self->log(2, "getting mail from ".$from->format);
-    $self->respond(250, $from->format . ", sender OK - I always like getting mail from you!");
+    $self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
 
     $self->transaction->sender($from);
   }
@@ -199,7 +200,7 @@ sub rcpt {
   return $self->respond(501, "could not parse recipient") unless $rcpt;
   return $self->respond(550, "will not relay for ". $rcpt->host) unless $self->check_relay($rcpt->host);
   $self->transaction->add_recipient($rcpt);
-  $self->respond(250, $rcpt->format . ", recipient OK");
+  $self->respond(250, $rcpt->format . ", recipient ok");
 }
 
  
@@ -208,9 +209,7 @@ sub check_relay {
   my $host = lc shift;
   my @rcpt_hosts = $self->config("rcpthosts");
   return 1 if exists $ENV{RELAYCLIENT};
-  warn "HOSTTOCHECK: $host";
   for my $allowed (@rcpt_hosts) {
-    warn "ALLOWED: $allowed";
     $allowed =~ s/^\s*(\S+)/$1/;
     return 1 if $host eq lc $allowed;
     return 1 if substr($allowed,0,1) eq "." and $host =~ m/\Q$allowed\E$/i;
@@ -270,7 +269,9 @@ sub rset {
 
 sub quit {
   my $self = shift;
-  $self->respond(221, $self->config('me') . " closing connection. Have a wonderful day");
+  my @fortune = `/usr/games/fortune -s`;
+  @fortune = map { chop; s/^/  \/ /; $_ } @fortune;
+  $self->respond(221, $self->config('me') . " closing connection. Have a wonderful day.", @fortune);
   exit;
 }
 
@@ -390,7 +391,7 @@ sub queue {
     waitpid($child, 0);
     my $exit_code = $? >> 8;
     $exit_code and respond(451, "Unable to queue message ($exit_code)"), exit;
-    $self->respond(250, "Message queued; it better be worth it.");
+    $self->respond(250, "Queued.");
   }
   elsif (defined $child) {
     # Child
@@ -407,4 +408,78 @@ sub queue {
 
 }
 
+
+sub load_plugins {
+  my $self = shift;
+  my @plugins = $self->config('plugins');
+
+  my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
+  my $dir = "$name/plugins";
+  $self->log(2, "loading plugins from $dir");
+
+  for my $plugin (@plugins) {
+    $self->log(3, "Loading $plugin");
+    my $plugin_name = $plugin;
+    # Escape everything into valid perl identifiers
+    $plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
+
+    # second pass cares for slashes and words starting with a digit
+    $plugin_name =~ s{
+		      (/+)       # directory
+		      (\d?)      # package's first character
+		     }[
+		       "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
+		      ]egx;
+
+
+    my $sub;
+    open F, "$dir/$plugin" or die "could not open $dir/$plugin: $!";
+    { 
+      local $/ = undef;
+      $sub = <F>;
+    }
+    close F;
+
+    my $package = "Qpsmtpd::Plugin::$plugin_name";
+
+    warn "PLUGIN PACKAGE: $package";
+
+    my $line = "\n#line 1 $dir/$plugin\n";
+
+    my $eval = join(
+		    "\n",
+		    "package $package;",
+		    "require Qpsmtpd::Plugin;",
+		    'use vars qw(@ISA);',
+		    '@ISA = qw(Qpsmtpd::Plugin);',
+#		    $line,
+		    $sub,
+		    "\n", # last line comment without newline?
+		   );
+
+    warn "eval: $eval";
+
+    $eval =~ m/(.*)/;
+    $eval = $1;
+
+    eval $eval;
+    warn "EVAL: $@";
+    die "eval $@" if $@;
+
+    #my $package_path = $package;
+    #$package_path =~ s!::!/!g;
+    #$package_path .= ".pm";
+    #$INC{$package_path} = "$dir/$plugin";
+    #use Data::Dumper;
+    #warn Data::Dumper->Dump([\%INC, \@INC], [qw(INCh INCa)]);
+
+    my $plug = $package->new();
+    $plug->register();
+
+  }
+
+}
+
+
+
 1;

lib/Qpsmtpd/TcpServer.pm

@@ -18,6 +18,9 @@ sub start_connection {
 sub run {
     my $self = shift;
 
+    # should be somewhere in Qpsmtpd.pm and not here...
+    $self->load_plugins;
+
     $self->start_conversation;
 
     # this should really be the loop and read_input should just get one line; I think
@@ -27,14 +30,15 @@ sub run {
 
 sub read_input {
   my $self = shift;
-  alarm $self->config('timeout');
+  my $timeout = $self->config('timeout');
+  alarm $timeout;
   while (<STDIN>) {
     alarm 0;
     $_ =~ s/\r?\n$//s; # advanced chomp
     $self->log(1, "dispatching $_");
     defined $self->dispatch(split / +/, $_)
       or $self->respond(502, "command unrecognized: '$_'");
-    alarm $self->config('timeout');
+    alarm $timeout;
   }
 }
 

plugins/quit_fortune

@@ -0,0 +1,14 @@
+
+sub new {}
+
+sub register {
+  my ($self, $qp) = @_;
+
+  $qp->register_hook("quit", "quit_handler");
+
+}
+
+sub quit_handler {
+  my ($self, $qp) = @_;
+
+}

qpsmtpd

@@ -58,12 +58,4 @@ sub check_dns {
 }
 
 
-sub load_plugins {
-  my @plugins = get_config('plugins');
-
-  my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
-  my $dir = "$name/plugins";
-  warn "$$ loading plugins from $dir" if $TRACE;
-}
-
 1;