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

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/lib/net
In directory common-lisp.net:/tmp/cvs-serv15239

Modified Files:
	ip4.lisp 
Log Message:
*** empty log message ***
Date: Wed May 25 21:46:07 2005
Author: ffjeld

Index: movitz/losp/lib/net/ip4.lisp
diff -u movitz/losp/lib/net/ip4.lisp:1.19 movitz/losp/lib/net/ip4.lisp:1.20
--- movitz/losp/lib/net/ip4.lisp:1.19	Tue May 24 09:14:53 2005
+++ movitz/losp/lib/net/ip4.lisp	Wed May 25 21:46:07 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Apr 30 13:52:57 2003
 ;;;;                
-;;;; $Id: ip4.lisp,v 1.19 2005/05/24 07:14:53 ffjeld Exp $
+;;;; $Id: ip4.lisp,v 1.20 2005/05/25 19:46:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -242,40 +242,42 @@
 	  (ash x -16)))))
 
 (defun ip-input (stack packet start)
-  (let ((header-size (* 4 (ip-header-length packet start))))
-    (cond
-     ((not (checksum-ok (checksum-octets packet start (+ start header-size))))
-      (warn "IP4 header checksum failed (from ~@/ip4:pprint-ip4/ to ~:/ip4:pprint-ip4/ proto ~A len ~D)."
-	    packet packet
-	    (integer-name 'ip-protocol (ip-protocol packet start) nil)
-	    (length packet))
-      #+ignore
-      (loop for y from 0 below (length packet) by 16
-	  do (fresh-line)
-	     (loop for x from y below (min (length packet) (+ y 16))
-		 when (zerop (rem x 4))
-		 do (format t " ")
-		 do (format t " ~2,'0X" (aref packet x)))
-	     (write-string "   ")
-	     (loop for x from y below (min (length packet) (+ y 16))
-		 as c = (code-char (aref packet x))
-		 do (write-char (if (alphanumericp c) c #\.)))))
-     ((mismatch packet (address stack)
-		:start1 (+ start +ip-header-destination+)
-		:end1 (+ start +ip-header-destination+ 4))
-      #+ignore
-      (warn "IPv4 Packet from ~@/ip4:pprint-ip4/ not for me, but for ~:/ip4:pprint-ip4/."
-	    packet packet))
-     (t (named-integer-case ip-protocol (ip-protocol packet start)
-	  (icmp
-	   (icmp-input stack packet start (+ start header-size)))
-	  (udp
-	   (udp-input stack packet start (+ start header-size)))
-	  (tcp
-	   (tcp-input stack packet start (+ start header-size)))
-	  (t (warn "Unknown IPv4 protocol ~A received from ~@/ip4:pprint-ip4/."
-		   (integer-name 'ip-protocol (ip-protocol packet start) nil)
-		   packet)))))))
+  (with-ip4-header (ip packet :start start)
+    (let ((header-size (* 4 (ip :ihl))))
+      (cond
+       ((not (or (= 0 (ip :checksum))
+		 (checksum-ok (checksum-octets packet start (+ start header-size)))))
+	(warn "IP4 header checksum failed #x~X (from ~@/ip4:pprint-ip4/ to ~:/ip4:pprint-ip4/ proto ~A len ~D)."
+	      (checksum-octets packet start (+ start header-size))
+	      packet packet
+	      (integer-name 'ip-protocol (ip-protocol packet start) nil)
+	      (length packet))
+	(loop for y from 0 below (length packet) by 16
+	    do (fresh-line)
+	       (loop for x from y below (min (length packet) (+ y 16))
+		   when (zerop (rem x 4))
+		   do (format t " ")
+		   do (format t " ~2,'0X" (aref packet x)))
+	       (write-string "   ")
+	       (loop for x from y below (min (length packet) (+ y 16))
+		   as c = (code-char (aref packet x))
+		   do (write-char (if (alphanumericp c) c #\.)))))
+       ((mismatch packet (address stack)
+		  :start1 (+ start +ip-header-destination+)
+		  :end1 (+ start +ip-header-destination+ 4))
+	#+ignore
+	(warn "IPv4 Packet from ~@/ip4:pprint-ip4/ not for me, but for ~:/ip4:pprint-ip4/."
+	      packet packet))
+       (t (named-integer-case ip-protocol (ip :protocol)
+	    (icmp
+	     (icmp-input stack packet start (+ start header-size)))
+	    (udp
+	     (udp-input stack packet start (+ start header-size)))
+	    (tcp
+	     (tcp-input stack packet start (+ start header-size)))
+	    (t (warn "Unknown IPv4 protocol ~A received from ~@/ip4:pprint-ip4/."
+		     (integer-name 'ip-protocol (ip :protocol) nil)
+		     packet))))))))
 
 
 
@@ -307,7 +309,7 @@
 	    (= +ether-type-ip4+
 	       (arp-prot-type packet start))
 	    (not (mismatch (address stack) packet :start2 (+ start 24) :end2 (+ start 28))))
-       (warn "arp request from ~v/ip4:pprint-ip4/." (+ start 14) packet)
+       (warn "arp request from ~v/ip4:pprint-ip4/ len ~D." (+ start 14) packet (length packet))
        (transmit (interface stack)
 		 (format-ethernet-packet (format-arp-request nil +arp-op-reply+
 							     (address stack)
@@ -316,12 +318,12 @@
 							     :target-hardware-address packet
 							     :target-hardware-address-start (+ start 8))
 					 (mac-address (interface stack))
-					 packet
-					 muerte.ethernet:+ether-type-arp+
-					 :destination-start (+ start 8))))
+					 (ether-source packet)
+					 muerte.ethernet:+ether-type-arp+)))
       (t (unknown-packet stack packet)
-	 #+ignore (warn "ARP request for not me ~/ip4:pprint-ip4/: ~v/ip4:pprint-ip4/."
-			(address stack) (+ start 24) packet))))
+	 #+ignore
+	 (warn "ARP request for not me ~/ip4:pprint-ip4/: ~v/ip4:pprint-ip4/."
+	       (address stack) (+ start 24) packet))))
     (#.+arp-op-reply+
      (warn "Received an ARP reply: ~v/ip4:pprint-ip4/ is ~v/ethernet:pprint-mac/."
 	   (+ start 14) packet