ethernet.tcl

eCos操作系统源码

# {{{  Banner                                                   

# ============================================================================
# 
#      ethernet.tcl
# 
#      Ethernet support for the eCos synthetic target I/O auxiliary
# 
# ============================================================================
# ####COPYRIGHTBEGIN####
#                                                                           
#  ----------------------------------------------------------------------------
#  Copyright (C) 2002 Bart Veer
# 
#  This file is part of the eCos host tools.
# 
#  This program is free software; you can redistribute it and/or modify it 
#  under the terms of the GNU General Public License as published by the Free 
#  Software Foundation; either version 2 of the License, or (at your option) 
#  any later version.
#  
#  This program is distributed in the hope that it will be useful, but WITHOUT 
#  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for 
#  more details.
#  
#  You should have received a copy of the GNU General Public License along with
#  this program; if not, write to the Free Software Foundation, Inc., 
#  59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#  ----------------------------------------------------------------------------
#                                                                           
# ####COPYRIGHTEND####
# ============================================================================
# #####DESCRIPTIONBEGIN####
# 
#  Author(s):   bartv
#  Contact(s):  bartv
#  Date:        2002/08/07
#  Version:     0.01
#  Description:
#      Implementation of the ethernet device. This script should only ever
#      be run from inside the ecosynth auxiliary.
# 
# ####DESCRIPTIONEND####
# ============================================================================

# }}}

# Overview.
#
# Linux provides a number of different ways of performing low-level
# ethernet I/O from user space, including accessing an otherwise
# unused ethernet card via a PF_PACKET socket, and the tap facility.
# The necessary functionality is not readily accessible from Tcl,
# and performing this low-level I/O generally requires special
# privileges. Therefore the actual I/O happens in a C program
# rawether, installed suid root,
#
# The synthetic ethernet package supports up to four ethernet devices,
# eth0 to eth3. The target definition file maps these onto the
# underlying I/O facility. Instantiation requires spawning a rawether
# process with appropriate arguments, and then waiting for a message
# from that process indicating whether or not the instantiation
# succeeded. That message includes the MAC address. A file event
# handler is installed to handle data detected by raw ether.
#
# eCos can send a number of requests: transmit a packet, start the
# interface (possibly in promiscuous mode), stop the interface,
# or get the various parameters such as the MAC address. All those
# requests can just be passed on to the rawether process. Incoming
# ethernet packets are slightly more complicated: rawether will
# immediately pass these up to this Tcl script, which will buffer
# the packets until they are requested by eCos; in addition an
# interrupt will be raised.

namespace eval ethernet {
    # The protocol between eCos and this script.
    variable SYNTH_ETH_TX           0x01
    variable SYNTH_ETH_RX           0x02
    variable SYNTH_ETH_START        0x03
    variable SYNTH_ETH_STOP         0x04
    variable SYNTH_ETH_GETPARAMS    0x05
    variable SYNTH_ETH_MULTIALL     0x06
    
    # This array holds all the interesting data for all the
    # interfaces, indexed by the instance id. It is also useful
    # to keep track of the instance id's associated with ethernet
    # devices.
    array set data [list]
    set ids [list]

    # One-off initialization, for example loading images. If this fails
    # then all attempts at instantiation will fail as well.
    variable init_ok 1
    variable install_dir $synth::device_install_dir
    variable rawether_executable [file join $ethernet::install_dir "rawether"]

    if { ![file exists $rawether_executable] } {
	synth::report_error "Ethernet device, rawether executable has not been installed in $ethernet::install_dir.\n"
	set init_ok 0
    } elseif { ![file executable $rawether_executable] } {
	synth::report_error "Ethernet device, installed program $rawether_executable is not executable.\n"
	set init_ok 0
    }

    if { $synth::flag_gui } {
	foreach _image [list "netrecord.xbm"] {
	    variable image_[file rootname $_image]
	    if { ! [synth::load_image "ethernet::image_[file rootname $_image]" [file join $ethernet::install_dir $_image]] } {
		set init_ok 0
	    }
	}
	unset _image
    }
    
    # Maximum number of packets that should be buffered per interface.
    # This can be changed in the target definition
    variable max_buffered_packets   16

