use strict; use warnings; use FileHandle; use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_E +RROR inet_aton inet_ntoa sockaddr_in );; use Data::Dumper; use constant ICMP_PROTO => 1; use constant ICMP_STRUCT => "C2 n3 C4"; # icmp address-mask request pa +cket format use constant ICMP_TYPE => 17; # icmp address-mask request type use constant ICMP_IDENT => $$ & 0xffff; # icmp identity field (build f +rom current pid and stripped to lower 16 bits) use constant ICMP_MASK_REPLY => 18; # icmp address-mask reply type (an +swer is not checked against by now) use constant ICMP_CODE => 0; # icmp code field (should be set to 0) use constant ICMP_PORT => 0; # port to use with icmp use constant ICMP_FLAGS => 0; # icmp flags my $FH = FileHandle->new(); # create FileHandle to use with socket socket($FH, PF_INET, SOCK_RAW, ICMP_PROTO) || croak ("icmp socket erro +r - $!"); # open socket my $host = shift; my $timeout = shift; print get_network_mask($host); # code below is based on code from package Perl.pm sub get_network_mask { my $ip = inet_aton(shift); # trx dest address my ($seq, # packet sequence number $checksum, # packet checksum $msg, # trx message $msg_len, # trx message length $saddr, # trx socket address $from_ip, # rcv src ip address $from_type, # rcv icmp packet type field (to match request it mu +st be set to 18) $from_code, # rcv icmp packet code field (must be set to 0) $from_addr_msk, # rcv icmp packet mask field (contains the reque +sted address mask) $from_saddr, # rcv socket address $from_port, # rcv socket port $from_id, # rcv icmp packet identity field (should contain the s +ame value as set for ICMP_IDENT) $from_seq, # rcv icmp packet sequence flied (should contain the +same value as set for $seq $from_crc, # rcv icmp packet checksum (could be tested to ensure + message integrity) $recv_msg, # rcv message $finish_time, # var to measure the timeout $done, # var telling that packet rcvd or timout reached $nfound, # for timing issues $rbits # bits send over socket ); $seq = 0; $seq = ($seq + 256) % 65536; $checksum = 0; $msg = pack(ICMP_STRUCT, ICMP_TYPE, ICMP_CODE, $checksum, ICMP_IDENT, $seq, 0x0, 0x0, 0x0, 0x0); $checksum = checksum($msg); $msg = pack(ICMP_STRUCT, ICMP_TYPE, ICMP_CODE, $checksum, ICMP_IDENT, $seq, 0x0, 0x0, 0x0, 0x0); $msg_len = length($msg); $saddr = sockaddr_in(ICMP_PORT, $ip); send($FH, $msg, ICMP_FLAGS, $saddr); $rbits = ""; vec($rbits, $FH->fileno(), 1) = 1; $done = $from_ip = $from_type = $from_code = $from_addr_msk = $from_ +id = 0; $finish_time = time() + $timeout; while(!$done && $timeout > 0) { $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wa +it for packet $timeout = $finish_time - time(); # Get remaining time if (!defined($nfound)) { # Hmm, a strange error $from_addr_msk = undef; $done = 1; } elsif ($nfound) { # Got a packet from somewhere $recv_msg = ""; $from_saddr = recv($FH, $recv_msg, 1500, ICMP_FLAGS); ($from_port, $from_ip) = sockaddr_in($from_saddr); print "IP". Dumper inet_ntoa $from_ip; ($from_type, $from_code, $from_crc, $from_id, $from_seq) = unpack("C2 n3", substr $recv_msg, 20, 8); $from_addr_msk = join ".", unpack("C4", substr $recv_msg, 28, 4) +; $done = 1; } else { # Oops, timed out $done = 1; $from_addr_msk = undef; } } return $from_addr_msk; } # Below this line code is taken from package Ping.pm sub checksum { my $msg = shift; 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("n$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 } # Description: A select() wrapper that compensates for platform # peculiarities. sub mselect { if ($_[3] > 0 and $^O eq 'MSWin32') { # On windows, select() doesn't process the message loop, # but sleep() will, allowing alarm() to interrupt the latter. # So we chop up the timeout into smaller pieces and interleave # select() and sleep() calls. my $t = $_[3]; my $gran = 0.5; # polling granularity in seconds my @args = @_; while (1) { $gran = $t if $gran > $t; my $nfound = select($_[0], $_[1], $_[2], $gran); $t -= $gran; return $nfound if $nfound or !defined($nfound) or $t <= 0; sleep(0); ($_[0], $_[1], $_[2]) = @args; } } else { return select($_[0], $_[1], $_[2], $_[3]); } }
In reply to Socket problem by elLunes
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |