1package Qpsmtpd::ConfigServer; 2 3use base ('Danga::Client'); 4use Qpsmtpd::Constants; 5 6use strict; 7 8use fields qw( 9 _auth 10 _commands 11 _config_cache 12 _connection 13 _transaction 14 _test_mode 15 _extras 16 other_fds 17 ); 18 19my $PROMPT = "Enter command: "; 20 21sub new { 22 my Qpsmtpd::ConfigServer $self = shift; 23 24 $self = fields::new($self) unless ref $self; 25 $self->SUPER::new(@_); 26 $self->write($PROMPT); 27 return $self; 28} 29 30sub max_idle_time { 3600 } # one hour 31 32sub process_line { 33 my $self = shift; 34 my $line = shift || return; 35 if ($::DEBUG > 1) { print "$$:" . ($self + 0) . "C($self->{mode}): $line"; } 36 local $SIG{ALRM} = sub { 37 my ($pkg, $file, $line) = caller(); 38 die "ALARM: $pkg, $file, $line"; 39 }; 40 my $prev = alarm(2); # must process a command in < 2 seconds 41 my $resp = eval { $self->_process_line($line) }; 42 alarm($prev); 43 if ($@) { 44 print STDERR "Error: $@\n"; 45 } 46 return $resp || ''; 47} 48 49sub respond { 50 my $self = shift; 51 my (@messages) = @_; 52 while (my $msg = shift @messages) { 53 $self->write("$msg\r\n"); 54 } 55 return; 56} 57 58sub fault { 59 my $self = shift; 60 my ($msg) = shift || "program fault - command not performed"; 61 print STDERR "$0 [$$]: $msg ($!)\n"; 62 $self->respond("Error - " . $msg); 63 return $PROMPT; 64} 65 66sub _process_line { 67 my $self = shift; 68 my $line = shift; 69 70 $line =~ s/\r?\n//; 71 my ($cmd, @params) = split(/ +/, $line); 72 my $meth = "cmd_" . lc($cmd); 73 if (my $lookup = $self->can($meth)) { 74 my $resp = eval { $lookup->($self, @params); }; 75 if ($@) { 76 my $error = $@; 77 chomp($error); 78 Qpsmtpd->log(LOGERROR, "Command Error: $error"); 79 return $self->fault("command '$cmd' failed unexpectedly"); 80 } 81 return "$resp\n$PROMPT"; 82 } 83 else { 84 # No such method - i.e. unrecognized command 85 return $self->fault("command '$cmd' unrecognised"); 86 } 87} 88 89my %helptext = ( 90 help => "HELP [CMD] - Get help on all commands or a specific command", 91 status => "STATUS - Returns status information about current connections", 92 list => 93"LIST [LIMIT] - List the connections, specify limit or negative limit to shrink list", 94 kill => 95"KILL (\$IP | \$REF) - Disconnect all connections from \$IP or connection reference \$REF", 96 pause => "PAUSE - Stop accepting new connections", 97 continue => "CONTINUE - Resume accepting connections", 98 reload => "RELOAD - Reload all plugins and config", 99 quit => "QUIT - Exit the config server", 100); 101 102sub cmd_help { 103 my $self = shift; 104 my ($subcmd) = @_; 105 106 $subcmd ||= 'help'; 107 $subcmd = lc($subcmd); 108 109 if ($subcmd eq 'help') { 110 my $txt = join("\n", 111 map { substr($_, 0, index($_, "-")) } 112 sort values(%helptext)); 113 return "Available Commands:\n\n$txt\n"; 114 } 115 my $txt = $helptext{$subcmd} 116 || "Unrecognised help option. Try 'help' for a full list."; 117 return "$txt\n"; 118} 119 120sub cmd_quit { 121 my $self = shift; 122 $self->close; 123} 124 125sub cmd_shutdown { 126 exit; 127} 128 129sub cmd_pause { 130 my $self = shift; 131 132 my $other_fds = $self->OtherFds; 133 134 $self->{other_fds} = {%$other_fds}; 135 %$other_fds = (); 136 return "PAUSED"; 137} 138 139sub cmd_continue { 140 my $self = shift; 141 142 my $other_fds = $self->{other_fds}; 143 144 $self->OtherFds(%$other_fds); 145 %$other_fds = (); 146 return "UNPAUSED"; 147} 148 149sub cmd_status { 150 my $self = shift; 151 152 # Status should show: 153 # - Total time running 154 # - Total number of mails received 155 # - Total number of mails rejected (5xx) 156 # - Total number of mails tempfailed (5xx) 157 # - Avg number of mails/minute 158 # - Number of current connections 159 # - Number of outstanding DNS queries 160 161 my $output = "Current Status as of " . gmtime() . " GMT\n\n"; 162 163 if (defined &Qpsmtpd::Plugin::stats::get_stats) { 164 165 # Stats plugin is loaded 166 $output .= Qpsmtpd::Plugin::stats->get_stats; 167 } 168 169 my $descriptors = Danga::Socket->DescriptorMap; 170 171 my $current_connections = 0; 172 my $current_dns = 0; 173 foreach my $fd (keys %$descriptors) { 174 my $pob = $descriptors->{$fd}; 175 if ($pob->isa("Qpsmtpd::PollServer")) { 176 $current_connections++; 177 } 178 elsif ($pob->isa("ParaDNS::Resolver")) { 179 $current_dns = $pob->pending; 180 } 181 } 182 183 $output .= "Curr Connections: $current_connections / $::MAXconn\n" 184 . "Curr DNS Queries: $current_dns"; 185 186 return $output; 187} 188 189sub cmd_list { 190 my $self = shift; 191 my ($count) = @_; 192 193 my $descriptors = Danga::Socket->DescriptorMap; 194 195 my $list = 196 "Current" 197 . ($count ? (($count > 0) ? " Oldest $count" : " Newest " . -$count) : "") 198 . " Connections: \n\n"; 199 my @all; 200 foreach my $fd (keys %$descriptors) { 201 my $pob = $descriptors->{$fd}; 202 if ($pob->isa("Qpsmtpd::PollServer")) { 203 next unless $pob->connection->remote_ip; # haven't even started yet 204 push @all, 205 [ 206 $pob + 0, $pob->connection->remote_ip, 207 $pob->connection->remote_host, $pob->uptime 208 ]; 209 } 210 } 211 212 @all = sort { $a->[3] <=> $b->[3] } @all; 213 if ($count) { 214 if ($count > 0) { 215 @all = @all[$#all - ($count - 1) .. $#all]; 216 } 217 else { 218 @all = @all[0 .. (abs($count) - 1)]; 219 } 220 } 221 foreach my $item (@all) { 222 $list .= sprintf("%x : %s [%s] Connected %0.2fs\n", 223 map { defined() ? $_ : '' } @$item); 224 } 225 226 return $list; 227} 228 229sub cmd_kill { 230 my $self = shift; 231 my ($match) = @_; 232 233 return "SYNTAX: KILL (\$IP | \$REF)\n" unless $match; 234 235 my $descriptors = Danga::Socket->DescriptorMap; 236 237 my $killed = 0; 238 my $is_ip = (index($match, '.') >= 0); 239 foreach my $fd (keys %$descriptors) { 240 my $pob = $descriptors->{$fd}; 241 if ($pob->isa("Qpsmtpd::PollServer")) { 242 if ($is_ip) { 243 next 244 unless $pob->connection->remote_ip; # haven't even started yet 245 if ($pob->connection->remote_ip eq $match) { 246 $pob->write( 247"550 Your connection has been killed by an administrator\r\n"); 248 $pob->disconnect; 249 $killed++; 250 } 251 } 252 else { 253 # match by ID 254 if ($pob + 0 == hex($match)) { 255 $pob->write( 256"550 Your connection has been killed by an administrator\r\n"); 257 $pob->disconnect; 258 $killed++; 259 } 260 } 261 } 262 } 263 264 return "Killed $killed connection" . ($killed > 1 ? "s" : "") . "\n"; 265} 266 267sub cmd_dump { 268 my $self = shift; 269 my ($ref) = @_; 270 271 return "SYNTAX: DUMP \$REF\n" unless $ref; 272 require Data::Dumper; 273 $Data::Dumper::Indent = 1; 274 275 my $descriptors = Danga::Socket->DescriptorMap; 276 foreach my $fd (keys %$descriptors) { 277 my $pob = $descriptors->{$fd}; 278 if ($pob->isa("Qpsmtpd::PollServer")) { 279 if ($pob + 0 == hex($ref)) { 280 return Data::Dumper::Dumper($pob); 281 } 282 } 283 } 284 285 return "Unable to find the connection: $ref. Try the LIST command\n"; 286} 287 2881; 289__END__ 290 291=head1 NAME 292 293Qpsmtpd::ConfigServer - a configuration server for qpsmtpd 294 295=head1 DESCRIPTION 296 297When qpsmtpd runs in multiplex mode it also provides a config server that you 298can connect to. This allows you to view current connection statistics and other 299gumph that you probably don't care about. 300 301=cut 302