Subject: Re: "ping" in perl? [Sort of]

From: [email-masked] (Karl Bunch)
Date: Fri, 17 Jan 1992 16:56:00 GMT

In <[email-masked]> [email-masked] (Root Boy Jim) writes:
>[email-masked] (Mark Frost) writes:
>>
>>Has anyone implemented the "ping" program using perl?
>
>Probably not. One must open a raw socket and compose
>and ICMP ECHO pack. Not impossible, but hairy.

I have a program (icmp.pl) that listens for ICMP packets, decodes them
and prints them out as they are received.

I suspect it's not terribly portable, not is it perfect.  We just use 
it here so we can monitor or SLIP line when we things aren't working
correctly.

I would like to mention that I'm a little sheepish about posting this
in the middle of this nice little "discussion" regarding perl.  If you
have problems with the way it's written then don't use it.

Good luck,
Karl

#!/usr/bin/perl

# System dependent stuff here....
$sockaddr = "Sna4x8"; # From /usr/include/sys/socket.h
$AF_INET = 2;
$SOCK_STREAM = 1;
$SOCK_DGRAM  = 2;
$SOCK_RAW    = 3;
# From /usr/include/netinet/in.h
$IPPROTO_ICMP= 1;

# From /usr/include/netinet/ip.h
$ip_header = "CCsSsCCSa4a4";

# Open socket
socket(IP, $AF_INET, $SOCK_RAW, $IPPROTO_ICMP) || die "Socket Failed: $!\n";

@icmp_types = (
    "ICMP_ECHOREPLY - echo reply",
    "ICMP_?? - Unknown Type #1",
    "ICMP_?? - Unknown Type #2",
    "ICMP_UNREACH - dest unreachable, codes:",
    "ICMP_SOURCEQUENCH - packet lost, slow down",
    "ICMP_REDIRECT - shorter route, codes:",
    "ICMP_?? - Unknown Type #6",
    "ICMP_?? - Unknown Type #7",
    "ICMP_ECHO - echo service",
    "ICMP_?? - Unknown Type #9",
    "ICMP_?? - Unknown Type #10",
    "ICMP_TIMXCEED - time exceeded, code:",
    "ICMP_PARAMPROB - ip header bad",
    "ICMP_TSTAMP - timestamp request",
    "ICMP_TSTAMPREPLY - timestamp reply",
    "ICMP_IREQ - information request",
    "ICMP_IREQREPLY - information reply",
    "ICMP_MASKREQ - address mask request",
    "ICMP_MASKREPLY - address mask reply",
);

%icmp_codes = (
    # ICMP_UNREACH	/* dest unreachable, codes: */
    "3:0", "ICMP_UNREACH_NET - bad net",
    "3:1", "ICMP_UNREACH_HOST - bad host",
    "3:2", "ICMP_UNREACH_PROTOCOL - bad protocol",
    "3:3", "ICMP_UNREACH_PORT - bad port",
    "3:4", "ICMP_UNREACH_NEEDFRAG - IP_DF caused drop",
    "3:5", "ICMP_UNREACH_SRCFAIL - src route failed",

    # ICMP_REDIRECT	/* shorter route, codes: */
    "5:0", "ICMP_REDIRECT_NET - for network",
    "5:1", "ICMP_REDIRECT_HOST - for host",
    "5:2", "ICMP_REDIRECT_TOSNET - for tos and net",
    "5:3", "ICMP_REDIRECT_TOSHOST - for tos and host",

    # ICMP_TIMXCEED1 time exceeded, code:
    "11:0", "ICMP_TIMXCEED_INTRANS - in transit",
    "11:1", "ICMP_TIMXCEED_REASS - in reass"
);

$| = 1;

while(1) {
    $from = recv(IP, $buf, 4096, 0);

    # Decode IP header
    ($ip_hlv, $ip_tos, $ip_len, $ip_id, $ip_off, $ip_ttl, $ip_p,
     $ip_sum, $ip_src, $ip_dest)
     = unpack($ip_header, $buf);
    $ip_hl = ($ip_hlv & 0xF0) >> 4;
    $ip_v  = ($ip_hlv & 0xF);

    printf "From %d.%d.%d.%d", unpack('C4', $ip_src);
    printf " -> %d.%d.%d.%d\n", unpack('C4', $ip_dest);

    # Pull IP header off of $buf
    $buf = substr($buf, length(pack($ip_header, 0)));

    # Decode ICMP header.
    ($icmp_type, $icmp_code, $icmp_cksum) = unpack("CCn", $buf);

    if($icmp_type > 18) {
	$type_desc = sprintf("ICMP_?? - Unknown Type #%d", $icmp_type);
	$code_desc = sprintf("(%d)", $icmp_code);
    } else {
	$type_desc = $icmp_types[$icmp_type];
	$code_desc = $icmp_codes{"$icmp_type:$icmp_code"};
    }

    print "$type_def $code_desc\n\n";
}
__END__
-- 
% ----------------------------------------------------------------------------
% Karl Bunch                        ||| UUCP: ..!uunet!cerritos.edu!ttank!karl
% Think Tank Software               ||| INTERNET: [email-masked]
% "...you'd be surprised how far a hug will go with Geordi, even Worf!" -- Riker