Looking for bad ethernet hosts on your local network

[Mabry Tyson <TYSON%sri-stripe.arpa@CSNET-RELAY>]

Occasionally we get a host on our local network putting out bad packets on the
network or causing collisions.  The following has proved helpful to us.

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: NETI; Base: 10 -*-

;;; Copyright 1986 by Mabry Tyson, SRI International.

;;; This code is intended to help track down hosts that are putting
;;; trash out on your local ethernet when they are talking.
;;; Call PING-HOSTS-IN-BACKGROUND.

;;; Only usable with IP-TCP loaded.
;;; If you don't have IP-TCP, you shouldn't use this code but instead
;;; see SYS:NETWORK;CHAOS-PERF.

;;; This works with other TCP/IP hosts (eg SUNs, VAXen, ...) on your net.
;;; Be sure they are in your local namespace with their site set to yours
;;; so (NETI:GET-LOCAL-HOSTS) finds them.

(defun PING-HOST (host &key (ntimes 100) (stream standard-output))
  (let ((phost (net:parse-host host)))
    (condition-case (e)
	(let ((old-collisions %net-collisions)
	      (old-crc %net-crc-errors)
	      (old-allignment %net-alignment-errors)
	      (successes (loop repeat ntimes
			       count (tcp:send-icmp-echo phost))))
	  (if (> (+ (- ntimes successes)
		    (- %net-collisions old-collisions)
		    (- %net-crc-errors old-crc)
		    (- %net-alignment-errors old-allignment))
		 0)
	      (format stream
		      "~%Talking to ~A ~D times: ~d failures; ~d collisions; ~d crc; ~d alignment."
		      phost ntimes (- ntimes successes)
		      (- %net-collisions old-collisions)
		      (- %net-crc-errors old-crc)
		      (- %net-alignment-errors old-allignment))
	      ))
      (sys:network-error
	(format stream "~%****** Network error in talking to ~A: ~a" phost e))
      (sys:error
	(format stream "~%****** Unknown error in talking to ~A: ~A" phost e))))
    )

(defun PING-HOSTS-IN-BACKGROUND (&optional (ntimes 100) (hosts (neti:get-local-hosts)))
  (process-run-function
    "Ping-hosts"
    (function (lambda (ntimes hosts)
		(tv:notify nil
			   "Result of pinging ~A:~{~a~}"
			   (loop for host in hosts collect (net:parse-host host))
			   (or (loop for host in hosts
				     when (ping-host host :ntimes ntimes :stream nil)
				       collect it)
			       '("All hosts ok")))))
    ntimes hosts))