Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight

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":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2023-12-05 19:34 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (27 votes). Check out past polls.