Net/Server/MSVA.pm

   1 #!/usr/bin/perl -wT
   2
   3 # Net::Server implementation for Monkeysphere Validation Agent
   4 # Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 { package Net::Server::MSVA;
  20   use strict;
  21   use base qw(Net::Server::Fork);
  22
  23   my $msva;
  24   # guarantee initial failure -- this will be cleared after we bind
  25   # successfully.
  26   my $exit_status = 13;
  27
  28   sub post_bind_hook {
  29     my $self = shift;
  30     # if we got here, then the binding was successful.
  31     $exit_status = 0;
  32     $msva->post_bind_hook($self, @_);
  33   }
  34
  35   sub pre_loop_hook {
  36     my $self = shift;
  37     $msva->pre_loop_hook($self, @_);
  38   }
  39
  40   sub set_exit_status {
  41     my $self = shift;
  42     $exit_status = shift;
  43   }
  44
  45   # FIXME: this is an override of an undocumented interface of
  46   # Net::Server.  it would be better to use a documented hook, if
  47   # https://rt.cpan.org/Public/Bug/Display.html?id=55485 was resolved
  48   sub delete_child {
  49     my $self = shift;
  50     my $pid = shift;
  51
  52     $msva->child_dies($pid, $self);
  53     $self->SUPER::delete_child($pid, @_);
  54   }
  55
  56   sub server_exit {
  57     my $self = shift;
  58     exit $exit_status;
  59   }
  60
  61   sub run {
  62     my $self = shift;
  63     my $options = { @_ };
  64     if (exists $options->{msva}) {
  65       $msva = $options->{msva};
  66     };
  67     $self->SUPER::run(@_);
  68   }
  69
  70   1;
  71 }