ethernet.tcl

eCos操作系统源码

	    append msg "    Expected $len byte ethernet packet, received [string length $data] bytes\n"
	    ethernet::_handle_packet_error $msg $id
	    return
	}

	# The data has been received correctly. Should it be buffered?
	if { !$ethernet::data($id,up) } {
	    return
	}
	if { $ethernet::data($id,packet_count) >= $ethernet::max_buffered_packets } {
	    return
	}

	# Store the packet, and inform eCos there is work to be done
	lappend ethernet::data($id,packets) $data
	incr ethernet::data($id,packet_count)
	synth::interrupt_raise $ethernet::data($id,interrupt_vector)
	
    }
    
    # ----------------------------------------------------------------------------
    # When eCos has exited, the rawether processes can and should be
    # shut down immediately.
    proc ecos_exited { arg_list } {
	foreach id $ethernet::ids {
	    if { $ethernet::data($id,alive) } {
		set ethernet::data($id,alive) 0
		fileevent $ethernet::data($id,rawether) readable ""
		catch { close $ethernet::data($id,rawether) }
	    }
	}
    }
    synth::hook_add "ecos_exit" ethernet::ecos_exited

    # ----------------------------------------------------------------------------
    # Read in various data files for use by the filters
    #
    # Other possible sources of information include arp, ypcat, and
    # dns. Those are avoided for now because they involve running
    # additional processes that might hang for a while. Also arp
    # would only give useful information for very recently accessed
    # machines, NIS might not be running, and dns could involve an
    # expensive lookup while the system is running .
    
    array set services [list]
    array set hosts [list]
    array set protocols [list]
    
    proc read_services { } {
	catch {
	    set fd [open "/etc/services" "r"]
	    while { -1 != [gets $fd line] } {
		set junk     ""
		set name     ""
		set number   ""
		set protocol ""
		if { [regexp -- {^([-a-zA-Z0-9_]+)\s*([0-9]+)/((?:tcp)|(?:udp)).*$} $line junk name number protocol] } {
		    set ethernet::services($number,$protocol) $name
		}
	    }
	    close $fd
	}
    }

    proc read_protocols { } {
	catch {
	    set fd [open "/etc/protocols" "r"]
	    while { -1 != [gets $fd line] } {
		set junk   ""
		set name   ""
		set number ""
		if { [regexp -- {^([-a-zA-Z0-9_]+)\s*([0-9]+)\s.*} $line junk name number] } {
		    set ethernet::protocols($number) $name
		}
	    }
	    close $fd
	}
    }
    
    proc read_hosts { } {
	catch {
	    set fd [open "/etc/hosts" "r"]
	    while { -1 != [gets $fd line] } {
		set junk   ""
		set name   ""
		set number ""

		# Deliberately ignore parts of the name after the first .
		if { [regexp -- {^([0-9]{1,3}.[0-9]{1,3}.[0-9]{1,3}.[0-9]{1,3})\s*([a-zA-Z0-9]+)(\.|\s|$)} $line junk number name] } {
		    # The number should be naturalized if it is going to match reliably
		    scan $line "%d.%d.%d.%d" a b c d
		    set index [expr (($a & 0x0FF) << 24) | (($b & 0x0FF) << 16) | (($c & 0x0FF) << 8) | ($d & 0x0FF)]
		    set ethernet::hosts($index) $name
		}
	    }
	    close $fd
	}
    }
    
    # ----------------------------------------------------------------------------
    # Filtering support. This is only really used when running in GUI mode.
    # However all the relevant options are still extracted and validated,
    # to avoid warnings about unrecognised options.
    
    variable logging_enabled 0
    variable max_show        64

    # Construct a string for the data, either all of it or up to max_show bytes.
    # This is just hex in chunks of four bytes.
    proc format_hex_data { data } {
	set result ""

	set len [string length $data]
	if { $len > $ethernet::max_show } {
	    set len $ethernet::max_show
	}
	binary scan $data "H[expr 2 * $len]" hex
	for { set i 0 } { $i < $len } { incr i 4 } {
	    append result "[string range $hex [expr $i * 2] [expr ($i * 2) + 7]] "
	}
	set result [string trimright $result]
	return $result
    }

    # Given an IPv4 network address, turn it into a.b.c.d and the
    # host name as well (if known). The argument should be a 32-bit
    # integer.
    proc inet_ipv4_ntoa { number } {
	set result [format "%d.%d.%d.%d" [expr ($number >> 24) & 0x0FF] [expr ($number >> 16) & 0x0FF] \
		[expr ($number >> 8) & 0x0FF] [expr $number & 0x0FF]]
	if { [info exists ethernet::hosts($number) ] } {
	    append result "($ethernet::hosts($number))"
	}
	return $result
    }

    # Given an ipv4 address encapsulated in an IPv6 address, do the necessary
    # conversion. We have something like 123:4567, we want a.b.c.d plus
    # a host address.
    proc inet_ipv4_in_ipv6_ntoa { top bottom } {
	if { "" == $top } {
	    set top 0
	}
	if { "" == $bottom } {
	    set bottom 0
	}
	set top "0x$top"
	set bottom "0x$bottom"

	set ipv4 [expr ($top << 16) | $bottom]
	return inet_ipv4_ntoa $ipv4
    }
    
    # Ditto for IPv6. The argument should be a 32-digit hexadecimal string.
    # For now there is no simple way of mapping these onto host names,
    # unless the address is an IPv4-mapped or compatible one, or one of
    # special cases such as loopback.
    proc inet_ipv6_ntoa { number } {
	# We have something like 12345678abcdef. Start by inserting the appropriate
	# colons.
	set result [format "%s:%s:%s:%s:%s:%s:%s:%s" [string range $number 0 3] [string range $number 4 7] \
		[string range $number 8 11] [string range $number 12 15] [string range $number 16 19] \
		[string range $number 20 23] [string range $number 24 27] [string range $number 28 31]]
	# Now eliminate unwanted 0's at the start of each range.
	regsub {^0+} $result {} result
	regsub -all {:0+} $result {:} result

	# If we have ended up with sequences of colons, abbreviate
        # them into pairs.
	regsub -all {::+} $result {::} result

	# There are a couple of special addresses
	if { "::1" == $result } {
	    return "::1(loopback)"
	} elseif { "::" == $result } {
	    return "::(IN6ADDR_ANY)"
	}

	# Look for IPv4-mapped addresses.
	set junk ""
	set ipv4_1 ""
	set ipv4_2 ""
	if { [regexp -nocase -- {::ffff:([0-9a-f]{0,3}):([0-9a-f]{0,3})$} $result junk ipv4_1 ipv4_2] } {
	    set result [inet_ipv4_in_ipv6_nto $ipv4_1 $ipv4_2]
	    return "::FFFF:$result"
	} elseif { [regexp -nocase -- {::([0-9a-f]{0,3}):([0-9a-f]{0,3})$} $result junk ipv4_1 ipv4_2] } {
	    set result [inet_ipv4_in_ipv6_nto $ipv4_1 $ipv4_2]
	    return "::$result"
	} else {
	    # Could still be aggregatable global unicast, link-local, site-local or multicast.
	    # But not decoded further for now.
	    return $result
	}
    }
    
    proc log_packet { device direction packet } {
	if { [string length $packet] < 14 } {
	    return
	}
	binary scan $packet {H2H2H2H2H2H2 H2H2H2H2H2H2 S} dest5 dest4 dest3 dest2 dest1 dest0 src5 src4 src3 src2 src1 src0 eth_protocol
	set packet [string range $packet 14 end]
	
	set ether_msg "$device $direction: [string length $packet] bytes, "
	append ether_msg [format ">%s:%s:%s:%s:%s:%s <%s:%s:%s:%s:%s:%s" $dest5 $dest4 $dest3 $dest2 $dest1 $dest0 $src5 $src4 $src3 $src2 $src1 $src0]
	set eth_protocol [expr $eth_protocol & 0x0FFFF]
	if { $eth_protocol <= 1536 } {
	    append ether_msg " 802.3 "
	    if { [string length $packet] < 8 } {
		return
	    }
	    binary scan $packet {a6 S} junk eth_protocol
	    set packet [string range $packet 8 end]
	}
	append ether_msg [format " %04x" $eth_protocol]
	if { $eth_protocol == 0x0800 } {
	    append ether_msg "(ip)"
	} elseif { $eth_protocol == 0x00806 } {
	    append ether_msg "(arp)"
	} elseif { $eth_protocol == 0x08035 } {
	    append ether_msg "(rarp)"
	}
	append ether_msg " [ethernet::format_hex_data $packet]\n"
	synth::output $ether_msg "eth_ether"

	if { 0x0806 == $eth_protocol } {
	    # An ARP request. This should always be 28 bytes.
	    if { [string length $packet] < 28 } {
		return
	    }
	    binary scan $packet {SSccS H2H2H2H2H2H2 I H2H2H2H2H2H2 I} hard_type prot_type hard_size prot_size op \
		    sender5 sender4 sender3 sender2 sender1 sender0 sender_ip \
		    target5 target4 target3 target2 target1 target0 target_ip
	    set hard_type [expr $hard_type & 0x0FFFF]
	    set prot_type [expr $prot_type & 0x0FFFF]
	    set hard_size [expr $hard_size & 0x0FF]
	    set prot_size [expr $prot_size & 0x0FF]
	    set op        [expr $op & 0x0FFFF]
	    set sender_ip [expr $sender_ip & 0x0FFFFFFFF]
	    set target_ip [expr $target_ip & 0x0FFFFFFFF]

	    set arp_msg "$device $direction: ARP "
	    if { $op == 1 } {
		append arp_msg "request "
	    } elseif { $op == 2 } {
		append arp_msg "reply "
	    } else {
		append_arp_msg "<unknown opcode> "
	    }
	    if { $hard_type != 1 } {
		append arp_msg "(unexpected hard_type field $hard_type, should be 1) "
	    }
	    if { $prot_type != 0x0800 } {
		append arp_msg "(unexpected prot_type field $prot_type, should be 0x0800) "
	    }
	    if { $hard_size != 6 } {
		append arp_msg "(unexpected hard_size field $hard_size, should be 6) "
	    }
	    if { $prot_size != 4 } {
		append arp_msg "(unexpected prot_size field $prot_size, should be 4) "
	    }
	    append arp_msg [format ", sender %s:%s:%s:%s:%s:%s " $sender5 $sender4 $sender3 $sender2 $sender1 $sender0]
	    append arp_msg [ethernet::inet_ipv4_ntoa $sender_ip]
	    append arp_msg [format ", target %s:%s:%s:%s:%s:%s " $target5 $target4 $target3 $target2 $target1 $target0]
	    append arp_msg [ethernet::inet_ipv4_ntoa $target_ip]
	    append arp_msg "\n"

	    synth::output $arp_msg "eth_arp"
	    return
	}

	if { 0x0800 != $eth_protocol } {
	    return
	}

	# We have an IP packet. Is this IPv4 or IPv6? The first byte contains
	# the version and the overall length of the IP header in 32-bit words
	if { [string length $packet] < 20 } {
	    return
	}
	binary scan $packet {c} tmp
	set ip_version [expr ($tmp >> 4) & 0x0F]
	set ip_hdrsize [expr $tmp & 0x0F]
	if { 4 == $ip_version } {
	    binary scan $packet {ccSSSccSII} tmp tos len id frag ttl ip_protocol checksum source_ip dest_ip
	    set ipv4_msg "$device $direction: IPv4"
	    if { 0 != $tos } {
		append ipv4_msg [format " tos %02x," [expr $tos & 0x0FF]]
	    }
	    append ipv4_msg [format " len %d, id %d," [expr $len & 0x0FFFF] [expr $id & 0x0FFFF]]
	    if { 0 != $frag } {
		append ipv4_msg [format " frag %u" [expr 8 * ($frag & 0x01FFF)]]
		if { 0 != ($frag & 0x04000) } {
		    append ipv4_msg " DF"
		}
		if { 0 != ($frag & 0x02000) } {
		    append ipv4_msg " MF"
		}
		append ipv4_msg ","
	    }
	    append ipv4_msg [format " ttl %d," $ttl]
	    set ip_protocol [expr $ip_protocol & 0x0FF]
	    if { [info exists ethernet::protocols($ip_protocol)] } {
		append ipv4_msg " $ethernet::protocols($ip_protocol),"
	    } else {
		append ipv4_msg [format " protocol %d" $ip_protocol]
	    }

	    set source_name [ethernet::inet_ipv4_ntoa $source_ip]
	    set dest_name   [ethernet::inet_ipv4_ntoa $dest_ip]
	    append ipv4_msg " >${dest_name}, <${source_name}\n"

	    synth::output $ipv4_msg "eth_ipv4"

	    # If this packet is a fragment other than the first, do not try to decode
	    # subsequent packets. The header information will not be present.
	    if { 0 != ($frag & 0x01FFF)} {
		return
	    }
	    set packet [string range $packet [expr 4 * $ip_hdrsize] end]
	    
	} elseif { 6 == $ip_version } {
	    if { [string length $packet] < 40 } {
		return
	    }
	    binary scan $packet {ISccH16H16} flow payload_length next_header hop_limit source_ip dest_ip
	    set ipv6_msg "$device $direction: IPv6"
	    set prio [expr ($flow & 0x0F000000) >> 24]
	    set flow [expr $flow & 0x00FFFFFF]
	    if { 0 != $flow } {
		append ipv6_msg [format " flow %04x prio %x," $flow $prio]
	    }
	    append ipv6_msg " payload [expr $payload bytes & 0x0FFFF],"
	    append ipv6_msg " hop limit [expr $hop_limit & 0x0FF],"
	    set next_header [expr $next_header & 0x0FF]
	    if { [info exists ethernet::protocols($next_header)] } {
		append ipv6_msg " $ethernet::protocols($next_header),"
	    } else {
		append ipv6_msg [format " protocol %d," $next_header]
	    }

	    set source_name [ethernet::inet_ipv6_ntoa $source_ip]
	    set dest_name [ethernet::inet_ipv6_ntoa $dest_ip]
	    append ipv6_msg " >${dest_name}, <${source_name}\n"

	    synth::output $ipv6_msg "eth_ipv6"
	    
	    set packet [string range $packet 40 end]
	    
	} else {
	    synth::output "$device $direction: unknown IP version $ip_version\n" "eth_ipv4"
	    return
	}


	# Now for some known protocols, icmp, tcp, udp and icmpv6
	# Possible ipv6-frag should be handled here as well. The
	# fragment header should be followed by another header such
	# as tcp or udp.
	if { 1 == $ip_protocol } {
	    # ipv4 ICMP
	    if { [string length $packet] < 4 } {
		return
	    }
	    binary scan $packet {ccS} code type checksum

	    set icmpv4_msg "$device $direction: ICMPv4 "
	    set error 0
	    set data  0
	    switch -- $code {
		0 {
		    append icmpv4_msg "ping reply"
		    if { [string length $packet] >= 8 } {
			# The id and seq are in the sender's format, not network format.
			# We have to assume either little or bigendian, so go for the former
			binary scan $packet {iss} junk id seq
			append icmpv4_msg [format " id %u, seq %u" [expr $id & 0x0FFFF] [expr $seq & 0x0FFFF]]
			set data 1
			set packet [string range $packet 8 end]
		    }
		}
		3 {
		    append icmpv4_msg "unreachable/"
		    switch -- $type {
			 0   { append icmpv4_msg "network" }
			 1   { append icmpv4_msg "host" }
			 2   { append icmpv4_msg "protocol" }
			 3   { append icmpv4_msg "port" }
			 4   { append icmpv4_msg "frag needed but don't frag set" }
			 5   { append icmpv4_msg "source route failed" }
			 6   { append icmpv4_msg "destination network unknown" }
			 7   { append icmpv4_msg "destination host unknown" }
			 8   { append icmpv4_msg "source host isolated" }
			 9   { append icmpv4_msg "destination network prohibited" }
			10   { append icmpv4_msg "destination host prohibited" }
			11   { append icmpv4_msg "network for TOS" }
			12   { append icmpv4_msg "host for TOS" }
			13   { append icmpv4_msg "communication prohibited" }
			14   { append icmpv4_msg "host precedence violation" }
			15   { append icmpv4_msg "precedence cutoff" }
			default { append icmpv4_msg "unknown" }
		    }
		    set error 1
		}
		4 {
		    append icmpv4_msg "source quench"
		    set error 1
		}
		5 {
		    append icmpv4_msg "redirect/"