Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv7768
Modified Files: arp.lisp Log Message: Use untyped (i.e. memref) accessors to packets.
Date: Tue Nov 23 17:14:33 2004 Author: ffjeld
Index: movitz/losp/lib/net/arp.lisp diff -u movitz/losp/lib/net/arp.lisp:1.5 movitz/losp/lib/net/arp.lisp:1.6 --- movitz/losp/lib/net/arp.lisp:1.5 Thu Jul 22 02:58:50 2004 +++ movitz/losp/lib/net/arp.lisp Tue Nov 23 17:14:33 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Thu Mar 20 15:01:15 2003 ;;;; -;;;; $Id: arp.lisp,v 1.5 2004/07/22 00:58:50 ffjeld Exp $ +;;;; $Id: arp.lisp,v 1.6 2004/11/23 16:14:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -45,14 +45,11 @@ (+ start 28))) (setf packet (make-array +min-ethernet-frame-size+ :element-type '(unsigned-byte 8)))) - (setf (aref packet (+ start 0)) (ldb (byte 8 8) hard-type) - (aref packet (+ start 1)) (ldb (byte 8 0) hard-type) - (aref packet (+ start 2)) (ldb (byte 8 8) prot-type) - (aref packet (+ start 3)) (ldb (byte 8 0) prot-type) - (aref packet (+ start 4)) hard-size - (aref packet (+ start 5)) prot-size - (aref packet (+ start 6)) (ldb (byte 8 8) op) - (aref packet (+ start 7)) (ldb (byte 8 0) op)) + (setf (ip4-ref packet start 0 :unsigned-byte16) hard-type + (ip4-ref packet start 2 :unsigned-byte16) prot-type + (ip4-ref packet start 4 :unsigned-byte8) hard-size + (ip4-ref packet start 5 :unsigned-byte8) prot-size + (ip4-ref packet start 6 :unsigned-byte16) op) (replace packet sender-hardware-address :start1 (+ start 8) :end1 (+ start 14) @@ -72,35 +69,53 @@
(defun arp-operation (packet &optional (start 14)) - (bvref-u16 packet start 6)) + (ip4-ref packet start 6 :unsigned-byte16))
(defun arp-hard-type (packet &optional (start 14)) - (bvref-u16 packet start 0)) + (ip4-ref packet start 0 :unsigned-byte16))
(defun arp-prot-type (packet &optional (start 14)) - (bvref-u16 packet start 2)) - + (ip4-ref packet start 2 :unsigned-byte16))
(defvar *ne2000* nil) + +(defun arp-polling (ip &optional (waiter #'false)) + (loop with nic = *ip4-nic* + for packet = (muerte.ethernet:receive nic) + until (funcall waiter) + do (transmit nic + (format-ethernet-packet (format-arp-request nil +arp-op-request+ *ip4-ip* + (mac-address nic) ip) + (mac-address nic) + muerte.ethernet:+broadcast-address+ + muerte.ethernet:+ether-type-arp+)) + (when (and packet + (eq +ether-type-arp+ (ether-type packet)) + (eq +arp-op-reply+ (arp-operation packet)) + (not (mismatch packet ip :start1 28 :end1 32))) + (return (subseq packet 22 28))))) (defun test-arp (&optional (ip #(129 242 16 30)) (my-ip #(129 242 16 173)) - (device (or *ne2000* - #+ignore - (setf *ne2000* (some #'muerte.x86-pc.ne2k:ne2k-probe muerte.x86-pc.ne2k:+ne2k-probe-addresses+))))) + (device *ne2000*))
- (loop for packet = (muerte.ethernet:receive device) + (loop with ip = (ip4-address ip) and my-ip = (ip4-address my-ip) + for packet = (muerte.ethernet:receive device) with i = 9999 do (when (= (incf i) 10000) (setf i 0) (transmit device - (format-ethernet-packet (format-arp-request nil +arp-op-request+ my-ip (mac-address device) ip) + (format-ethernet-packet (format-arp-request nil +arp-op-request+ + my-ip (mac-address device) ip) (mac-address device) muerte.ethernet:+broadcast-address+ muerte.ethernet:+ether-type-arp+))) until (or (muerte.x86-pc.keyboard:poll-char) (when (and packet - (or (eq +ether-type-arp+ (ether-type packet)) (warn "not type")) - (or (eq +arp-op-reply+ (arp-operation packet)) (warn "not op")) - (or (not (mismatch packet ip :start1 28 :end1 32)) (warn "mismatch: ~S" (subseq packet 28 32)))) + (or (eq +ether-type-arp+ (ether-type packet)) + (warn "not type")) + (or (eq +arp-op-reply+ (arp-operation packet)) + (warn "not op")) + (or (not (mismatch packet ip :start1 28 :end1 32)) + (warn "mismatch: ~S" (subseq packet 28 32)))) (format t "The MAC of ~S is ~22/ethernet:pprint-mac/." ip packet) t))))