Today I wrote a small ethernet switch using my Lisp networking code. A ways back I broke it into separate "low-level networking library" and "partial TCP/IP stack" pieces, which makes it easier to write other applications like this switch. It's surprising how many useful throw-away applications have popped up at work recently when testing our latest network appliance.

I also added support for PF_PACKET sockets in addition to TAP interfaces. PF_PACKET sockets are better for switchey things because they directly access existing interfaces.

The switch is a toy, but I like it because it works and it fits on one screen. (Your screen mileage may vary.)

Here's the code:

;;; switch.lisp -- a toy ethernet switch built on `netlib'.
;;; (netlib source is at http://www.sourceforge.net/projects/slitch/)
 
(defpackage :switch
  (:use :common-lisp :netlib)
  (:export :start))
 
(in-package :switch)
 
(defvar *ports* nil
  "Array of switch ports (network devices).")
 
(defvar *fdb* (make-hash-table :test #'equalp)
  "Forwarding database: maps MAC address onto port number.")
 
(defun start (&rest devices)
  "Start switching packets between DEVICES."
  (setq *ports* (concatenate 'vector devices))
  (loop for device across *ports*
        for port from 0
        do (init-port device port)))
 
(defun init-port (device port)
  "Initialize DEVICE as an input port (number PORT)."
  (netdev-enable device
                 ;; This function is called when a frame arrives.
                 ;; FRAME is an ethernet frame as an array of bytes.
                 (lambda (frame) (input frame port))))
 
(defun input (frame input-port)
  "Process a FRAME arriving on INPUT-PORT."
  (multiple-value-bind (source destination) (header-addresses frame)
    (update-fdb source input-port)
    (let ((output-port (where-is destination)))
      (cond ((null output-port)
             (flood frame input-port))
            ((/= output-port input-port)
             (send frame output-port))))))
 
(defun header-addresses (frame)
  "Return the source and destination addresses from FRAME's ethernet header."
  (with-input-from-frame (stream frame)
    (let ((header (read-ethh stream)))
      (values (ethh-src header) (ethh-dest header)))))
 
(defun update-fdb (address port)
  "Update the forwarding database: ADDRESS is on PORT."
  (unless (ethernet-multicast-p address)
    (setf (gethash address *fdb*) port)))
 
(defun where-is (address)
  "Return the port that ADDRESS is on, or NIL if unknown."
  (gethash address *fdb*))
 
(defun send (frame output-port)
  "Send FRAME to OUTPUT-PORT."
  (netdev-tx (aref *ports* output-port) frame))
 
(defun flood (frame input-port)
  "Send FRAME to all ports except INPUT-PORT."
  (dotimes (output-port (length *ports*))
    (unless (= output-port input-port)
      (send frame output-port))))