packages/devs/eth/synth/ecosynth/v2_0/host/ethernet.tcl

   1 # {{{  Banner
   2
   3 # ============================================================================
   4 #
   5 #      ethernet.tcl
   6 #
   7 #      Ethernet support for the eCos synthetic target I/O auxiliary
   8 #
   9 # ============================================================================
  10 # ####COPYRIGHTBEGIN####
  11 #
  12 #  ----------------------------------------------------------------------------
  13 #  Copyright (C) 2002 Bart Veer
  14 #
  15 #  This file is part of the eCos host tools.
  16 #
  17 #  This program is free software; you can redistribute it and/or modify it
  18 #  under the terms of the GNU General Public License as published by the Free
  19 #  Software Foundation; either version 2 of the License, or (at your option)
  20 #  any later version.
  21 #
  22 #  This program is distributed in the hope that it will be useful, but WITHOUT
  23 #  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  24 #  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  25 #  more details.
  26 #
  27 #  You should have received a copy of the GNU General Public License along with
  28 #  this program; if not, write to the Free Software Foundation, Inc.,
  29 #  59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  30 #  ----------------------------------------------------------------------------
  31 #
  32 # ####COPYRIGHTEND####
  33 # ============================================================================
  34 # #####DESCRIPTIONBEGIN####
  35 #
  36 #  Author(s):   bartv
  37 #  Contact(s):  bartv
  38 #  Date:        2002/08/07
  39 #  Version:     0.01
  40 #  Description:
  41 #      Implementation of the ethernet device. This script should only ever
  42 #      be run from inside the ecosynth auxiliary.
  43 #
  44 # ####DESCRIPTIONEND####
  45 # ============================================================================
  46
  47 # }}}
  48
  49 # Overview.
  50 #
  51 # Linux provides a number of different ways of performing low-level
  52 # ethernet I/O from user space, including accessing an otherwise
  53 # unused ethernet card via a PF_PACKET socket, and the tap facility.
  54 # The necessary functionality is not readily accessible from Tcl,
  55 # and performing this low-level I/O generally requires special
  56 # privileges. Therefore the actual I/O happens in a C program
  57 # rawether, installed suid root,
  58 #
  59 # The synthetic ethernet package supports up to four ethernet devices,
  60 # eth0 to eth3. The target definition file maps these onto the
  61 # underlying I/O facility. Instantiation requires spawning a rawether
  62 # process with appropriate arguments, and then waiting for a message
  63 # from that process indicating whether or not the instantiation
  64 # succeeded. That message includes the MAC address. A file event
  65 # handler is installed to handle data detected by raw ether.
  66 #
  67 # eCos can send a number of requests: transmit a packet, start the
  68 # interface (possibly in promiscuous mode), stop the interface,
  69 # or get the various parameters such as the MAC address. All those
  70 # requests can just be passed on to the rawether process. Incoming
  71 # ethernet packets are slightly more complicated: rawether will
  72 # immediately pass these up to this Tcl script, which will buffer
  73 # the packets until they are requested by eCos; in addition an
  74 # interrupt will be raised.
  75
  76 namespace eval ethernet {
  77     # The protocol between eCos and this script.
  78     variable SYNTH_ETH_TX           0x01
  79     variable SYNTH_ETH_RX           0x02
  80     variable SYNTH_ETH_START        0x03
  81     variable SYNTH_ETH_STOP         0x04
  82     variable SYNTH_ETH_GETPARAMS    0x05
  83     variable SYNTH_ETH_MULTIALL     0x06
  84
  85     # This array holds all the interesting data for all the
  86     # interfaces, indexed by the instance id. It is also useful
  87     # to keep track of the instance id's associated with ethernet
  88     # devices.
  89     array set data [list]
  90     set ids [list]
  91
  92     # One-off initialization, for example loading images. If this fails
  93     # then all attempts at instantiation will fail as well.
  94     variable init_ok 1
  95     variable install_dir $synth::device_install_dir
  96     variable rawether_executable [file join $ethernet::install_dir "rawether"]
  97
  98     if { ![file exists $rawether_executable] } {
  99         synth::report_error "Ethernet device, rawether executable has not been installed in $ethernet::install_dir.\n"
 100         set init_ok 0
 101     } elseif { ![file executable $rawether_executable] } {
 102         synth::report_error "Ethernet device, installed program $rawether_executable is not executable.\n"
 103         set init_ok 0
 104     }
 105
 106     if { $synth::flag_gui } {
 107         foreach _image [list "netrecord.xbm"] {
 108             variable image_[file rootname $_image]
 109             if { ! [synth::load_image "ethernet::image_[file rootname $_image]" [file join $ethernet::install_dir $_image]] } {
 110                 set init_ok 0
 111             }
 112         }
 113         unset _image
 114     }
 115
 116     # Maximum number of packets that should be buffered per interface.
 117     # This can be changed in the target definition
 118     variable max_buffered_packets   16
 119
 120     if { [synth::tdf_has_option "ethernet" "max_buffer"] } {
 121         set ethernet::max_buffered_packets [synth::tdf_get_option "ethernet" "max_buffer"]
 122         if { ![string is integer -strict $ethernet::max_buffered_packets] } {
 123             synth::report_error "Ethernet device, invalid value in target definition file $synth::target_definition\n   \
 124                                  Entry max_buffer should be a simple integer, not $ethernet::max_buffered_packets\n"
 125             set init_ok 0
 126         }
 127     }
 128
 129     # Define hooks for tx and rx packets
 130     synth::hook_define "ethernet_tx"
 131     synth::hook_define "ethernet_rx"
 132
 133     # Get a list of known ethernet devices
 134     proc devices_get_list { } {
 135         set result [list]
 136         foreach id $ids {
 137             lappend result $::ethernet::data($id,name)
 138         }
 139         return $result
 140     }
 141
 142     # ----------------------------------------------------------------------------
 143     proc instantiate { id name data } {
 144         if { ! $ethernet::init_ok } {
 145             synth::report_warning "Cannot instantiate ethernet device $name, initialization failed.\n"
 146             return ""
 147         }
 148
 149         # id is a small number that uniquely identifies this device. It will
 150         # be used as an array index.
 151         # name is something like eth0 or eth1
 152         # There should be no device-specific data
 153
 154         # The hard work is done by an auxiliary process which needs to be
 155         # spawned off. It requires some additional information to map the
 156         # eCos device name on to a suitable Linux network device such
 157         # as tap0. That information has to come from the config file.
 158         if { ![synth::tdf_has_option "ethernet" $name] } {
 159             synth::report_error "Cannot instantiate ethernet device $name\n   \
 160                     No entry in target definition file $synth::target_definition\n"
 161             return ""
 162         }
 163         set use [synth::tdf_get_option "ethernet" $name]
 164
 165         # Do some validation here, before the rawether process is started.
 166         # Typical entries would look like
 167         #     eth0 real eth1
 168         #     eth1 ethertap [[tap-device] [MAC] [persistent]]
 169         set junk ""
 170         set optional ""
 171         set mac      ""
 172         if { [regexp -- {^\s*real\s*[a-zA-z0-9_]+$} $use] } {
 173             # Real ethernet.
 174         } elseif { [regexp -- {^\s*ethertap\s*(.*)$} $use junk optional ] } {
 175             if { "" != $optional } {
 176                 if { ! [regexp -- {^tap[0-9]+\s*(.*)$} $optional junk mac ] } {
 177                     synth::report_error "Cannot instantiate ethernet device $name\n   \
 178                             Invalid entry \"$use\" in target definition file $synth::target_definition\n   \
 179                             Should be \"ethertap \[<tap-device> \[<MAC address>\]\] [persistent]\"\n"
 180                     return ""
 181                 }
 182                 if { "" != $mac } {
 183                     if { ! [regexp -- {^\s*([0-9a-fA-F]{2}:){5}[0-9a-fA-F]{2}\s*} $mac ] } {
 184                         synth::report_error "Cannot instantiate ethernet device $name\n   \
 185                                 Invalid entry \"$use\" in target definition file $synth::target_definition\n   \
 186                                 MAC address should be of the form xx:xx:xx:xx:xx:xx, all hexadecimal digits.\n"
 187                         return ""
 188                     }
 189                 }
 190             }
 191         } else {
 192             synth::report_error "Cannot instantiate ethernet device $name\n   \
 193                     Invalid entry \"$use\" in target definition file $synth::target_definition\n   \
 194                     Should be \"real <Linux ethernet device>\" or \"ethertap \[<tap-device> \[<MAC address>\]\]\"\n"
 195             return ""
 196         }
 197
 198         # Now spawn the rawether process. Its stdin and stdout are
 199         # pipes connected to ecosynth. Its stderr is redirected to
 200         # the current tty to avoid confusion between incoming ethernet
 201         # packets and diagnostics.
 202         if { [catch { set rawether [open "|$ethernet::rawether_executable $use 2>/dev/tty" w+] } message ] } {
 203             synth::report_error "Failed to spawn rawether process for device $name\n   $message"
 204             return ""
 205         }
 206
 207         # No translation on this pipe please.
 208         fconfigure $rawether -translation binary -encoding binary -buffering none
 209
 210         # Now wait for the rawether device to initialize. It should send back a single
 211         # byte, '0' for failure or '1' for success. Failure is followed by a text
 212         # message which should be reported. Success is followed by a six-byte MAC
 213         # address.
 214         set reply [read $rawether 1]
 215         if { "" == $reply } {
 216             synth::report_error "rawether process for device $name exited unexpectedly.\n"
 217             catch { close $rawether }
 218             return ""
 219         }
 220
 221         if { "1" != $reply } {
 222             set message [read $rawether 1024]
 223             synth::report_error "rawether process was unable to initialize eCos device $name ($use)\n    $message"
 224             catch { close $rawether }
 225             return ""
 226         }
 227
 228         set reply [read $rawether 7]
 229         if { [string length $reply] != 7 } {
 230             synth::report_error "rawether process for eCos device $name ($use) failed to provide the initialization response.\n"
 231             catch { close $rawether }
 232             return ""
 233         }
 234         set mac [string range $reply 0 5]
 235         set multi [string index $reply 6]
 236
 237         # Finally allocate an interrupt vector
 238         set vector [synth::interrupt_allocate $name]
 239         if { -1 == $vector } {
 240             # No more interrupts left. An error will have been reported already.
 241             catch { close $rawether }
 242             return ""
 243         }
 244
 245         # The device is up and running. Fill in the array entries
 246         lappend ethernet::ids                       $id
 247         set ethernet::data($id,alive)               1
 248         set ethernet::data($id,name)                $name
 249         set ethernet::data($id,rawether)            $rawether
 250         set ethernet::data($id,packets)             [list]
 251         set ethernet::data($id,packet_count)        0
 252         set ethernet::data($id,up)                  0
 253         set ethernet::data($id,interrupt_vector)    $vector
 254         set ethernet::data($id,MAC)                 $mac
 255         set ethernet::data($id,multi)               $multi
 256
 257         # Set up the event handler to handle incoming packets. There should
 258         # not be any until the interface is brought up
 259         fileevent $rawether readable [list ethernet::handle_packet $name $id $rawether]
 260
 261         # Finally return the request handler. The eCos device driver will
 262         # automatically get back an ack.
 263         return ethernet::handle_request
 264     }
 265
 266     # ----------------------------------------------------------------------------
 267     # eCos has sent a request to a device instance. Most of these requests should
 268     # just be forwarded to rawether. Some care has to be taken to preserve
 269     # packet boundaries and avoid confusion. It is also necessary to worry
 270     # about the rawether process exiting unexpectedly, which may cause
 271     # puts operations to raise an error (subject to buffering).
 272     #
 273     # Note: it might actually be more efficient to always send a header plus
 274     # 1514 bytes of data, reducing the number of system calls at the cost of
 275     # some extra data copying, but with at least two process switches per
 276     # ethernet transfer efficiency is not going to be particularly good
 277     # anyway.
 278
 279     proc send_rawether { id packet } {
 280         if { $ethernet::data($id,alive) } {
 281             set chan $ethernet::data($id,rawether)
 282             if { [catch { puts -nonewline $chan $packet } ] } {
 283                 set ethernet::data($id,alive) 0
 284                 # No further action is needed here, instead the read handler
 285                 # will detect EOF and report abnormal termination.
 286             }
 287         }
 288     }
 289
 290     proc handle_request { id reqcode arg1 arg2 reqdata reqlen reply_len } {
 291
 292         if { $reqcode == $ethernet::SYNTH_ETH_TX } {
 293             # Transmit a single packet. To preserve packet boundaries
 294             # this involves a four-byte header containing opcode and
 295             # size, followed by the data itself.
 296             set header [binary format "ccs" $reqcode 0 [string length $reqdata]]
 297             ethernet::send_rawether $id $header
 298             ethernet::send_rawether $id $reqdata
 299             if { $ethernet::logging_enabled } {
 300                 ethernet::log_packet $ethernet::data($id,name) "tx" $reqdata
 301             }
 302             synth::hook_call "ethernet_tx" $ethernet::data($id,name) $reqdata
 303
 304         } elseif { $reqcode == $ethernet::SYNTH_ETH_RX } {
 305             # Return a single packet to eCos, plus a count of the number
 306             # of remaining packets. All packets are buffered here, not
 307             # in rawether.
 308             if { $ethernet::data($id,packet_count) == 0 } {
 309                 synth::send_reply 0 0 ""
 310             } else {
 311                 incr ethernet::data($id,packet_count) -1
 312                 set packet [lindex $ethernet::data($id,packets) 0]
 313                 set ethernet::data($id,packets) [lrange $ethernet::data($id,packets) 1 end]
 314                 synth::send_reply $ethernet::data($id,packet_count) [string length $packet] $packet
 315                 if { $ethernet::logging_enabled } {
 316                     ethernet::log_packet $ethernet::data($id,name) "rx" $packet
 317                 }
 318                 synth::hook_call "ethernet_rx" $ethernet::data($id,name) $packet
 319             }
 320         } elseif { $reqcode == $ethernet::SYNTH_ETH_START } {
 321             # Start the interface in either normal or promiscuous
 322             # mode, depending on arg1. No reply is expected. Also
 323             # mark the interface as up so that any packets transmitted
 324             # by rawether will not be discarded
 325             set ethernet::data($id,up) 1
 326             set header [binary format "ccs" $reqcode $arg1 0]
 327             ethernet::send_rawether $id $header
 328         } elseif { $reqcode == $ethernet::SYNTH_ETH_STOP } {
 329             # Stop the interface. All pending packets should be
 330             # discarded and no new packets should be accepted.
 331             # No reply is expected so just pass this on to rawether
 332             set ethernet::data($id,up) 0
 333             set ethernet::data($id,packets) [list]
 334             set ethernet::data($id,packet_count) 0
 335             set header [binary format "ccs" $reqcode 0 0]
 336             ethernet::send_rawether $id $header
 337         } elseif { $reqcode == $ethernet::SYNTH_ETH_GETPARAMS } {
 338             # Retrieve the interrupt number, the MAC address,
 339             # and the multicast flag for this interface. eCos should be
 340             # expecting back 6 bytes of data for the MAC, plus an
 341             # extra byte for the multi flag, and the interrupt
 342             # number as the return code. This is all known locally.
 343             set reply "$ethernet::data($id,MAC)$ethernet::data($id,multi)"
 344             synth::send_reply $ethernet::data($id,interrupt_vector) 7 $reply
 345         } elseif { $reqcode == $ethernet::SYNTH_ETH_MULTIALL } {
 346             set header [binary format "ccs" $reqcode $arg1 0]
 347             ethernet::send_rawether $id $header
 348         } else {
 349             synth::report_error "Received unexpected request $reqcode for ethernet device"
 350         }
 351     }
 352
 353     # ----------------------------------------------------------------------------
 354     # Incoming data.
 355     #
 356     # The rawether process continually reads packets from the low-level device
 357     # and tries to forward them on to this script, where they will be received
 358     # by an event handler. The packet consists of a four-byte header containing
 359     # the size, followed by the ethernet data itself. This ensures that
 360     # packet boundaries are preserved. Incoming packets are buffered inside
 361     # the auxiliary until eCos sends an RX request, and an interrupt is
 362     # generated.
 363     #
 364     # If eCos stops accepting data or if it cannot process the ethernet packets
 365     # quickly enough then the auxiliary could end up buffering an unbounded
 366     # amount of data. That is a bad idea, so there is an upper bound on the
 367     # number of buffered packets. Any excess packets get dropped.
 368     #
 369     # Error conditions or EOF indicate that rawether has terminated. This
 370     # should not happen during normal operation. rawether should only exit
 371     # because of an ecos_exit hook when the channel gets closed, and the
 372     # event handler gets removed first.
 373     #
 374     # Incoming packets are logged when they are received by eCos, not when
 375     # they are received from the rawether device. That gives a somewhat more
 376     # accurate view of what is happening inside eCos - a packet stuck in
 377     # a fifo has little impact.
 378     proc _handle_packet_error { msg id } {
 379         append msg "    No further I/O will happen on this interface.\n"
 380         synth::report_warning $msg
 381         set ethernet::data($id,alive) 0
 382         fileevent $ethernet::data($id,rawether) readable ""
 383         catch { close $ethernet::data($id,rawether) }
 384     }
 385
 386     proc handle_packet { name id chan } {
 387         set header [read $chan 4]
 388         if { 4 != [string length $header] } {
 389             ethernet::_handle_packet_error "rawether process for $name has terminated unexpectedly.\n" $id
 390             return
 391         }
 392
 393         binary scan $header "ccs" code arg1 len
 394         if { $ethernet::SYNTH_ETH_RX  != $code } {
 395             set msg    "protocol mismatch from rawether process for $name\n"
 396             append msg "    Function code $code not recognised.\n"
 397             ethernet::_handle_packet_error $msg $id
 398             return
 399         }
 400         if { ($len < 14) || ($len > 1514) } {
 401             set msg    "protocol mismatch from rawether process for $name\n"
 402             append msg "    Invalid transfer length $len\n"
 403             ethernet::_handle_packet_error $msg $id
 404             return
 405         }
 406
 407         set data [read $chan $len]
 408         if { $len != [string length $data] } {
 409             set msg    "protocol mismatch from rawether process for $name\n"
 410             append msg "    Expected $len byte ethernet packet, received [string length $data] bytes\n"
 411             ethernet::_handle_packet_error $msg $id
 412             return
 413         }
 414
 415         # The data has been received correctly. Should it be buffered?
 416         if { !$ethernet::data($id,up) } {
 417             return
 418         }
 419         if { $ethernet::data($id,packet_count) >= $ethernet::max_buffered_packets } {
 420             return
 421         }
 422
 423         # Store the packet, and inform eCos there is work to be done
 424         lappend ethernet::data($id,packets) $data
 425         incr ethernet::data($id,packet_count)
 426         synth::interrupt_raise $ethernet::data($id,interrupt_vector)
 427
 428     }
 429
 430     # ----------------------------------------------------------------------------
 431     # When eCos has exited, the rawether processes can and should be
 432     # shut down immediately.
 433     proc ecos_exited { arg_list } {
 434         foreach id $ethernet::ids {
 435             if { $ethernet::data($id,alive) } {
 436                 set ethernet::data($id,alive) 0
 437                 fileevent $ethernet::data($id,rawether) readable ""
 438                 catch { close $ethernet::data($id,rawether) }
 439             }
 440         }
 441     }
 442     synth::hook_add "ecos_exit" ethernet::ecos_exited
 443
 444     # ----------------------------------------------------------------------------
 445     # Read in various data files for use by the filters
 446     #
 447     # Other possible sources of information include arp, ypcat, and
 448     # dns. Those are avoided for now because they involve running
 449     # additional processes that might hang for a while. Also arp
 450     # would only give useful information for very recently accessed
 451     # machines, NIS might not be running, and dns could involve an
 452     # expensive lookup while the system is running .
 453
 454     array set services [list]
 455     array set hosts [list]
 456     array set protocols [list]
 457
 458     proc read_services { } {
 459         catch {
 460             set fd [open "/etc/services" "r"]
 461             while { -1 != [gets $fd line] } {
 462                 set junk     ""
 463                 set name     ""
 464                 set number   ""
 465                 set protocol ""
 466                 if { [regexp -- {^([-a-zA-Z0-9_]+)\s*([0-9]+)/((?:tcp)|(?:udp)).*$} $line junk name number protocol] } {
 467                     set ethernet::services($number,$protocol) $name
 468                 }
 469             }
 470             close $fd
 471         }
 472     }
 473
 474     proc read_protocols { } {
 475         catch {
 476             set fd [open "/etc/protocols" "r"]
 477             while { -1 != [gets $fd line] } {
 478                 set junk   ""
 479                 set name   ""
 480                 set number ""
 481                 if { [regexp -- {^([-a-zA-Z0-9_]+)\s*([0-9]+)\s.*} $line junk name number] } {
 482                     set ethernet::protocols($number) $name
 483                 }
 484             }
 485             close $fd
 486         }
 487     }
 488
 489     proc read_hosts { } {
 490         catch {
 491             set fd [open "/etc/hosts" "r"]
 492             while { -1 != [gets $fd line] } {
 493                 set junk   ""
 494                 set name   ""
 495                 set number ""
 496
 497                 # Deliberately ignore parts of the name after the first .
 498                 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] } {
 499                     # The number should be naturalized if it is going to match reliably
 500                     scan $line "%d.%d.%d.%d" a b c d
 501                     set index [expr (($a & 0x0FF) << 24) | (($b & 0x0FF) << 16) | (($c & 0x0FF) << 8) | ($d & 0x0FF)]
 502                     set ethernet::hosts($index) $name
 503                 }
 504             }
 505             close $fd
 506         }
 507     }
 508
 509     # ----------------------------------------------------------------------------
 510     # Filtering support. This is only really used when running in GUI mode.
 511     # However all the relevant options are still extracted and validated,
 512     # to avoid warnings about unrecognised options.
 513
 514     variable logging_enabled 0
 515     variable max_show        64
 516
 517     # Construct a string for the data, either all of it or up to max_show bytes.
 518     # This is just hex in chunks of four bytes.
 519     proc format_hex_data { data } {
 520         set result ""
 521
 522         set len [string length $data]
 523         if { $len > $ethernet::max_show } {
 524             set len $ethernet::max_show
 525         }
 526         binary scan $data "H[expr 2 * $len]" hex
 527         for { set i 0 } { $i < $len } { incr i 4 } {
 528             append result "[string range $hex [expr $i * 2] [expr ($i * 2) + 7]] "
 529         }
 530         set result [string trimright $result]
 531         return $result
 532     }
 533
 534     # Given an IPv4 network address, turn it into a.b.c.d and the
 535     # host name as well (if known). The argument should be a 32-bit
 536     # integer.
 537     proc inet_ipv4_ntoa { number } {
 538         set result [format "%d.%d.%d.%d" [expr ($number >> 24) & 0x0FF] [expr ($number >> 16) & 0x0FF] \
 539                 [expr ($number >> 8) & 0x0FF] [expr $number & 0x0FF]]
 540         if { [info exists ethernet::hosts($number) ] } {
 541             append result "($ethernet::hosts($number))"
 542         }
 543         return $result
 544     }
 545
 546     # Given an ipv4 address encapsulated in an IPv6 address, do the necessary
 547     # conversion. We have something like 123:4567, we want a.b.c.d plus
 548     # a host address.
 549     proc inet_ipv4_in_ipv6_ntoa { top bottom } {
 550         if { "" == $top } {
 551             set top 0
 552         }
 553         if { "" == $bottom } {
 554             set bottom 0
 555         }
 556         set top "0x$top"
 557         set bottom "0x$bottom"
 558
 559         set ipv4 [expr ($top << 16) | $bottom]
 560         return inet_ipv4_ntoa $ipv4
 561     }
 562
 563     # Ditto for IPv6. The argument should be a 32-digit hexadecimal string.
 564     # For now there is no simple way of mapping these onto host names,
 565     # unless the address is an IPv4-mapped or compatible one, or one of
 566     # special cases such as loopback.
 567     proc inet_ipv6_ntoa { number } {
 568         # We have something like 12345678abcdef. Start by inserting the appropriate
 569         # colons.
 570         set result [format "%s:%s:%s:%s:%s:%s:%s:%s" [string range $number 0 3] [string range $number 4 7] \
 571                 [string range $number 8 11] [string range $number 12 15] [string range $number 16 19] \
 572                 [string range $number 20 23] [string range $number 24 27] [string range $number 28 31]]
 573         # Now eliminate unwanted 0's at the start of each range.
 574         regsub {^0+} $result {} result
 575         regsub -all {:0+} $result {:} result
 576
 577         # If we have ended up with sequences of colons, abbreviate
 578         # them into pairs.
 579         regsub -all {::+} $result {::} result
 580
 581         # There are a couple of special addresses
 582         if { "::1" == $result } {
 583             return "::1(loopback)"
 584         } elseif { "::" == $result } {
 585             return "::(IN6ADDR_ANY)"
 586         }
 587
 588         # Look for IPv4-mapped addresses.
 589         set junk ""
 590         set ipv4_1 ""
 591         set ipv4_2 ""
 592         if { [regexp -nocase -- {::ffff:([0-9a-f]{0,3}):([0-9a-f]{0,3})$} $result junk ipv4_1 ipv4_2] } {
 593             set result [inet_ipv4_in_ipv6_nto $ipv4_1 $ipv4_2]
 594             return "::FFFF:$result"
 595         } elseif { [regexp -nocase -- {::([0-9a-f]{0,3}):([0-9a-f]{0,3})$} $result junk ipv4_1 ipv4_2] } {
 596             set result [inet_ipv4_in_ipv6_nto $ipv4_1 $ipv4_2]
 597             return "::$result"
 598         } else {
 599             # Could still be aggregatable global unicast, link-local, site-local or multicast.
 600             # But not decoded further for now.
 601             return $result
 602         }
 603     }
 604
 605     proc log_packet { device direction packet } {
 606         if { [string length $packet] < 14 } {
 607             return
 608         }
 609         binary scan $packet {H2H2H2H2H2H2 H2H2H2H2H2H2 S} dest5 dest4 dest3 dest2 dest1 dest0 src5 src4 src3 src2 src1 src0 eth_protocol
 610         set packet [string range $packet 14 end]
 611
 612         set ether_msg "$device $direction: [string length $packet] bytes, "
 613         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]
 614         set eth_protocol [expr $eth_protocol & 0x0FFFF]
 615         if { $eth_protocol <= 1536 } {
 616             append ether_msg " 802.3 "
 617             if { [string length $packet] < 8 } {
 618                 return
 619             }
 620             binary scan $packet {a6 S} junk eth_protocol
 621             set packet [string range $packet 8 end]
 622         }
 623         append ether_msg [format " %04x" $eth_protocol]
 624         if { $eth_protocol == 0x0800 } {
 625             append ether_msg "(ip)"
 626         } elseif { $eth_protocol == 0x00806 } {
 627             append ether_msg "(arp)"
 628         } elseif { $eth_protocol == 0x08035 } {
 629             append ether_msg "(rarp)"
 630         }
 631         append ether_msg " [ethernet::format_hex_data $packet]\n"
 632         synth::output $ether_msg "eth_ether"
 633
 634         if { 0x0806 == $eth_protocol } {
 635             # An ARP request. This should always be 28 bytes.
 636             if { [string length $packet] < 28 } {
 637                 return
 638             }
 639             binary scan $packet {SSccS H2H2H2H2H2H2 I H2H2H2H2H2H2 I} hard_type prot_type hard_size prot_size op \
 640                     sender5 sender4 sender3 sender2 sender1 sender0 sender_ip \
 641                     target5 target4 target3 target2 target1 target0 target_ip
 642             set hard_type [expr $hard_type & 0x0FFFF]
 643             set prot_type [expr $prot_type & 0x0FFFF]
 644             set hard_size [expr $hard_size & 0x0FF]
 645             set prot_size [expr $prot_size & 0x0FF]
 646             set op        [expr $op & 0x0FFFF]
 647             set sender_ip [expr $sender_ip & 0x0FFFFFFFF]
 648             set target_ip [expr $target_ip & 0x0FFFFFFFF]
 649
 650             set arp_msg "$device $direction: ARP "
 651             if { $op == 1 } {
 652                 append arp_msg "request "
 653             } elseif { $op == 2 } {
 654                 append arp_msg "reply "
 655             } else {
 656                 append_arp_msg "<unknown opcode> "
 657             }
 658             if { $hard_type != 1 } {
 659                 append arp_msg "(unexpected hard_type field $hard_type, should be 1) "
 660             }
 661             if { $prot_type != 0x0800 } {
 662                 append arp_msg "(unexpected prot_type field $prot_type, should be 0x0800) "
 663             }
 664             if { $hard_size != 6 } {
 665                 append arp_msg "(unexpected hard_size field $hard_size, should be 6) "
 666             }
 667             if { $prot_size != 4 } {
 668                 append arp_msg "(unexpected prot_size field $prot_size, should be 4) "
 669             }
 670             append arp_msg [format ", sender %s:%s:%s:%s:%s:%s " $sender5 $sender4 $sender3 $sender2 $sender1 $sender0]
 671             append arp_msg [ethernet::inet_ipv4_ntoa $sender_ip]
 672             append arp_msg [format ", target %s:%s:%s:%s:%s:%s " $target5 $target4 $target3 $target2 $target1 $target0]
 673             append arp_msg [ethernet::inet_ipv4_ntoa $target_ip]
 674             append arp_msg "\n"
 675
 676             synth::output $arp_msg "eth_arp"
 677             return
 678         }
 679
 680         if { 0x0800 != $eth_protocol } {
 681             return
 682         }
 683
 684         # We have an IP packet. Is this IPv4 or IPv6? The first byte contains
 685         # the version and the overall length of the IP header in 32-bit words
 686         if { [string length $packet] < 20 } {
 687             return
 688         }
 689         binary scan $packet {c} tmp
 690         set ip_version [expr ($tmp >> 4) & 0x0F]
 691         set ip_hdrsize [expr $tmp & 0x0F]
 692         if { 4 == $ip_version } {
 693             binary scan $packet {ccSSSccSII} tmp tos len id frag ttl ip_protocol checksum source_ip dest_ip
 694             set ipv4_msg "$device $direction: IPv4"
 695             if { 0 != $tos } {
 696                 append ipv4_msg [format " tos %02x," [expr $tos & 0x0FF]]
 697             }
 698             append ipv4_msg [format " len %d, id %d," [expr $len & 0x0FFFF] [expr $id & 0x0FFFF]]
 699             if { 0 != $frag } {
 700                 append ipv4_msg [format " frag %u" [expr 8 * ($frag & 0x01FFF)]]
 701                 if { 0 != ($frag & 0x04000) } {
 702                     append ipv4_msg " DF"
 703                 }
 704                 if { 0 != ($frag & 0x02000) } {
 705                     append ipv4_msg " MF"
 706                 }
 707                 append ipv4_msg ","
 708             }
 709             append ipv4_msg [format " ttl %d," $ttl]
 710             set ip_protocol [expr $ip_protocol & 0x0FF]
 711             if { [info exists ethernet::protocols($ip_protocol)] } {
 712                 append ipv4_msg " $ethernet::protocols($ip_protocol),"
 713             } else {
 714                 append ipv4_msg [format " protocol %d" $ip_protocol]
 715             }
 716
 717             set source_name [ethernet::inet_ipv4_ntoa $source_ip]
 718             set dest_name   [ethernet::inet_ipv4_ntoa $dest_ip]
 719             append ipv4_msg " >${dest_name}, <${source_name}\n"
 720
 721             synth::output $ipv4_msg "eth_ipv4"
 722
 723             # If this packet is a fragment other than the first, do not try to decode
 724             # subsequent packets. The header information will not be present.
 725             if { 0 != ($frag & 0x01FFF)} {
 726                 return
 727             }
 728             set packet [string range $packet [expr 4 * $ip_hdrsize] end]
 729
 730         } elseif { 6 == $ip_version } {
 731             if { [string length $packet] < 40 } {
 732                 return
 733             }
 734             binary scan $packet {ISccH16H16} flow payload_length next_header hop_limit source_ip dest_ip
 735             set ipv6_msg "$device $direction: IPv6"
 736             set prio [expr ($flow & 0x0F000000) >> 24]
 737             set flow [expr $flow & 0x00FFFFFF]
 738             if { 0 != $flow } {
 739                 append ipv6_msg [format " flow %04x prio %x," $flow $prio]
 740             }
 741             append ipv6_msg " payload [expr $payload bytes & 0x0FFFF],"
 742             append ipv6_msg " hop limit [expr $hop_limit & 0x0FF],"
 743             set next_header [expr $next_header & 0x0FF]
 744             if { [info exists ethernet::protocols($next_header)] } {
 745                 append ipv6_msg " $ethernet::protocols($next_header),"
 746             } else {
 747                 append ipv6_msg [format " protocol %d," $next_header]
 748             }
 749
 750             set source_name [ethernet::inet_ipv6_ntoa $source_ip]
 751             set dest_name [ethernet::inet_ipv6_ntoa $dest_ip]
 752             append ipv6_msg " >${dest_name}, <${source_name}\n"
 753
 754             synth::output $ipv6_msg "eth_ipv6"
 755
 756             set packet [string range $packet 40 end]
 757
 758         } else {
 759             synth::output "$device $direction: unknown IP version $ip_version\n" "eth_ipv4"
 760             return
 761         }
 762
 763
 764         # Now for some known protocols, icmp, tcp, udp and icmpv6
 765         # Possible ipv6-frag should be handled here as well. The
 766         # fragment header should be followed by another header such
 767         # as tcp or udp.
 768         if { 1 == $ip_protocol } {
 769             # ipv4 ICMP
 770             if { [string length $packet] < 4 } {
 771                 return
 772             }
 773             binary scan $packet {ccS} code type checksum
 774
 775             set icmpv4_msg "$device $direction: ICMPv4 "
 776             set error 0
 777             set data  0
 778             switch -- $code {
 779                 0 {
 780                     append icmpv4_msg "ping reply"
 781                     if { [string length $packet] >= 8 } {
 782                         # The id and seq are in the sender's format, not network format.
 783                         # We have to assume either little or bigendian, so go for the former
 784                         binary scan $packet {iss} junk id seq
 785                         append icmpv4_msg [format " id %u, seq %u" [expr $id & 0x0FFFF] [expr $seq & 0x0FFFF]]
 786                         set data 1
 787                         set packet [string range $packet 8 end]
 788                     }
 789                 }
 790                 3 {
 791                     append icmpv4_msg "unreachable/"
 792                     switch -- $type {
 793                          0   { append icmpv4_msg "network" }
 794                          1   { append icmpv4_msg "host" }
 795                          2   { append icmpv4_msg "protocol" }
 796                          3   { append icmpv4_msg "port" }
 797                          4   { append icmpv4_msg "frag needed but don't frag set" }
 798                          5   { append icmpv4_msg "source route failed" }
 799                          6   { append icmpv4_msg "destination network unknown" }
 800                          7   { append icmpv4_msg "destination host unknown" }
 801                          8   { append icmpv4_msg "source host isolated" }
 802                          9   { append icmpv4_msg "destination network prohibited" }
 803                         10   { append icmpv4_msg "destination host prohibited" }
 804                         11   { append icmpv4_msg "network for TOS" }
 805                         12   { append icmpv4_msg "host for TOS" }
 806                         13   { append icmpv4_msg "communication prohibited" }
 807                         14   { append icmpv4_msg "host precedence violation" }
 808                         15   { append icmpv4_msg "precedence cutoff" }
 809                         default { append icmpv4_msg "unknown" }
 810                     }
 811                     set error 1
 812                 }
 813                 4 {
 814                     append icmpv4_msg "source quench"
 815                     set error 1
 816                 }
 817                 5 {
 818                     append icmpv4_msg "redirect/"
 819                     switch -- $type {
 820                         0 { append icmpv4_msg "network" }
 821                         1 { append icmpv4_msg "host" }
 822                         2 { append icmpv4_msg "tos & network" }
 823                         3 { append icmpv4_msg "tos & host" }
 824                         default { append icmpv4_msg "unknown" }
 825                     }
 826                     set error 1
 827                 }
 828                 8 {
 829                     append icmpv4_msg "ping request"
 830                     if { [string length $packet] >= 8 } {
 831                         binary scan $packet {iss} junk id seq
 832                         append icmpv4_msg [format " id %u, seq %u" [expr $id & 0x0FFFF] [expr $seq & 0x0FFFF]]
 833                         set data 1
 834                         set packet [string range $packet 8 end]
 835                     }
 836                 }
 837                 9 {
 838                     append icmpv4_msg "router advertisement"
 839                 }
 840                 10 {
 841                     append icmpv4_msg "router solicitation"
 842                 }
 843                 11 {
 844                     append icmpv4_msg "time exceeded/"
 845                     switch -- $type {
 846                         0 { append icmpv4_msg "transit" }
 847                         1 { append icmpv4_msg "reassembly" }
 848                         default { append icmpv4_msg "unknown" }
 849                     }
 850                     set error 1
 851                 }
 852                 12 {
 853                     append icmpv4_msg "parameter problem/"
 854                     switch -- $type {
 855                         0 { append icmpv4_msg "IP header bad" }
 856                         1 { append icmpv4_msg "required option missing" }
 857                         default { append icmpv4_msg "unknown" }
 858                     }
 859                     set error 1
 860                 }
 861                 13 {
 862                     append icmpv4_msg "timestamp request"
 863                 }
 864                 14 {
 865                     append icmpv4_msg "timestamp reply"
 866                 }
 867                 15 {
 868                     append icmpv4_msg "information request"
 869                 }
 870                 16 {
 871                     append icmpv4_msg "information reply"
 872                 }
 873                 17 {
 874                     append icmpv4_msg "address mask request"
 875                 }
 876                 18 {
 877                     append icmpv4_msg "address mask reply"
 878                 }
 879                 default {
 880                     append icmpv4_msg "unknown"
 881                 }
 882             }
 883             if { $error && ([string length $packet] >= 36) } {
 884                 # The ICMP message contains an IP header and hopefully the TCP or UDP ports as well
 885                 # Only deal with the simple cases.
 886                 binary scan $packet {iiccSiccSIISS} icmp_junk1 icmp_junk2 ip_lenver ip_junk1 ip_junk2 ip_junk3 ip_junk4 ip_protocol ip_junk5 \
 887                         ip_source ip_dest ip_source_port ip_dest_port
 888                 if { (5 == ($ip_lenver & 0x0F)) && ((6 == $ip_protocol) || (17 == $ip_protocol)) } {
 889                     if { 6 == $ip_protocol } {
 890                         append icmpv4_msg ", tcp"
 891                     } else {
 892                         append icmpv4_msg ", udp"
 893                     }
 894                     append icmpv4_msg " >[ethernet::inet_ipv4_ntoa $ip_dest]:$ip_dest_port <[ethernet::inet_ipv4_ntoa $ip_source]:$ip_source_port"
 895                 }
 896             }
 897
 898             append icmpv4_msg "\n"
 899             synth::output $icmpv4_msg "eth_icmpv4"
 900
 901             # Only some of the requests contain additional data that should be displayed
 902             if { !$data } {
 903                 return
 904             }
 905
 906         } elseif { 58 == $ip_protocol } {
 907             # ipv6 ICMP
 908             if { [string length $packet] < 4 } {
 909                 return
 910             }
 911             binary scan $packet {ccS} code type checksum
 912
 913             set icmpv6_msg "$device $direction: ICMPv6 "
 914             set error 0
 915             set data  0
 916             switch -- $code {
 917                 1 {
 918                     append icmpv6_msg "unreachable/"
 919                     switch -- $type {
 920                         0 { append icmpv6_msg "no route" }
 921                         1 { append icmpv6_msg "prohibited" }
 922                         2 { append icmpv6_msg "not a neighbour" }
 923                         3 { append icmpv6_msg "any other reason" }
 924                         4 { append icmpv6_msg "UDP port unreachable" }
 925                         default { append icmpv6_msg "unknown" }
 926                     }
 927                     set error 1
 928                 }
 929                 2 {
 930                     append icmpv6_msg "packet too big"
 931                     set error 1
 932                 }
 933                 3 {
 934                     append icmpv6_msg "time exceeded/"
 935                     switch -- $type {
 936                         0 { append icmpv6_msg "hop limit" }
 937                         1 { append icmpv6_msg "fragment reassembly" }
 938                         default { append icmpv6_msg "unknown" }
 939                     }
 940                     set error 1
 941                 }
 942                 4 {
 943                     append icmpv6_msg "parameter problem"
 944                     switch -- $type {
 945                         0 { append icmpv6_msg "erroneous header" }
 946                         1 { append icmpv6_msg "unrecognized next header" }
 947                         2 { append icmpv6_msg "unrecognized option" }
 948                         default { append icmpv6_msg "unknown" }
 949                     }
 950                     set error 1
 951                 }
 952                 128 {
 953                     append icmpv6_msg "ping request"
 954                     # FIXME: is this the same format as for icmpv4?
 955                 }
 956                 129 {
 957                     append icmpv6_msg "ping reply"
 958                     # FIXME: is this the same format as for icmpv4?
 959                 }
 960                 130 {
 961                     append icmpv6_msg "group membership query"
 962                 }
 963                 131 {
 964                     append icmpv6_msg "group membership report"
 965                 }
 966                 132 {
 967                     append icmpv6_msg "group membership reduction"
 968                 }
 969                 133 {
 970                     append icmpv6_msg "router solicitation"
 971                 }
 972                 134 {
 973                     append icmpv6_msg "router advertisement"
 974                 }
 975                 135 {
 976                     append icmpv6_msg "neighbour solicitation"
 977                 }
 978                 136 {
 979                     append icmpv6_msg "neighbour advertisement"
 980                 }
 981                 137 {
 982                     append icmpv6_msg "redirect"
 983                 }
 984             }
 985
 986             if { $error && ([string length $packet] >= 44) } {
 987                 # The ICMP message contains an IPv6 header and hopefully the TCP or UDP ports as well
 988                 binary scan $packet {isccH16H16SS} icmp_junk1 icmp_junk2 ip_protocol icmp_junk3 ip_source ip_dest ip_source_port ip_dest_port
 989                 if { 6 == $ip_protocol } {
 990                     append icmpv6_msg ", tcp"
 991                 } elseif { 17 == $ip_protocol } {
 992                     append icmpv6_msg ", udp"
 993                 }
 994                 append icmpv6_msg " >[ethernet::inet_ipv4_ntoa $ip_dest]:$ip_dest_port <[ethernet::inet_ipv6_ntoa $ip_source]:$ip_source_port"
 995             }
 996             append icmpv6_msg "\n"
 997             synth::output $icmpv6_msg "eth_icmpv6"
 998
 999             if { !$data } {
1000                 return
1001             }
1002
1003         } elseif { 6 == $ip_protocol } {
1004             # TCP
1005             if { [string length $packet] < 20 } {
1006                 return
1007             }
1008             binary scan $packet {SSIIccSSS} source_port dest_port seq ack hdrsize flags winsize checksum urg
1009             set source_port [expr $source_port & 0x0FFFF]
1010             set dest_port   [expr $dest_port & 0x0FFFF]
1011             set hdrsize     [expr ($hdrsize >> 4) & 0x0F]
1012             set winsize     [expr $winsize & 0x0FFFF]
1013             set urg         [expr $urg & 0x0FFFF]
1014
1015             set tcp_msg "$device $direction tcp: "
1016             append tcp_msg " >${dest_name}:${dest_port}"
1017             if { [info exists ethernet::services($dest_port,udp)] } {
1018                 append tcp_msg "($ethernet::services($dest_port,udp))"
1019             }
1020             append tcp_msg "<${source_name}:$source_port"
1021             if { [info exists ethernet::services($source_port,udp)] } {
1022                 append tcp_msg "($ethernet::services($source_port,udp))"
1023             }
1024
1025             append tcp_msg ", "
1026             if { $flags & 0x08 } {
1027                 append tcp_msg "PSH "
1028             }
1029             if { $flags & 0x04 } {
1030                 append tcp_msg "RST "
1031             }
1032             if { $flags & 0x02 } {
1033                 append tcp_msg "SYN "
1034             }
1035             if { $flags & 0x01 } {
1036                 append tcp_msg "FIN "
1037             }
1038             append tcp_msg [format "seq %u" $seq]
1039
1040             if { 0 != ($flags & 0x010) } {
1041                 append tcp_msg [format ", ACK %u" $ack]
1042             }
1043             append tcp_msg ", win $winsize"
1044             if { 0 != ($flags & 0x020) } {
1045                 append tcp_msg ", URG $urg"
1046             }
1047             append tcp_msg "\n"
1048             synth::output $tcp_msg "eth_tcp"
1049
1050             set packet [string range $packet [expr 4 * $hdrsize] end]
1051         } elseif { 17 == $ip_protocol } {
1052             # UDP
1053             if { [string length $packet] < 8 } {
1054                 return
1055             }
1056             set udp_msg "$device $direction: udp "
1057             binary scan $packet {SSSS} source_port dest_port len checksum
1058             set source_port [expr $source_port & 0x0FFFF]
1059             set dest_port   [expr $dest_port   & 0x0FFFF]
1060             append udp_msg [format "%d bytes, " [expr $len & 0x0FFFF]]
1061             append udp_msg " >${dest_name}:$dest_port"
1062             if { [info exists ethernet::services($dest_port,udp)] } {
1063                 append udp_msg "($ethernet::services($dest_port,udp))"
1064             }
1065             append udp_msg "<${source_name}:$source_port"
1066             if { [info exists ethernet::services($source_port,udp)] } {
1067                 append udp_msg "($ethernet::services($source_port,udp))"
1068             }
1069             append udp_msg "\n"
1070             synth::output $udp_msg "eth_udp"
1071             set packet [string range $packet 8 end]
1072         } else {
1073             # Unknown protocol, so no way of knowing where the data starts.
1074             return
1075         }
1076
1077         # At this point we may have a payload. This should be
1078         # dumped in both hex and ascii. The code tries to preserve
1079         # alignment.
1080         if { [string length $packet] == 0 } {
1081             return
1082         }
1083         set hexdata_msg "$device $direction: data [format_hex_data $packet]\n"
1084         set asciidata_msg "$device $direction: data "
1085         set len [string length $packet]
1086         if { $len > $ethernet::max_show } {
1087             set len $ethernet::max_show
1088         }
1089         for { set i 0 } { $i < $len } { incr i } {
1090             set char [string index $packet $i]
1091             if { "\r" == $char } {
1092                 append asciidata_msg "\\r"
1093             } elseif { "\n" == $char } {
1094                 append asciidata_msg "\\n"
1095             } elseif { "\t" == $char } {
1096                 append asciidata_msg "\\t"
1097             } elseif { [string is print -strict $char] } {
1098                 append asciidata_msg " $char"
1099             } else {
1100                 append asciidata_msg "??"
1101             }
1102             if { 3 == ($i % 4) } {
1103                 append asciidata_msg " "
1104             }
1105         }
1106         append asciidata_msg "\n"
1107         synth::output $hexdata_msg "eth_hexdata"
1108         synth::output $asciidata_msg "eth_asciidata"
1109
1110         return
1111     }
1112
1113     # A utility for handling the ethernet record button on the toolbar
1114     proc logging_button_toggle { } {
1115         if { $ethernet::logging_enabled } {
1116             set ethernet::logging_enabled 0
1117             .toolbar.ethernet_logging configure -relief flat
1118         } else {
1119             set ethernet::logging_enabled 1
1120             .toolbar.ethernet_logging configure -relief sunken
1121         }
1122     }
1123
1124     # A dummy procedure for initialization. All of this could execute at
1125     # the toplevel, but there are lots of locals.
1126     proc filters_initialize { } {
1127         ethernet::read_services
1128         ethernet::read_protocols
1129         ethernet::read_hosts
1130
1131         # Add a button on the toolbar for enabling/disabling logging.
1132         # Also add an entry to the help menu
1133         if { $synth::flag_gui } {
1134             button .toolbar.ethernet_logging -image $ethernet::image_netrecord -borderwidth 2 -relief flat -command ethernet::logging_button_toggle
1135             pack .toolbar.ethernet_logging -side left -padx 2
1136             synth::register_balloon_help .toolbar.ethernet_logging "Record ethernet traffic"
1137
1138             if { [synth::tdf_has_option "ethernet" "logging"] } {
1139                 set ethernet::logging_enabled [synth::tdf_get_option "ethernet" "logging"]
1140             } else {
1141                 # Default to logging ethernet traffic. This may not be the right thing to do
1142                 # because users may see too much output by default, but it is easy enough
1143                 # to disable.
1144                 set ethernet::logging_enabled 1
1145             }
1146             if { $ethernet::logging_enabled } {
1147                 .toolbar.ethernet_logging configure -relief sunken
1148             }
1149
1150             set ethernet_help [file join $synth::device_src_dir "doc" "devs-eth-synth-ecosynth.html"]
1151             if { ![file readable $ethernet_help] } {
1152                 synth::report_warning "Failed to locate synthetic ethernet documentation $ethernet_help\n   \
1153                         Help->Ethernet target menu option disabled.\n"
1154                 set ethernet_help ""
1155             }
1156             if { "" == $ethernet_help } {
1157                 .menubar.help add command -label "Ethernet" -state disabled
1158             } else {
1159                 .menubar.help add command -label "Ethernet" -command [list synth::handle_help "file://$ethernet_help"]
1160             }
1161         }
1162
1163         if { [synth::tdf_has_option "ethernet" "max_show"] } {
1164             set ethernet::max_show [synth::tdf_get_option "ethernet" "max_show"]
1165             if { ! [string is integer -strict $ethernet::max_show] } {
1166                 synth::report_error "Ethernet device, invalid value in target definition file $synth::target_definition\n   \
1167                                      Entry max_show should be a simple integer, not $ethernet::max_show\n"
1168                 set ethernet::init_ok 0
1169             }
1170         }
1171
1172         # Filters. First, perform some validation.
1173         set known_filters [list "ether" "arp" "ipv4" "ipv6" "icmpv4" "icmpv6" "udp" "tcp" "hexdata" "asciidata"]
1174         set tdf_filters [synth::tdf_get_options "ethernet" "filter"]
1175         array set filter_options [list]
1176
1177         foreach filter $tdf_filters {
1178             if { 0 == [llength $filter] } {
1179                 synth::report_error "Ethernet device, invalid value in target definition file $synth::target_definition\n   \
1180                                      Option \"filter\" requires the name of a known filters.\n"
1181                 set ethernet::init_ok 0
1182                 continue
1183             }
1184             set name [lindex $filter 0]
1185             if { [info exists filter_options($name)] } {
1186                 synth::report_error "Ethernet device, invalid value in target definition file $synth::target_definition\n   \
1187                                      \"filter $name\" should be defined only once.\n"
1188                 set ethernet::init_ok 0
1189                 continue
1190             }
1191             if { -1 == [lsearch -exact $known_filters $name] } {
1192                 synth::report_error "Ethernet device, invalid value in target definition file $synth::target_definition\n   \
1193                                      Unknown filter \"$name\".\n   \
1194                                      Known filters are $known_filters\n"
1195                 set ethernet::init_ok 0
1196                 continue
1197             }
1198             set filter_options($name) [lrange $filter 1 end]
1199         }
1200
1201         # We now know about all the filter entries in the target definition file.
1202         # Time to create the filters themselves, provided we are running in GUI mode.
1203         if { $synth::flag_gui } {
1204             foreach filter $known_filters {
1205                 if { ! [info exists filter_options($filter)] } {
1206                     synth::filter_add "eth_$filter" -text "ethernet $filter"
1207                 } else {
1208                     array set parsed_options [list]
1209                     set message ""
1210                     if { ![synth::filter_parse_options $filter_options($filter) parsed_options message] } {
1211                         synth::report_error \
1212                             "Invalid entry in target definition file $synth::target_definition\n   \
1213                              Ethernet filter $filter\n   $message"
1214                         set ethernet::init_ok 0
1215                     } else {
1216                         set parsed_options("-text") "ethernet $filter"
1217                         synth::filter_add_parsed "eth_$filter" parsed_options
1218                     }
1219                 }
1220             }
1221         }
1222     }
1223     ethernet::filters_initialize
1224 }
1225
1226 return ethernet::instantiate