App-mhping

 view release on metacpan or  search on metacpan

bin/mhping  view on Meta::CPAN

#!/usr/bin/perl -T

use 5.008008;
use utf8;
use warnings FATAL => 'all';
use threads;
use threads::shared;
use Thread::Queue;
use Getopt::Long;
use Scalar::Util qw(looks_like_number);
use Time::HiRes qw(sleep);

BEGIN {
    $ENV{PATH} = '/bin:/usr/bin';
}

$|++;

bin/mhping  view on Meta::CPAN

my @hosts = parse_hosts( $option{filename} );

exit 3 unless @hosts;

my @workers;
foreach my $host (@hosts) {
    my $status_queue = Thread::Queue->new;
    my $count_queue  = Thread::Queue->new;
    my $rtt_queue    = Thread::Queue->new;
    my $worker       = threads->create(
        'ping_host',
        $status_queue,
        $count_queue,
        $rtt_queue,
        $host,
        $option{interval}
    );
    push(
        @workers, {
            thread       => $worker,
            status_queue => $status_queue,
            count_queue  => $count_queue,
            rtt_queue    => $rtt_queue,
            host         => $host,
        }
    );
}
threads->create( 'show_report', \@workers, $option{interval} )->join;

exit 0;

sub show_help {
    print <<HELP;
Usage: mhping [options] [systems...]
  -f,--filename file    read list of targets from a file
  -i,--interval n       interval between sending ping packets (default: 1s)
  -v,--version          show version
HELP

bin/mhping  view on Meta::CPAN

              = $worker->{count_queue}->pending
              ? $worker->{count_queue}->dequeue
              : undef;
            my $rtt
              = $worker->{rtt_queue}->pending
              ? $worker->{rtt_queue}->dequeue
              : '';

            $worker_count++;

            if ( $worker->{thread}->is_running ) {
                my $tid = $worker->{thread}->tid;
                $stat{$tid}->{count} = $count if defined $count;

                if ( looks_like_number($rtt) ) {
                    $stat{$tid}->{last} = $rtt;

                    if ( not defined $stat{$tid}->{min} ) {
                        $stat{$tid}->{min} = $rtt;
                    }
                    else {
                        $stat{$tid}->{min} = $rtt

bin/mhping  view on Meta::CPAN

                        $worker_count,
                        $host,
                        $stat{$tid}->{count} || 0,
                        $rtt,
                        $stat{$tid}->{min} || 0,
                        $stat{$tid}->{max} || 0,
                    )
                );
            }
            elsif ( $status eq 'BAD_HOST' ) {
                terminate_all_threads();
                print "mhping: Unknown host $host\n";
                exit 3;
            }
        }

        $display_count++;

        print $tty_clear;
        printf " %4s %39s %6s %6s %6s\n", 'Host', 'Snt', 'Last', 'Min', 'Max';
        print '-' x 66, "\n";

bin/mhping  view on Meta::CPAN

    return;
}

sub ping_host {
    my $status_queue = shift;
    my $count_queue  = shift;
    my $rtt_queue    = shift;
    my $host         = shift;
    my $interval     = shift || 1;

    local $SIG{TERM} = sub { threads->exit };

    $host     = ( $host     =~ /^([a-z0-9\.]+)$/i ) ? $1 : return;
    $interval = ( $interval =~ /^([0-9\.]+)$/ )     ? $1 : return;

    open( my $ping, '-|', "ping -i $interval $host 2>&1" );
    while (<$ping>) {
        my $status;
        my $count = 0;
        my $rtt;
        if (m/icmp_(?:req|seq)=(\d+).+time=(.+)\sms$/) {

bin/mhping  view on Meta::CPAN

            $rtt    = '???';
        }
        $status_queue->enqueue($status);
        $count_queue->enqueue($count);
        $rtt_queue->enqueue($rtt);
    }

    return;
}

sub terminate_all_threads {
    foreach my $thread ( threads->list ) {
        if ( $thread->is_running ) {
            $thread->kill('SIGTERM')->detach;
        }
        else {
            $thread->join;
        }
    }

    return;
}

# vim: set ts=4 sw=4 et:

lib/App/mhping.pm  view on Meta::CPAN

The minimum amount of time between sending ping packets. Default is 1 second.

=item B<-v, --version>

Print C<mhping> version information.

=back

=head1 COMPATIBILITY

This program requires Perl minimum version 5.8.8 with ithreads support to run.
It has been tested on the following minimum setup:

=over 4

=item *
Perl 5.8.8

=item *
threads 1.79

=item *
threads::shared 0.94

=item *
Thread::Queue 2.00

=back

=head1 BUGS

Please report bugs on github: L<https://github.com/arpadszasz/mhping/issues>

=head1 AUTHORS

Árpád Szász

=head1 SEE ALSO

L<ping(8)>
L<fping(8)>
L<mtr(8)>
L<threads>
L<threads::shared>
L<Thread::Queue>

=cut

1;