clones/arpsponge
1
0
Fork 0
mirror of https://github.com/AMS-IX/arpsponge.git synced 2024-09-21 07:47:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Intermediate check-in while redoing the control socket code.

Browse Source 
Move as the server-side stuff to Server.pm, make communications
very simple, let the client side do all the conversions.
This commit is contained in:
Steven Bakker 2011-03-31 16:16:10 +00:00
parent 3075f32097
commit ac7e271972
7 changed files with 455 additions and 531 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
TODO
View File

@ -1,9 +1,43 @@
@(#) $Id$
--------------------------------------------------
Tue Mar 29 23:13:42 CEST 2011
Internal storage of IP and MAC addresses is now done
as hex strings.
Need to rework the client/server protocol, so the
client also sends and receives HEX strings. See the
doc/command_mapping.txt file.
--------------------------------------------------
Wish list for future enhancements:
* setuid() to unprivileged user after opening relevant streams.
* use ithreads for better real-time behaviour:
- process
- learner
- sweeper
- prober
Process: Always active, listens to packets on the wire.
Handles ALIVE->PENDING and DEAD->ALIVE, manages
the ARP table.
Learner: stays active for "n" iterations, then finishes.
Prober: waits for Learner to finish, then every second, probes
the IPs that are PENDING, moving them to DEAD if necessary.
Sweeper: waits for Learner to finish, then periodically probes
"quiet" IPs.
--------------------------------------------------
Wed Mar 23 17:45:17 CET 2011
* speed improvements:
* DONE: speed improvements:
MAC and IP addresses already come in as hex strings.
We currently use "hex2ip" and "hex2mac" to convert them
@ -16,7 +50,6 @@ Wed Mar 23 17:45:17 CET 2011
for checking whether an IP address is in a network, which
dramatically cuts down on the packet handling loop.
#!/usr/bin/perl
use M6::ARP::Util qw( :all );
@ -68,29 +101,6 @@ sub addr_in_net {
return ($a & $mask) == $n;
}
--------------------------------------------------
Wish list for future enhancements:
* setuid() to unprivileged user after opening relevant streams.
* use ithreads for better real-time behaviour:
- process
- learner
- sweeper
- prober
Process: Always active, listens to packets on the wire.
Handles ALIVE->PENDING and DEAD->ALIVE, manages
the ARP table.
Learner: stays active for "n" iterations, then finishes.
Prober: waits for Learner to finish, then every second, probes
the IPs that are PENDING, moving them to DEAD if necessary.
Sweeper: waits for Learner to finish, then periodically probes
"quiet" IPs.
--------------------------------------------------
Thu Oct 7 09:16:50 CEST 2010

136
doc/command_mapping.txt
View File

@ -9,11 +9,9 @@ Basic (socket-level) Communications
FF = line-feed (\f)
TAB = tab (\t)
log = FF + "LOG" + TAB
* Client sends single-line commands to server, terminated by LF.
* Server sends two kinds of reply:
* Server sends two kinds of reply "log_msg" and "command_output":
reply := log_msg | command_output
log_msg := log_hdr + text + LF
@ -30,6 +28,26 @@ Basic (socket-level) Communications
All text up to (but not including) the ready_prompt.
Log messages are sent by the server whenever it has something to log.
Hence, a client may receive zero or more log messages when it waits
for command output.
Server commands
---------------
quit
ping
get_status
get_arp [X]
clear_arp X
get_ip [X]
clear_ip X
set_dead X
set_alive X [Y]
set_pending X Y
set_queue X Y
set_rate X Y
Command mappings
----------------
@ -37,64 +55,82 @@ Client Server
-----------------------------------
quit quit
ping ping
sponge X set-dead X
unsponge X set-alive X
clear ip X forget-ip X
sponge X set_dead X
unsponge X set_alive X
clear ip X clear_ip X
clear arp X clear_arp X
clear log -
set ip X pending Y set-pending X Y
set ip X alive [Y] set-alive X Y
set ip X dead set-dead X
set ip X mac Y set-alive X Y
set ip X queue Y set-queue X Y
set ip X rate Y set-rate X Y
set ip X pending Y set_pending X Y
set ip X alive [Y] set_alive X Y
set ip X dead set_dead X
set ip X mac Y set_alive X Y
set ip X queue Y set_queue X Y
set ip X rate Y set_rate X Y
show status status
show version status
show uptime status
show arp [X] get_arp [X]
show version get_status
show uptime get_status
show log -
show ip X show-ip X
show ip X state show-ip X
show ip X mac show-ip X
show ip X queue show-ip X
show ip X rate show-ip X
show ip get_ip
show ip X get_ip X, get_arp X
show ip X state get_ip X
show ip X mac get_arp X
show ip X queue get_ip X
show ip X rate get_ip X
Data Types
----------
IP addresses are sent as hexadecimal strings.
MAC addresses are sent as hexadecimal strings.
Boolean values are sent as 0 or 1.
Time stamps are sent as seconds since epoch.
Server:
Time stamps are sent as seconds since epoch.
Mac addresses are sent/received as hex strings.
IP addresses are sent/received as hex strings.
Boolean values are sent as 0 or 1.
Output is sent as <key> <space> <val>:
Output is sent as <key>=<val> <LF> <key=val>, with
<LF><LF> between records.
-----------------------------
ip=1c201a6f
state=ALIVE
queue=0
rate=0.0
state_mtime=1301071508
state_atime=1301071567
ip=1c201a70
state=DEAD
queue=500
rate=60.0
state_mtime=1301071402
state_atime=1301071663
ip 1c201a6f
state ALIVE
queue 0
rate 0.0
mac 000cdbfd2300
mac_changed 1301071000
state_mtime 1301071508
state_atime 1301071567
[OK]
id arpsponge
version 3.10-alpha2
date 1301071803
started 1300897051
network 5bc81100/26
interface eth0
ip 5bc81128
mac fe000096000a
max_queue 200
max_rate 30.00
flood_protection 5.00
max_pending 10
sweep_period 900
sweep_age 3600
proberate 100
next_sweep 38
learning 0
dummy 1
-----------------------------
id=arpsponge
pid=3456
version=3.10-alpha2(110)
date=1301071803
started=1300897051
network=5bc81100
prefixlen=26
interface=eth0
ip=5bc81128
mac=fe000096000a
max_queue=200
max_rate=30.00
flood_protection=5.00
max_pending=10
sweep_period=900
sweep_age=3600
proberate=100
next_sweep=38
learning=0
dummy=1
[OK]

448
lib/M6/ARP/Control.pm
View File

@ -14,10 +14,6 @@
package M6::ARP::Control;
use strict;
use base qw( IO::Socket::UNIX );
use IO::Socket;
use Scalar::Util qw( blessed );
BEGIN {
our $VERSION = '0.02';
@ -35,302 +31,6 @@ sub _set_error {
return;
}
# $handle = $handle->_send_data("something\n", ...);
#
# Wrapper around "syswrite" on a socket handle.
# This catches SIGPIPE for when the remote end has disconnected.
# In case of a SIGPIPE or other error, this will return undef,
# otherwise it will return the object itself, allowing chaining:
#
# $handle->_send_data("hello world\n");
# $handle->_send_data("hello", " world\n");
#
# $handle->_send_data("hello")->_send_data(" world\n");
#
sub _send_data {
my $self = shift;
my $data = join('', @_);
local($::SIG{PIPE}) = 'IGNORE';
my $nwritten = $self->syswrite($data);
if (!$nwritten && length($!)) {
return $self->_set_error($!);
}
return $self;
}
# $data = $handle->_get_data($blocking);
#
# Wrapper around "sysread" on a socket handle. This normally
# implements a non-blocking read on a socket, regardless of
# what the current blocking mode on the socket is. Returns
# "undef" if there is no data. Tries to read no more than $BUFSIZ
# bytes, but may run over that if the last character is not a newline.
#
# $data = $handle->_get_data($blocking);
#
sub _get_data {
my $self = shift;
my $blocking = @_ ? int(shift) : 0;
my $buf;
my $old_blocking = $self->blocking($blocking);
my $n = $self->sysread($buf, $BUFSIZ);
if ($buf !~ /\n\Z/) {
my $char;
while ($self->sysread($char, 1)) {
$buf .= $char;
last if $char eq "\n";
}
}
$self->blocking($old_blocking);
return $n ? $buf : undef;
}
package M6::ARP::Control::Server;
use POSIX qw( strftime );
use base qw( M6::ARP::Control );
use IO::Socket;
sub create_server {
my $type = shift @_;
$type = ref $type || $type;
my $socketname = shift;
my $maxclients = @_ ? shift : 5;
print STDERR "M6::ARP::Control::create_server($socketname, $maxclients)\n";
# Fill in some harmless defaults...
#my $self = $type->new(
my $self = IO::Socket::UNIX->new(
Local => $socketname,
Type => SOCK_STREAM,
Listen => $maxclients,
) or return $type->_set_error($!);
$self->blocking(0); # Make sure we never hang as a server.
bless $self, $type;
}
sub new {
my $type = shift @_;
$type = ref $type || $type;
print STDERR "M6::ARP::Control::Server::new($type, @_)\n";
my %args = @_;
my $self = IO::Socket::UNIX->new(%args) or return $type->_set_error($!);
$self->blocking(0); # Make sure we never hang as a server.
bless $self, $type;
}
sub accept {
my $self = shift;
my $socket = $self->SUPER::accept() or return $self->_set_error($!);
bless $socket, ref $self;
$socket->blocking(0); # Make sure we never hang as a server.
return $socket->_send_data("\014READY\n");
}
sub get_command {
my $self = shift;
return $self->_get_data();
}
sub send_response {
my $self = shift;
my $response = join('', @_);
$response .= "\n" if $response !~ /\n\Z/;
return $self->_send_data("$response\014READY\n");
}
sub send_log {
my $self = shift;
my $log = join('', @_);
chomp($log);
my $tstamp = strftime("%Y-%m-%d %H:%M:%S", localtime(time));
my @log = map { "\014LOG\t$tstamp [$$] $_\n" } split(/\n/, $log);
return $self->_send_data(@log);
}
package M6::ARP::Control::Client;
use base qw( M6::ARP::Control );
use IO::Socket;
# $ref = $handle->_log_buffer;
# $handle->_log_buffer($ref);
#
# Get/set the internal buffer of logging lines received from
# the server end. The log_buffer acts as a circular buffer of
# $MAXLOGLINES lines.
#
sub _log_buffer {
my $self = shift;
if (@_) {
${*$self}{'m6_arp_control_client_log_buffer'} = shift;
return $self;
}
else {
return ${*$self}{'m6_arp_control_client_log_buffer'};
}
}
# $leftover = $handle->_parse_log_buffer($data [, \@logbuffer]);
#
# Remove the "\014LOG\t" log lines from $data, store them in the
# internal log buffer (or @logbuffer if given) and return the rest
# of $data.
#
sub _parse_log_buffer {
my $self = shift;
my $data = shift;
my ($log, $maxloglines);
if (@_) {
$log = shift;
$maxloglines = 0;
}
else {
$log = $self->_log_buffer;
$maxloglines = $MAXLOGLINES;
}
while ($data =~ s/^\014LOG\t(.*?\n)//m) {
if ($maxloglines && @$log > $maxloglines) {
shift @$log; # Rotate log buffer if necessary.
}
push @$log, $1;
}
return $data;
}
# $data = $handle->get_log_buffer;
#
# Return the internal log buffer as a single string. Gather
# any other log information you can get if it is available.
#
sub get_log_buffer {
my $self = shift;
my %args = (-order => +1, @_);
# Tease out log data from the socket.
my $buf = $self->_parse_log_buffer($self->_get_data(0));
# Anything else is weird. Tag it as such.
if (length $buf) {
$buf =~ s/^/UNEXPECTED: /gm;
}
my $log = $self->_log_buffer;
$buf = $buf . join('', $args{-order} < 0 ? reverse @$log : @$log);
return length $buf ? $buf : undef;
}
# $handle->clear_log_buffer;
#
# Clear the internal log buffer.
#
sub clear_log_buffer {
@{$_[0]->_log_buffer} = ();
return $_[0];
}
# @lines = $handle->read_log_data( [ -blocking => {0|1} ] );
#
# Read logging data from $handle. Default is to block for input,
# but can be overridden with "-blocking => 0".
#
sub read_log_data {
my $self = shift;
my %args = (-blocking => 1, @_);
my $blocking = $args{-blocking};
my @lines;
# Tease out log data from the socket.
my $buf = $self->_parse_log_buffer($self->_get_data($blocking), \@lines);
# Anything else is weird. Tag it as such.
if (length $buf) {
push @lines, map { "UNEXPECTED: $_\n" } split(/\n/, $buf);
}
return @lines;
}
# $data = $handle->_get_response;
#
# Wrapper around "sysread" on a socket handle, reads data
# until it sees the "ready" prompt or an EOF. Strips the
# ready prompt.
#
# Returns undef on EOF or error, a string with the response
# otherwise. Note that the response string may be empty.
#
sub _get_response {
my $self = shift;
my $response = '';
my $buf = '';
my $ok = undef;
while (my $n = $self->sysread($buf, $BUFSIZ)) {
$response .= $buf;
if ($response =~ s/^\014READY\n//m) {
$ok = 1;
last;
}
}
$response = $self->_parse_log_buffer($response);
return $ok ? $response : undef;
}
sub create_client {
my ($type, $sockfile) = @_;
my $self = IO::Socket::Client->new(
Peer => $sockfile,
Type => SOCK_STREAM,
) or return;
return bless $self, $type;
}
sub new {
my ($type, @args) = @_;
my $self = IO::Socket::UNIX->new(@args) or return $type->_set_error($!);
bless $self, $type;
$self->_log_buffer([]);
return defined $self->_get_response ? $self : undef;
}
# $reply = $handle->send_command($command);
#
# Send $command to the remote end and wait for the answer.
# Returns the answer (minus any LOG lines). Returns undef
# on error, in which case the connection is considered to
# be lost.
#
sub send_command {
my $self = shift;
my $command = join(' ', split(' ', join('', @_)))."\n";
$self->_send_data($command) || return;
return $self->_get_response;
}
1;
__END__
@ -345,63 +45,44 @@ M6::ARP::Control - client/server implementation for arpsponge control
use M6::ARP::Control;
$server = M6::ARP::Control::Server->create_server($socket_file);
M6::ARP::Control->_set_error("something scwewwy");
# Alternative method (equivalent to above):
$server = M6::ARP::Control::Server->new(
Local => $socket_file,
Type => SOCK_STREAM,
Listen =>5
);
print M6::ARP::Control->error, "\n";
$conn = $server->accept();
$M6::ARP::Control::BUFSIZ = 8*1024;
$M6::ARP::Control::MAXLOGLINES = 1024;
$command = $conn->read_command();
if (!defined $command) {
print STDERR "Client disconnected\n";
$conn->close;
}
if (!$conn->send_reply('Ok')) {
print STDERR "Client disconnected\n";
$conn->close;
}
# ---------------------------------------------
$client = M6::ARP::Control::Client->create_client($socket_file);
# Alternative method (equivalent to above):
$client = M6::ARP::Control::Client->new(
Peer => $socket_file,
Type => SOCK_STREAM,
);
$reply = $client->send_command('something important');
if (!defined $reply) {
print STDERR "Server disconnected\n";
$client->close;
}
# Modules that actually do some work:
use M6::ARP::Control::Base;
use M6::ARP::Control::Server;
use M6::ARP::Control::Client;
=head1 DESCRIPTION
This module implements a simple client/server protocol for
controlling the ARP sponge using UNIX domain sockets.
The C<M6::ARP::Control> modules implement a simple client/server
protocol for controlling the ARP sponge using UNIX domain sockets.
The L<arpsponge>(8) uses a
L<M6::ARP::Control::Server|/M6::ARP::Control::Server>
object, the L<asctl>(1) program uses
L<M6::ARP::Control::Client|/M6::ARP::Control::Client>.
The server (L<arpsponge>) uses a
L<M6::ARP::Control::Server>
object, the client (L<asctl>) uses
L<M6::ARP::Control::Client>.
It is a fairly thin wrapper around L<IO::Socket::UNIX>(3p),
implementing some defaults and handling exceptions (most
notably the SIGPIPE when writing to a disconnected peer).
The implementation consists of a fairly thin wrapper around
L<IO::Socket::UNIX>(3p), with sponge command handling in the
L<M6::ARP::Control::Server>
part.
You will probably never have to deal with this module directly,
but rather use
L<M6::ARP::Control::Server>
or
L<M6::ARP::Control::Client>.
=head1 PROTOCOL
The protocol implemented by this module is very simple:
=head2 General
The basic protocol implemented by this module is very simple:
=over
@ -423,65 +104,55 @@ Server handles command and sends a reply, followed by "\014READY\n".
=back
=head1 M6::ARP::Control::Server
=head2 Logging
The server may send unsollicited logging data to the client
which is prefixed by "\014LOG\t" and terminated with a newline.
The client should be aware that these lines can show up where
normal command output is expected.
The
C<M6::ARP::Control::Server>
class is designed with single-threaded servers in mind that uses a
C<select()> loop to detect input on a socket. Hence, the default
I/O mode these objects is non-blocking.
L<M6::ARP::Control::Client>
object knows how to handle this and will store logging information
in an internal buffer.
=head2 Constructor
=head1 VARIABLES
=over
=item X<new>B<new> ( I<%ARGS> )
=item X<$M6::ARP::Control::Error>I<$M6::ARP::Control::Error>
Create a new object instance and return a reference to it. Because
this object inherits from L<IO::Socket>(3), we must keep the same
semantics for the arguments.
Global control socket error message. Use
L<_set_error|/_set_error> and L<error|/error>
to manipulate this variable.
The L</create_server> method is preferred.
=item X<$M6::ARP::Control::BUFSIZ>I<$M6::ARP::Control::BUFSIZ>
=item X<create_server>B<create_server> ( I<SOCKNAME> [, I<MAXCLIENTS> ] )
Maximum size of data chunk we try to read in at once. See also
L<M6::ARP::Control::Base/_get_data>.
Create a new server instance, listening on I<SOCKNAME> and returning
a reference to the client object.
=item X<$M6::ARP::Control::MAXLOGLINES>I<$M6::ARP::Control::MAXLOGLINES>
On error, returns C<undef> and sets the module's error field.
=cut
Maximum number of log lines that a
L<M6::ARP::Control::Client> should buffer internally.
=back
=head1 M6::ARP::Control::Client
=head1 CLASS METHODS
=head2 Constructor
The following must be called as B<M6::ARP::Control-E<gt>>I<method>.
=over
=item X<new>B<new> ( I<%ARGS> )
=item X<error>B<error>
Create a new object instance and return a reference to it. Because
this object inherits from L<IO::Socket>(3), we must keep the same
semantics for the arguments.
Return latest error reported by any control socket connection.
The L</create_client> method is preferred.
=item X<_set_error>B<_set_error> ( I<MSG> ... )
=item X<create_client>B<create_client> ( I<SOCKNAME> )
Create a new client instance, connecting to I<SOCKNAME> and return
a reference to the client object.
On error, returns C<undef> and sets the module's error field.
=cut
=back
=head2 Methods
=over
Set the control socket error string. Should be called as a class
method.
=back
@ -491,9 +162,12 @@ See the L</SYNOPSIS> section.
=head1 SEE ALSO
L<perl(1)|perl>, L<arpsponge|arpsponge>(8),
L<M6::ARP::Sponge|M6::ARP::Sponge>(3),
L<IO::Socket|IO::Socket>(3).
L<M6::ARP::Control::Server>,
L<M6::ARP::Control::Client>,
L<M6::ARP::Control::Base>,
L<M6::ARP::Sponge>(3),
L<IO::Socket|IO::Socket>(3),
L<arpsponge>(8), L<asctl>(1).
=head1 AUTHORS

6
lib/M6/ARP/Sponge.pm
View File

@ -251,12 +251,18 @@ sub arp_table {
return $self->{'arp_table'} if @_ == 0;
my $ip = shift;
my $arp_table = $self->{'arp_table'};
if (@_) {
my $mac = shift;
my $time = @_ ? shift : time;
if (defined $mac) {
$self->{'arp_table'}->{$ip} = [ $mac, $time ];
}
else {
delete $self->{'arp_table'}->{$ip};
}
}
return $self->{'arp_table'}->{$ip} ? @{$self->{'arp_table'}->{$ip}} : ();
}

8
lib/M6/ARP/Util.pm
View File

@ -183,12 +183,15 @@ sub mac2mac {
###############################################################################
=item X<format_time>B<format_time> ( I<TIME> )
=item X<format_time>B<format_time> ( I<TIME> [, I<SEPARATOR>] )
Convert I<TIME> (seconds since epoch) to a "YYYY-mm-dd@HH:MM:SS"
string in the local timezone.
If I<TIME> is undefined or 0, it returns C<never>.
If I<SEPARATOR> is specified, it is used as the string that
separates the date part from the time part (by default an at-sign: "@").
Example: format_time(1300891278)
returns "2011-03-23@15:41:18"
@ -196,8 +199,9 @@ returns "2011-03-23@15:41:18"
sub format_time {
my $time = shift;
my $separator = @_ ? shift : '@';
if (defined $time && $time > 0) {
return strftime('%Y-%m-%d@%H:%M:%S', localtime($time));
return strftime("%Y-%m-%d${separator}%H:%M:%S", localtime($time));
}
return 'never';
}

53
sbin/arpsponge.pl
View File

@ -42,7 +42,7 @@ use IO::Socket;
use M6::ARP::Sponge qw( :states );
use M6::ARP::Util qw( :all );
use M6::ARP::Control;
use M6::ARP::Control::Server;
###############################################################################
$0 =~ s|.*/||g;
@ -255,6 +255,7 @@ sub Main {
$sponge->is_dummy($dummy);
$sponge->is_verbose($verbose);
$sponge->user('version', $VERSION);
$sponge->user('net_lo', $network->first->numeric);
$sponge->user('net_hi', $network->last->numeric);
$sponge->user('start_time', time);
@ -270,7 +271,7 @@ sub Main {
$sponge->user('sweep_age', $sweep_threshold);
}
$sponge->set_state($network, STATIC) if $sponge_net;
$sponge->set_state(ip2hex($network->addr), STATIC) if $sponge_net;
init_state($sponge, $init);
$sponge->print_log("Initializing $0 on [%s, %s, %s]",
@ -414,8 +415,7 @@ sub packet_capture_loop {
);
}
}
else {
if (!handle_client_command($sponge, $ready_fh)) {
elsif (!$ready_fh->handle_command($sponge)) {
$select->remove($ready_fh);
$sponge->remove_notify($ready_fh);
$sponge->print_log("[client %d] disconnected",
@ -424,7 +424,6 @@ sub packet_capture_loop {
}
}
}
}
# We don't really ever exit this loop...
$sponge->print_log("unexpected end of loop!");
@ -450,13 +449,17 @@ sub cmd_sponge {
if (@args != 1) {
return $fh->send_response("[ERR] sponge IP");
}
my $ip = shift @args;
my $ip_s = shift @args;
my $ip = ip2hex($ip_s);
if ( ! $ip ) {
return $fh->send_response("[ERR] \"$ip_s\" is not a valid IP");
}
if ( ! $sponge->is_my_network($ip) ) {
return $fh->send_response("[ERR] \"$ip\" not in network");
return $fh->send_response("[ERR] \"$ip_s\" not in network");
}
$sponge->set_dead($ip);
my $rate = sprintf("%0.1f", $sponge->queue->rate($ip) // 0.0);
return $fh->send_response("[OK] $ip state=DEAD rate=$rate");
return $fh->send_response("[OK] $ip_s state=DEAD rate=$rate");
}
sub cmd_clear {
@ -465,9 +468,13 @@ sub cmd_clear {
if (@args == 0 || @args > 2) {
return $fh->send_response("[ERR] clear IP [MAC]");
}
my ($ip, $mac) = @args;
my ($ip_s, $mac) = @args;
my $ip = ip2hex($ip_s);
if ( ! $ip ) {
return $fh->send_response("[ERR] \"$ip_s\" is not a valid IP");
}
if ( ! $sponge->is_my_network($ip) ) {
return $fh->send_response("[ERR] \"$ip\" not in network");
return $fh->send_response("[ERR] \"$ip_s\" not in network");
}
$mac //= '00:00:00:00:00:00';
($mac, my $time) = $sponge->set_alive($ip, $mac);
@ -480,10 +487,14 @@ sub cmd_set_pending {
if (@args == 0 || @args > 2) {
return $fh->send_response("[ERR] set-pending IP [STATE]");
}
my ($ip, $state) = @args;
my ($ip_s, $state) = @args;
$state //= 0;
my $ip = ip2hex($ip_s);
if ( ! $ip ) {
return $fh->send_response("[ERR] \"$ip_s\" is not a valid IP");
}
if ( ! $sponge->is_my_network($ip) ) {
return $fh->send_response("[ERR] \"$ip\" not in network");
return $fh->send_response("[ERR] \"$ip_s\" not in network");
}
$state = $sponge->set_pending($ip, PENDING($state));
$fh->send_response("[OK] ip=$ip state=$state");
@ -495,10 +506,16 @@ sub cmd_show_ip {
if (@args != 1) {
return $fh->send_response("[ERR] show-ip IP");
}
my $ip = shift @args;
if ( ! $sponge->is_my_network($ip) ) {
return $fh->send_response("[ERR] \"$ip\" not in network");
my $ip_s = shift @args;
my $ip = ip2hex($ip_s);
if ( ! $ip ) {
return $fh->send_response("[ERR] \"$ip_s\" is not a valid IP");
}
if ( ! $sponge->is_my_network($ip) ) {
return $fh->send_response("[ERR] \"$ip_s\" not in network");
}
my $state = $sponge->state_name($sponge->get_state($ip));
my $depth = $sponge->queue->depth($ip) // 0;
my $rate = $sponge->queue->rate($ip) // 0.0;
@ -532,7 +549,7 @@ sub get_status_info_s {
my @response = (
sprintf("%-17s %s\n", 'id:', $sponge->syslog_ident),
sprintf("%-17s %d\n", 'pid:', $$),
sprintf("%-17s %s\n", 'version:', $VERSION),
sprintf("%-17s %s\n", 'version:', $sponge->user('version')),
sprintf("%-17s %s [%d]\n", 'date:', format_time($now), $now),
sprintf("%-17s %s [%d]\n", 'started:',
format_time($start_time), $start_time),
@ -856,8 +873,8 @@ sub do_sweep($) {
my $threshold = $sponge->user('sweep_age');
my $sleep = $sponge->user('probesleep');
my ($net, $mask) = ($sponge->network, $sponge->netmask);
$sponge->print_log("sweeping for quiet entries on $net/$mask");
my ($net, $prefixlen) = ($sponge->network, $sponge->prefixlen);
$sponge->print_log("sweeping for quiet entries on $net/$prefixlen");
my $lo = $sponge->user('net_lo');
my $hi = $sponge->user('net_hi');

251
sbin/asctl.pl
View File

@ -28,9 +28,10 @@ $0 =~ s|.*/||g;
use feature ':5.10';
use strict;
use warnings;
use Getopt::Long;
use Getopt::Long qw( GetOptions GetOptionsFromArray );
use Pod::Usage;
use M6::ARP::Control;
use M6::ARP::Control::Client;
use M6::ARP::Util qw( :all );
use Term::ReadLine;
my $SPONGE_VAR = '@SPONGE_VAR@';
@ -66,8 +67,8 @@ sub Main {
}
verbose "connecting to arpsponge on $sockname\n";
my $conn = M6::ARP::Control::Client->new($sockname)
or die M6::ARP::Control->error;
my $conn = M6::ARP::Control::Client->create_client($sockname)
or die M6::ARP::Control::Client->error."\n";
my $err = 0;
@ -96,48 +97,217 @@ sub Main {
exit $err;
}
sub check_send_command {
my $conn = shift;
my $command = join(' ', @_);
my $reply = $conn->send_command($command) or return;
$reply =~ s/^\[(\S+)\]\s*\Z//m;
if ($1 eq 'OK') {
return $reply;
}
else {
return print_error($reply);
}
}
sub dispatch {
my $conn = shift;
my $parsed = shift;
my $args = shift;
my $valid = shift;
my $prefix = join('', map { $_.'_' } @$parsed);
my %commands = map { $_ => eval '\&do_'.$prefix.$_ } @$valid;
my $command = lc shift @$args;
push @$parsed, $command;
if (exists $commands{lc $command}) {
my $func = $commands{lc $command};
if (defined &$func) {
return $func->($conn, $parsed, $args);
}
else {
print_error("[INTERNAL] @$parsed: not implemented!");
}
}
else {
print_error("@$parsed: command unknown");
}
return 0;
}
sub do_command {
my $conn = shift;
my $input = shift;
my ($command, @args) = split(' ', $input);
$command = lc $command;
$input = join(' ', $command, @args);
my @args = split(' ', shift);
if (0) {
given ($command) {
when ('show') {
do_show(@args);
}
when ('set') {
do_set(@args);
}
when ('clear') {
do_clear(@args);
}
when ('sponge') {
do_sponge(@args);
}
}
}
dispatch($conn,
[],
[ @args ],
[ qw( quit status show set clear sponge unsponge ) ]
);
if ($input =~ /^\s*show\s+log\s*$/) {
if (my $log = $conn->get_log_buffer(-order => -1)) {
return $args[0];
}
sub check_arg_count {
my ($min, $max, $command, $args) = @_;
$min //= int(@$args);
$max //= int(@$args);
return 1 if @$args >= $min && @$args <= $max;
my $arguments = $max==1 ? "argument" : "arguments";
if ($min == $max) {
if (!$min) {
return print_error(qq{"$command" takes no arguments});
}
return print_error(qq{"$command" needs $min $arguments});
}
if ($min+1 == $max) {
return print_error(qq{"$command" needs $min or $max $arguments});
}
if (@$args < $min) {
my $arguments = $min==1 ? "argument" : "arguments";
return print_error(qq{"$command" needs at least $min $arguments});
}
if ($min) {
return print_error("$command: specify $min-$max $arguments");
}
return print_error("$command: specify up to $max $arguments");
}
sub do_quit {
my ($conn, $parsed, $args) = @_;
my $reply = check_send_command($conn, 'quit') or return;
print_output($reply);
}
sub do_show {
my ($conn, $parsed, $args) = @_;
my $format = 1;
my $command = join(' ', @$parsed);
check_arg_count(1,undef,$command, $args) or return;
return dispatch($conn,
$parsed,
$args,
[ qw( status log arp version uptime ip ) ]
);
}
sub do_clear {
my ($conn, $parsed, $args) = @_;
my $format = 1;
my $command = join(' ', @$parsed);
check_arg_count(1,undef,$command, $args) or return;
return dispatch($conn,
$parsed,
$args,
[ qw( ip arp log ) ]
);
}
sub do_show_log {
my ($conn, $parsed, $args) = @_;
my $format = 1;
GetOptionsFromArray($args,
'raw!' => \(my $raw = 0),
'format!' => \$format,
'nf' => sub { $format = 0 },
) or return;
$format &&= !$raw;
check_arg_count(0,0,"@$parsed", $args) or return;
my $log = $conn->get_log_buffer(-order => -1) or return;
if ($format) {
$log =~ s/^(\d+)\t(\d+)\t/format_time($1,' ')." [$2] "/gme;
}
print_output($log);
}
}
elsif ($input =~ /^\s*clear\s+log\s*$/) {
}
sub do_clear_log {
my ($conn, $parsed, $args) = @_;
my $format = 1;
check_arg_count(0,0,"@$parsed", $args) or return;
my $log = $conn->get_log_buffer(-order => -1);
$conn->clear_log_buffer;
print_output(length($log)." bytes cleared");
}
sub do_show_status {
return do_status(@_);
}
sub do_status {
my ($conn, $parsed, $args) = @_;
my $format = 1;
GetOptionsFromArray($args,
'raw!' => \(my $raw = 0),
'format!' => \$format,
'nf' => sub { $format = 0 },
) or return;
$format &&= !$raw;
check_arg_count(0,0,"@$parsed", $args) or return;
my $reply = check_send_command($conn, 'get_status') or return;
if (!$raw) {
$reply =~ s/^(network|ip)=([\da-f]+)$/"$1=".hex2ip($2)/gme;
$reply =~ s/^(mac)=([\da-f]+)$/"$1=".hex2mac($2)/gme;
}
else {
my $reply = $conn->send_command($input);
if (!defined $reply) {
print STDERR "ERROR: ", $conn->error, "\n";
}
else {
if (!$format) {
print_output($reply);
}
else {
my %info = map { split(/=/, $_) } split("\n", $reply);
my $taglen = 0;
foreach (keys %info) {
$taglen = length($_) if length($_) > $taglen;
}
$taglen++;
my $tag = "%-${taglen}s ";
print_output(
sprintf("$tag%s\n", 'id:', $info{id}),
sprintf("$tag%s\n", 'version:', $info{version}),
sprintf("$tag%s [%d]\n", 'date:',
format_time($info{date}), $info{date}),
sprintf("$tag%s [%d]\n", 'started:',
format_time($info{started}), $info{started}),
sprintf("$tag%s/%d\n", 'network:',
$info{network}, $info{prefixlen}),
sprintf("$tag%s\n", 'interface:', $info{interface}),
sprintf("$tag%s\n", 'IP:', $info{ip}),
sprintf("$tag%s\n", 'MAC:', $info{mac}),
sprintf("$tag%d\n", 'queue depth:', $info{queue_depth}),
sprintf("$tag%0.2f\n", 'max rate:', $info{max_rate}),
sprintf("$tag%0.2f\n", 'flood protection:',
$info{flood_protection}),
sprintf("$tag%0.2f\n", 'max pending:', $info{max_pending}),
sprintf("$tag%d\n", 'sweep period:', $info{sweep_period}),
sprintf("$tag%d\n", 'sweep age:', $info{sweep_age}),
sprintf("$tag%d\n", 'proberate:', $info{proberate}),
sprintf("$tag%s (in %d secs) [%d]\n", 'next sweep:',
format_time($info{next_sweep}),
$info{next_sweep}-$info{date},
$info{next_sweep}),
sprintf("$tag%s\n", 'learning', $info{learning}?'yes':'no'),
sprintf("$tag%s\n", 'dummy', $info{dummy}?'yes':'no'),
);
}
return $command;
}
sub initialise {
@ -176,9 +346,16 @@ sub initialise {
return ($sockname, [@ARGV]);
}
sub print_error {
my $out = join('', @_);
$out .= "\n" if $out !~ /\n\Z/;
print STDERR $out;
return;
}
sub print_output {
my $out = join('', @_);
$out =~ s/\n+\[OK\]\s*\Z//s;
$out .= "\n" if $out !~ /\n\Z/;
if (-t $OUT) {
open(MORE, "|less"