Initial work for continuations (and thus the async server).

(intention is to check bits in that don't break anything, so we can
always return to a stable base)


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

lib/Qpsmtpd.pm

@@ -344,55 +344,88 @@ sub run_hooks {
   my $hooks = $self->{hooks};
   if ($hooks->{$hook}) {
     my @r;
-    for my $code (@{$hooks->{$hook}}) {
-      if ( $hook eq 'logging' ) { # without calling $self->log()
-        eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
-        $@ and warn("FATAL LOGGING PLUGIN ERROR: ", $@) and next;
+    my @local_hooks = @{$hooks->{$hook}};
+    $self->{_continuation} = [$hook, [@_], @local_hooks];
+    return $self->run_continuation();
+  }
+  return (0, '');
+}
+
+sub run_continuation {
+  my $self = shift;
+  die "No continuation in progress" unless $self->{_continuation};
+  $self->continue_read() if $self->isa('Danga::Client');
+  my $todo = $self->{_continuation};
+  $self->{_continuation} = undef;
+  my $hook = shift @$todo || die "No hook in the continuation";
+  my $args = shift @$todo || die "No hook args in the continuation";
+  my @r;
+  while (@$todo) {
+    my $code = shift @$todo;
+    if ( $hook eq 'logging' ) { # without calling $self->log()
+      eval { (@r) = $code->{code}->($self, $self->transaction, @$args); };
+      $@ and warn("FATAL LOGGING PLUGIN ERROR: ", $@) and next;
+    }
+    else {
+      $self->varlog(LOGINFO, $hook, $code->{name});
+      eval { (@r) = $code->{code}->($self, $self->transaction, @$args); };
+      $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
+
+      !defined $r[0]
+        and $self->log(LOGERROR, "plugin ".$code->{name}
+                       ." running the $hook hook returned undef!")
+        and next;
+
+      if ($self->transaction) {
+        my $tnotes = $self->transaction->notes( $code->{name} );
+        $tnotes->{"hook_$hook"}->{'return'} = $r[0]
+          if (!defined $tnotes || ref $tnotes eq "HASH");
       }
       else {
-        $self->varlog(LOGINFO, $hook, $code->{name});
-        eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
-        $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
-
-        !defined $r[0]
-          and $self->log(LOGERROR, "plugin ".$code->{name}
-                         ." running the $hook hook returned undef!")
-          and next;
-
-        if ($self->transaction) {
-          my $tnotes = $self->transaction->notes( $code->{name} );
-          $tnotes->{"hook_$hook"}->{'return'} = $r[0]
-            if (!defined $tnotes || ref $tnotes eq "HASH");
-        } else {
-          my $cnotes = $self->connection->notes( $code->{name} );
-          $cnotes->{"hook_$hook"}->{'return'} = $r[0]
-            if (!defined $cnotes || ref $cnotes eq "HASH");
-        }
-
-        # should we have a hook for "OK" too?
-        if ($r[0] == DENY or $r[0] == DENYSOFT or
-            $r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT)
-        {
-          $r[1] = "" if not defined $r[1];
-          $self->log(LOGDEBUG, "Plugin ".$code->{name}.
+        my $cnotes = $self->connection->notes( $code->{name} );
+        $cnotes->{"hook_$hook"}->{'return'} = $r[0]
+          if (!defined $cnotes || ref $cnotes eq "HASH");
+      }
+
+      if ($r[0] == YIELD) {
+        $self->pause_read() if $self->isa('Danga::Client');
+        $self->{_continuation} = [$hook, $args, @$todo];
+        return @r;
+      }
+      elsif ($r[0] == DENY or $r[0] == DENYSOFT or
+          $r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT)
+      {
+        $r[1] = "" if not defined $r[1];
+        $self->log(LOGDEBUG, "Plugin ".$code->{name}.
 	    ", hook $hook returned ".return_code($r[0]).", $r[1]");
-          $self->run_hooks("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
-        } else {
-          $r[1] = "" if not defined $r[1];
-          $self->log(LOGDEBUG, "Plugin ".$code->{name}.
+        $self->run_hooks("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
+      }
+      else {
+        $r[1] = "" if not defined $r[1];
+        $self->log(LOGDEBUG, "Plugin ".$code->{name}.
 	    ", hook $hook returned ".return_code($r[0]).", $r[1]");
-          $self->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
-	}
-
+        $self->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
       }
 
-      last unless $r[0] == DECLINED;
     }
-    $r[0] = DECLINED if not defined $r[0];
-    @r = map { split /\n/ } @r;
-    return @r;
+
+    last unless $r[0] == DECLINED;
   }
-  return (0, '');
+  $r[0] = DECLINED if not defined $r[0];
+  @r = map { split /\n/ } @r;
+  return $self->hook_responder($hook, \@r, $args);
+}
+
+sub hook_responder {
+  my ($self, $hook, $msg, $args) = @_;
+
+  my $code = shift @$msg;
+
+  my $responder = $hook . '_respond';
+  if (my $meth = $self->can($responder)) {
+    return $meth->($self, $code, $msg, @$args);
+  }
+  return $code, @$msg;
 }
 
 sub _register_hook {

lib/Qpsmtpd/Constants.pm

@@ -17,14 +17,16 @@ my %log_levels = (
 
 # return codes
 my %return_codes = (
-	OK       => 900,
-	DENY     => 901,   # 550
-	DENYSOFT => 902,   # 450
-	DENYHARD => 903,   # 550 + disconnect  (deprecated in 0.29)
-	DENY_DISCONNECT     => 903, # 550 + disconnect
-	DENYSOFT_DISCONNECT => 904, # 450 + disconnect
-	DECLINED => 909,
-	DONE     => 910,
+	OK                     => 900,
+	DENY                   => 901,   # 550
+	DENYSOFT               => 902,   # 450
+	DENYHARD               => 903,   # 550 + disconnect  (deprecated in 0.29)
+	DENY_DISCONNECT        => 903,   # 550 + disconnect
+	DENYSOFT_DISCONNECT    => 904,   # 450 + disconnect
+	DECLINED               => 909,
+	DONE                   => 910,
+	CONTINUATION           => 911,   # deprecated - use YIELD
+	YIELD                  => 911,
 );
 
 my $has_ipv6;