    if { [synth::tdf_has_option "ethernet" "max_buffer"] } {
	set ethernet::max_buffered_packets [synth::tdf_get_option "ethernet" "max_buffer"]
	if { ![string is integer -strict $ethernet::max_buffered_packets] } {
	    synth::report_error "Ethernet device, invalid value in target definition file $synth::target_definition\n   \
		                 Entry max_buffer should be a simple integer, not $ethernet::max_buffered_packets\n"
	    set init_ok 0
	}
    }

    # Define hooks for tx and rx packets
    synth::hook_define "ethernet_tx"
    synth::hook_define "ethernet_rx"

    # Get a list of known ethernet devices
    proc devices_get_list { } {
	set result [list]
	foreach id $ids {
	    lappend result $::ethernet::data($id,name)
	}
	return $result
    }
    
    # ----------------------------------------------------------------------------
    proc instantiate { id name data } {
	if { ! $ethernet::init_ok } {
	    synth::report_warning "Cannot instantiate ethernet device $name, initialization failed.\n"
	    return ""
	}
	
	# id is a small number that uniquely identifies this device. It will
	# be used as an array index.
	# name is something like eth0 or eth1
	# There should be no device-specific data

	# The hard work is done by an auxiliary process which needs to be
	# spawned off. It requires some additional information to map the
	# eCos device name on to a suitable Linux network device such
	# as tap0. That information has to come from the config file.
	if { ![synth::tdf_has_option "ethernet" $name] } {
	    synth::report_error "Cannot instantiate ethernet device $name\n   \
		    No entry in target definition file $synth::target_definition\n"
	    return ""
	}
	set use [synth::tdf_get_option "ethernet" $name]

	# Do some validation here, before the rawether process is started.
	# Typical entries would look like
	#     eth0 real eth1
	#     eth1 ethertap [[tap-device] [MAC] [persistent]]
	set junk ""
	set optional ""
	set mac      ""
	if { [regexp -- {^\s*real\s*[a-zA-z0-9_]+$} $use] } {
	    # Real ethernet.
	} elseif { [regexp -- {^\s*ethertap\s*(.*)$} $use junk optional ] } {
	    if { "" != $optional } {
		if { ! [regexp -- {^tap[0-9]+\s*(.*)$} $optional junk mac ] } {
		    synth::report_error "Cannot instantiate ethernet device $name\n   \
			    Invalid entry \"$use\" in target definition file $synth::target_definition\n   \
			    Should be \"ethertap \[<tap-device> \[<MAC address>\]\] [persistent]\"\n"
		    return ""
		}
		if { "" != $mac } {
		    if { ! [regexp -- {^\s*([0-9a-fA-F]{2}:){5}[0-9a-fA-F]{2}\s*} $mac ] } {
			synth::report_error "Cannot instantiate ethernet device $name\n   \
				Invalid entry \"$use\" in target definition file $synth::target_definition\n   \
				MAC address should be of the form xx:xx:xx:xx:xx:xx, all hexadecimal digits.\n"
			return ""
		    }
		}
	    }
	} else {
	    synth::report_error "Cannot instantiate ethernet device $name\n   \
		    Invalid entry \"$use\" in target definition file $synth::target_definition\n   \
		    Should be \"real <Linux ethernet device>\" or \"ethertap \[<tap-device> \[<MAC address>\]\]\"\n"
	    return ""
	}

	# Now spawn the rawether process. Its stdin and stdout are
        # pipes connected to ecosynth. Its stderr is redirected to
	# the current tty to avoid confusion between incoming ethernet
	# packets and diagnostics.
	if { [catch { set rawether [open "|$ethernet::rawether_executable $use 2>/dev/tty" w+] } message ] } {
	    synth::report_error "Failed to spawn rawether process for device $name\n   $message"
	    return ""
	}

	# No translation on this pipe please.
	fconfigure $rawether -translation binary -encoding binary -buffering none 

	# Now wait for the rawether device to initialize. It should send back a single
	# byte, '0' for failure or '1' for success. Failure is followed by a text
	# message which should be reported. Success is followed by a six-byte MAC
	# address.
	set reply [read $rawether 1]
	if { "" == $reply } {
	    synth::report_error "rawether process for device $name exited unexpectedly.\n"
	    catch { close $rawether }
	    return ""
	}

	if { "1" != $reply } {
	    set message [read $rawether 1024]
	    synth::report_error "rawether process was unable to initialize eCos device $name ($use)\n    $message"
	    catch { close $rawether }
	    return ""
	}

	set reply [read $rawether 7]
	if { [string length $reply] != 7 } {
	    synth::report_error "rawether process for eCos device $name ($use) failed to provide the initialization response.\n"
	    catch { close $rawether }
	    return ""
	}
	set mac [string range $reply 0 5]
	set multi [string index $reply 6]

	# Finally allocate an interrupt vector
	set vector [synth::interrupt_allocate $name]
	if { -1 == $vector } {
	    # No more interrupts left. An error will have been reported already.
	    catch { close $rawether }
	    return ""
	}
	
	# The device is up and running. Fill in the array entries
	lappend ethernet::ids                       $id
	set ethernet::data($id,alive)               1
	set ethernet::data($id,name)                $name
	set ethernet::data($id,rawether)            $rawether
	set ethernet::data($id,packets)             [list]
	set ethernet::data($id,packet_count)        0
	set ethernet::data($id,up)                  0
	set ethernet::data($id,interrupt_vector)    $vector
	set ethernet::data($id,MAC)                 $mac
	set ethernet::data($id,multi)               $multi

	# Set up the event handler to handle incoming packets. There should
	# not be any until the interface is brought up
	fileevent $rawether readable [list ethernet::handle_packet $name $id $rawether]

	# Finally return the request handler. The eCos device driver will
	# automatically get back an ack.
	return ethernet::handle_request
    }

