[movitz-cvs] CVS update: movitz/losp/lib/net/arp.lisp

[Frode Vatvedt Fjeld]

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 at 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))))