From b771b26d08157645d6b439926ecb7d23af613465 Mon Sep 17 00:00:00 2001 From: Matt Simerson Date: Thu, 16 Jan 2025 11:05:09 -0800 Subject: [PATCH] remove Qpsmtpd::ConfigServer --- MANIFEST | 1 - lib/Qpsmtpd/ConfigServer.pm | 303 ------------------------------------ xt/01-syntax.t | 4 - 3 files changed, 308 deletions(-) delete mode 100644 lib/Qpsmtpd/ConfigServer.pm diff --git a/MANIFEST b/MANIFEST index a38bb014..402fde1e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -41,7 +41,6 @@ lib/Qpsmtpd/Auth.pm lib/Qpsmtpd/Base.pm lib/Qpsmtpd/Command.pm lib/Qpsmtpd/Config.pm -lib/Qpsmtpd/ConfigServer.pm lib/Qpsmtpd/Connection.pm lib/Qpsmtpd/Constants.pm lib/Qpsmtpd/DB.pm diff --git a/lib/Qpsmtpd/ConfigServer.pm b/lib/Qpsmtpd/ConfigServer.pm deleted file mode 100644 index f2127fe2..00000000 --- a/lib/Qpsmtpd/ConfigServer.pm +++ /dev/null @@ -1,303 +0,0 @@ -package Qpsmtpd::ConfigServer; - -use base ('Danga::Client'); -use Qpsmtpd::Constants; - -use strict; - -use fields qw( - _auth - _commands - _config_cache - _connection - _transaction - _test_mode - _extras - other_fds - ); - -my $PROMPT = "Enter command: "; - -sub new { - my Qpsmtpd::ConfigServer $self = shift; - - $self = fields::new($self) unless ref $self; - $self->SUPER::new(@_); - $self->write($PROMPT); - return $self; -} - -sub max_idle_time { 3600 } # one hour - -sub process_line { - my $self = shift; - my $line = shift || return; - if ($::DEBUG > 1) { print "$$:" . ($self + 0) . "C($self->{mode}): $line"; } - local $SIG{ALRM} = sub { - my ($pkg, $file, $line) = caller(); - die "ALARM: $pkg, $file, $line"; - }; - my $prev = alarm(2); # must process a command in < 2 seconds - my $resp = eval { $self->_process_line($line) }; - alarm($prev); - if ($@) { - print STDERR "Error: $@\n"; - } - return $resp || ''; -} - -sub respond { - my $self = shift; - my (@messages) = @_; - while (my $msg = shift @messages) { - $self->write("$msg\r\n"); - } - return; -} - -sub fault { - my $self = shift; - my ($msg) = shift || "program fault - command not performed"; - print STDERR "$0 [$$]: $msg\n"; - print STDERR $name, "[$$]: Last system error: $!" - ." (Likely irelevant--debug the crashed plugin to ensure it handles \$! properly)"; - $self->respond("Error - " . $msg); - return $PROMPT; -} - -sub _process_line { - my $self = shift; - my $line = shift; - - $line =~ s/\r?\n//; - my ($cmd, @params) = split(/ +/, $line); - my $meth = "cmd_" . lc($cmd); - if (my $lookup = $self->can($meth)) { - my $resp = eval { $lookup->($self, @params); }; - if ($@) { - my $error = $@; - chomp($error); - Qpsmtpd->log(LOGERROR, "Command Error: $error"); - return $self->fault("command '$cmd' failed unexpectedly"); - } - return "$resp\n$PROMPT"; - } - else { - # No such method - i.e. unrecognized command - return $self->fault("command '$cmd' unrecognised"); - } -} - -my %helptext = ( - help => "HELP [CMD] - Get help on all commands or a specific command", - status => "STATUS - Returns status information about current connections", - list => -"LIST [LIMIT] - List the connections, specify limit or negative limit to shrink list", - kill => -"KILL (\$IP | \$REF) - Disconnect all connections from \$IP or connection reference \$REF", - pause => "PAUSE - Stop accepting new connections", - continue => "CONTINUE - Resume accepting connections", - reload => "RELOAD - Reload all plugins and config", - quit => "QUIT - Exit the config server", -); - -sub cmd_help { - my $self = shift; - my ($subcmd) = @_; - - $subcmd ||= 'help'; - $subcmd = lc($subcmd); - - if ($subcmd eq 'help') { - my $txt = join("\n", - map { substr($_, 0, index($_, "-")) } - sort values(%helptext)); - return "Available Commands:\n\n$txt\n"; - } - my $txt = $helptext{$subcmd} - || "Unrecognised help option. Try 'help' for a full list."; - return "$txt\n"; -} - -sub cmd_quit { - my $self = shift; - $self->close; -} - -sub cmd_shutdown { - exit; -} - -sub cmd_pause { - my $self = shift; - - my $other_fds = $self->OtherFds; - - $self->{other_fds} = {%$other_fds}; - %$other_fds = (); - return "PAUSED"; -} - -sub cmd_continue { - my $self = shift; - - my $other_fds = $self->{other_fds}; - - $self->OtherFds(%$other_fds); - %$other_fds = (); - return "UNPAUSED"; -} - -sub cmd_status { - my $self = shift; - - # Status should show: - # - Total time running - # - Total number of mails received - # - Total number of mails rejected (5xx) - # - Total number of mails tempfailed (5xx) - # - Avg number of mails/minute - # - Number of current connections - # - Number of outstanding DNS queries - - my $output = "Current Status as of " . gmtime() . " GMT\n\n"; - - if (defined &Qpsmtpd::Plugin::stats::get_stats) { - - # Stats plugin is loaded - $output .= Qpsmtpd::Plugin::stats->get_stats; - } - - my $descriptors = Danga::Socket->DescriptorMap; - - my $current_connections = 0; - my $current_dns = 0; - foreach my $fd (keys %$descriptors) { - my $pob = $descriptors->{$fd}; - if ($pob->isa("Qpsmtpd::PollServer")) { - $current_connections++; - } - elsif ($pob->isa("ParaDNS::Resolver")) { - $current_dns = $pob->pending; - } - } - - $output .= "Curr Connections: $current_connections / $::MAXconn\n" - . "Curr DNS Queries: $current_dns"; - - return $output; -} - -sub cmd_list { - my $self = shift; - my ($count) = @_; - - my $descriptors = Danga::Socket->DescriptorMap; - - my $list = - "Current" - . ($count ? (($count > 0) ? " Oldest $count" : " Newest " . -$count) : "") - . " Connections: \n\n"; - my @all; - foreach my $fd (keys %$descriptors) { - my $pob = $descriptors->{$fd}; - if ($pob->isa("Qpsmtpd::PollServer")) { - next unless $pob->connection->remote_ip; # haven't even started yet - push @all, - [ - $pob + 0, $pob->connection->remote_ip, - $pob->connection->remote_host, $pob->uptime - ]; - } - } - - @all = sort { $a->[3] <=> $b->[3] } @all; - if ($count) { - if ($count > 0) { - @all = @all[$#all - ($count - 1) .. $#all]; - } - else { - @all = @all[0 .. (abs($count) - 1)]; - } - } - foreach my $item (@all) { - $list .= sprintf("%x : %s [%s] Connected %0.2fs\n", - map { defined() ? $_ : '' } @$item); - } - - return $list; -} - -sub cmd_kill { - my $self = shift; - my ($match) = @_; - - return "SYNTAX: KILL (\$IP | \$REF)\n" unless $match; - - my $descriptors = Danga::Socket->DescriptorMap; - - my $killed = 0; - my $is_ip = (index($match, '.') >= 0); - foreach my $fd (keys %$descriptors) { - my $pob = $descriptors->{$fd}; - if ($pob->isa("Qpsmtpd::PollServer")) { - if ($is_ip) { - next - unless $pob->connection->remote_ip; # haven't even started yet - if ($pob->connection->remote_ip eq $match) { - $pob->write( -"550 Your connection has been killed by an administrator\r\n"); - $pob->disconnect; - $killed++; - } - } - else { - # match by ID - if ($pob + 0 == hex($match)) { - $pob->write( -"550 Your connection has been killed by an administrator\r\n"); - $pob->disconnect; - $killed++; - } - } - } - } - - return "Killed $killed connection" . ($killed > 1 ? "s" : "") . "\n"; -} - -sub cmd_dump { - my $self = shift; - my ($ref) = @_; - - return "SYNTAX: DUMP \$REF\n" unless $ref; - require Data::Dumper; - $Data::Dumper::Indent = 1; - - my $descriptors = Danga::Socket->DescriptorMap; - foreach my $fd (keys %$descriptors) { - my $pob = $descriptors->{$fd}; - if ($pob->isa("Qpsmtpd::PollServer")) { - if ($pob + 0 == hex($ref)) { - return Data::Dumper::Dumper($pob); - } - } - } - - return "Unable to find the connection: $ref. Try the LIST command\n"; -} - -1; -__END__ - -=head1 NAME - -Qpsmtpd::ConfigServer - a configuration server for qpsmtpd - -=head1 DESCRIPTION - -When qpsmtpd runs in multiplex mode it also provides a config server that you -can connect to. This allows you to view current connection statistics and other -gumph that you probably don't care about. - -=cut diff --git a/xt/01-syntax.t b/xt/01-syntax.t index 842b9715..50d687b9 100644 --- a/xt/01-syntax.t +++ b/xt/01-syntax.t @@ -31,10 +31,6 @@ sub test_syntax { ok(0 == 0, "skipping $f, I couldn't load w/o $1"); return; } - if ($r =~ /^Base class package "Danga::Socket" is empty/) { - ok(0 == 0, "skipping $f, Danga::Socket not available."); - return; - } print "ec: $exit_code, r: $r\n"; }