    # ----------------------------------------------------------------------------
    # eCos has sent a request to a device instance. Most of these requests should
    # just be forwarded to rawether. Some care has to be taken to preserve
    # packet boundaries and avoid confusion. It is also necessary to worry
    # about the rawether process exiting unexpectedly, which may cause
    # puts operations to raise an error (subject to buffering).
    #
    # Note: it might actually be more efficient to always send a header plus
    # 1514 bytes of data, reducing the number of system calls at the cost of
    # some extra data copying, but with at least two process switches per
    # ethernet transfer efficiency is not going to be particularly good
    # anyway.
    
    proc send_rawether { id packet } {
	if { $ethernet::data($id,alive) } {
	    set chan $ethernet::data($id,rawether)
	    if { [catch { puts -nonewline $chan $packet } ] } {
		set ethernet::data($id,alive) 0
		# No further action is needed here, instead the read handler
		# will detect EOF and report abnormal termination.
	    }
	}
    }
    
    proc handle_request { id reqcode arg1 arg2 reqdata reqlen reply_len } {

	if { $reqcode == $ethernet::SYNTH_ETH_TX } {
	    # Transmit a single packet. To preserve packet boundaries
	    # this involves a four-byte header containing opcode and
	    # size, followed by the data itself.
	    set header [binary format "ccs" $reqcode 0 [string length $reqdata]]
	    ethernet::send_rawether $id $header
	    ethernet::send_rawether $id $reqdata
	    if { $ethernet::logging_enabled } {
		ethernet::log_packet $ethernet::data($id,name) "tx" $reqdata
	    }
	    synth::hook_call "ethernet_tx" $ethernet::data($id,name) $reqdata
	    
	} elseif { $reqcode == $ethernet::SYNTH_ETH_RX } {
	    # Return a single packet to eCos, plus a count of the number
	    # of remaining packets. All packets are buffered here, not
	    # in rawether.
	    if { $ethernet::data($id,packet_count) == 0 } {
		synth::send_reply 0 0 ""
	    } else {
		incr ethernet::data($id,packet_count) -1
		set packet [lindex $ethernet::data($id,packets) 0]
		set ethernet::data($id,packets) [lrange $ethernet::data($id,packets) 1 end]
		synth::send_reply $ethernet::data($id,packet_count) [string length $packet] $packet
		if { $ethernet::logging_enabled } {
		    ethernet::log_packet $ethernet::data($id,name) "rx" $packet
		}
		synth::hook_call "ethernet_rx" $ethernet::data($id,name) $packet
	    }
	} elseif { $reqcode == $ethernet::SYNTH_ETH_START } {
	    # Start the interface in either normal or promiscuous
	    # mode, depending on arg1. No reply is expected. Also
	    # mark the interface as up so that any packets transmitted
	    # by rawether will not be discarded
	    set ethernet::data($id,up) 1
	    set header [binary format "ccs" $reqcode $arg1 0]
	    ethernet::send_rawether $id $header
	} elseif { $reqcode == $ethernet::SYNTH_ETH_STOP } {
	    # Stop the interface. All pending packets should be
	    # discarded and no new packets should be accepted.
	    # No reply is expected so just pass this on to rawether
	    set ethernet::data($id,up) 0
	    set ethernet::data($id,packets) [list]
	    set ethernet::data($id,packet_count) 0
	    set header [binary format "ccs" $reqcode 0 0]
	    ethernet::send_rawether $id $header
	} elseif { $reqcode == $ethernet::SYNTH_ETH_GETPARAMS } {
	    # Retrieve the interrupt number, the MAC address,
	    # and the multicast flag for this interface. eCos should be
	    # expecting back 6 bytes of data for the MAC, plus an
	    # extra byte for the multi flag, and the interrupt
	    # number as the return code. This is all known locally.
	    set reply "$ethernet::data($id,MAC)$ethernet::data($id,multi)"
	    synth::send_reply $ethernet::data($id,interrupt_vector) 7 $reply
	} elseif { $reqcode == $ethernet::SYNTH_ETH_MULTIALL } {
	    set header [binary format "ccs" $reqcode $arg1 0]
	    ethernet::send_rawether $id $header
	} else {
	    synth::report_error "Received unexpected request $reqcode for ethernet device"
	}
    }

