Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
We are currently having oodles of fun with a new backup server, and problems with autonegotiation settings with switches. The problem is, essentially, that we have a number of switches that don't negotiate properly. We have been directed to set everything to force 100-full duplex.

As anyone who's experienced network duplex settings is aware, this can cause chaos and intermittent errors, especially when it comes time to run your backups.

So I knocked together this script to test servers on our local subnet to see if they were running full duplex. This avoids the awkwardness of logging in to each server (NT, 2K, Solaris, AIX, IRIX) and on each pulling a mac address, and the interface settings, and comparing those with network switches.
For my usage, I ran this on a 100/full machine, against other machines of a similar speed. (in theory).
It's less likely to work for things on a separate subnet (although you might be able to), and less likely still on a firewalled subnet.

Thanks to that Author of Net::Ping, Rob Brown, this was made much easier. And now I have about 50 less servers running half duplex.

And yes, there is a potential malicious use for this, in a fairly trivial fashion, but if you're smart enough to figure it out, or be aware of it, then this fairly trivial bit of code won't make the _slightest_ difference.
#!/usr/bin/perl #This utility is designed to test a remote host to see if it's network + interface is running at #full or half duplex. # #We have had a lot of problems with this, since we've got a batch of s +witches #that don't negotiate properly. # #It's loosely based on Net::Ping, since there were a number of useful +reference #points in there (like packet checksumming). #in essence, what it does is send a rapid burst of packets that are ov +er the ethernet #MTU size. This triggers a burst of responses from the remote end. (if + not firewalled etc.) #A machine that is running half duplex, will respond to significantly +less of these packets, #than a machine that is running full duplex. use strict; use warnings; use IO::Select; use Socket; use FileHandle; #configuration stuff my $data_size = 10240; my $pid = $$ && 0xffff; my $data = "E"x10240; my $debug = 0; use constant PINGCOUNT => 500; use constant TOO_FEW => 0.4; #what proportion of packets must get th +rough in order to be considered #'full duplex'. Yes, 60% packet loss is + horrible, but so is hitting things #with 10k of fragmented ICMP packets. use constant PORT => 1; #set to 1 because ICMP has no port, but + the socket functions need one. use constant SIZE => 1500; #MTU for ethernet use constant TIMEOUT => 5; #2 seconds use constant ICMP_ECHO => 8; use constant ICMP_ECHOREPLY => 0; use constant ICMP_STRUCT => "C2 S3 A"; #minimal packet. use constant ICMP_FLAGS => 0; #no special flags in this case. use constant ICMP_PORT => 0; #icmp has no port. use constant SUBCODE => 0; # end of config my $buff; if ( $< != 0 ) { die "This program needs to be run as root.\n"; } my @targets = () ; if ( $#ARGV >= 0 ) { @targets = @ARGV; } else { print "usage: $0 <hosts to ping>\n"; } foreach my $target ( @targets ) { my $result = 0; $result = burst_ping($target); #send lots of pings at the target, a +nd count the results. #If result = 0, then no response at all from host - down or firewall +ed. #if result > PINGCOUNT * TOO_FEW (eg. more than 40% of packets have +been recieved) then #the remote host is probably full duplex. #If less responses are recieved, but more than 0, then the system is + probably half duplex. #typical results for half duplex are <10% if ( $result > 0 ) { print $target,": ", $result, "/", PINGCOUNT, $result < PINGCOUNT * TOO_FEW ? " system is running at half-duplex.\n" : " system is running full-duplex.\n" ; } else { print "$target is down\n"; } if ( $result < PINGCOUNT * TOO_FEW ) { sleep TIMEOUT } #to allow ICM +P messages to catch up #since this script is going to be run on a batch +of hosts at once. } sub burst_ping { my ( $target ) = @_; #open a file handler to use for sending and recieveing ICMP messages +. my $pinger = FileHandle -> new(); $pinger -> autoflush(1); socket ( $pinger, PF_INET, SOCK_RAW, (getprotobyname('icmp'))[2] ) o +r die "couldn't open socket: $!"; my $sent = 0; my $received = 0; #we need to use select, because recv is a blocking call - if there's + nothing to recv, then it'll #wait. We don't want to do that. my $select = IO::Select -> new ( $pinger ) or die "Could not init se +lect : $!"; #get a socket flavour address. my $target_addr = sockaddr_in( ICMP_PORT, inet_aton("$target") ); #Now generate a packet to send. Loosely stolen from Net::Ping. my $checksum = 0; my $msg = pack(ICMP_STRUCT . $data_size, ICMP_ECHO, SUBCODE, $checksum, $pid, $sent % 65536, $data ); $checksum = checksum($msg); $msg = pack(ICMP_STRUCT . $data_size, ICMP_ECHO, SUBCODE, $checksum, $pid, $sent % 65536, $data ); while ( $sent < PINGCOUNT ) { #if there's data to be read, then we do if ( $select -> can_read( 0 ) ) { my $remote = recv ( $pinger, $buff, SIZE, ICMP_FLAGS ); if ( $debug ) { print "result from ", unpack("C*",$remote), ":", unpack ( "C*", $target_addr), "\n"; +} #sometimes we get ICMP traffic from other sources, so we want to +filter it. if ( $remote eq $target_addr ) { ++$received; } } else #no io waiting, so we can send another packet. { ++$sent; send ( $pinger, $msg, ICMP_FLAGS, $target_addr ); } } #sent an few, and probably caught most of them. Here is to tidy up #note that this time we wait for TIMEOUT, to allow any of the slower + packets to get back to #us. while ( $select -> can_read( TIMEOUT ) ) { my $remote = recv ( $pinger, $buff, SIZE, ICMP_FLAGS ); if ( $remote eq $target_addr ) { ++$received; } } if ( $debug ) { print "$received/$sent\n";} $pinger -> flush(); close ( $pinger ) ; return $received; } #sub sub checksum { # Description: Do a checksum on the message. Basically sum all of # the short words and fold the high order bits into the low order bi +ts. #stolen from Net::Ping. Thanks to Rob Brown. Not essential, but much + more #elegant than sending packets with bad checksums. my ( $msg ) = @_; # the packet to checksum my ($len_msg, # Length of the message $num_short, # The number of short words in the message $short, # One short word $chk # The checksum ); $len_msg = length($msg); $num_short = int($len_msg / 2); $chk = 0; foreach $short (unpack("S$num_short", $msg)) { $chk += $short; } # Add the odd byte in $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_ms +g % 2; $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement }

In reply to Network Duplex speed test by Preceptor

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (11)
    As of 2018-06-22 16:15 GMT
    Find Nodes?
      Voting Booth?
      Should cpanminus be part of the standard Perl release?

      Results (124 votes). Check out past polls.