    # ----------------------------------------------------------------------------
    # Incoming data.
    #
    # The rawether process continually reads packets from the low-level device
    # and tries to forward them on to this script, where they will be received
    # by an event handler. The packet consists of a four-byte header containing
    # the size, followed by the ethernet data itself. This ensures that
    # packet boundaries are preserved. Incoming packets are buffered inside
    # the auxiliary until eCos sends an RX request, and an interrupt is
    # generated.
    #
    # If eCos stops accepting data or if it cannot process the ethernet packets
    # quickly enough then the auxiliary could end up buffering an unbounded
    # amount of data. That is a bad idea, so there is an upper bound on the
    # number of buffered packets. Any excess packets get dropped.
    #
    # Error conditions or EOF indicate that rawether has terminated. This
    # should not happen during normal operation. rawether should only exit
    # because of an ecos_exit hook when the channel gets closed, and the
    # event handler gets removed first.
    #
    # Incoming packets are logged when they are received by eCos, not when
    # they are received from the rawether device. That gives a somewhat more
    # accurate view of what is happening inside eCos - a packet stuck in
    # a fifo has little impact.
    proc _handle_packet_error { msg id } {
	append msg "    No further I/O will happen on this interface.\n"
	synth::report_warning $msg
	set ethernet::data($id,alive) 0
	fileevent $ethernet::data($id,rawether) readable ""
	catch { close $ethernet::data($id,rawether) }
    }
    
    proc handle_packet { name id chan } {
	set header [read $chan 4]
	if { 4 != [string length $header] } {
	    ethernet::_handle_packet_error "rawether process for $name has terminated unexpectedly.\n" $id
	    return
	}

	binary scan $header "ccs" code arg1 len
	if { $ethernet::SYNTH_ETH_RX  != $code } {
	    set msg    "protocol mismatch from rawether process for $name\n"
	    append msg "    Function code $code not recognised.\n"
	    ethernet::_handle_packet_error $msg $id
	    return
	}
	if { ($len < 14) || ($len > 1514) } {
	    set msg    "protocol mismatch from rawether process for $name\n"
	    append msg "    Invalid transfer length $len\n"
	    ethernet::_handle_packet_error $msg $id
	    return
	}

	set data [read $chan $len]
	if { $len != [string length $data] } {
	    set msg    "protocol mismatch from rawether process for $name\n"