[movitz-cvs] CVS update: movitz/losp/lib/net/ip4.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Sat May 21 22:36:17 UTC 2005
Update of /project/movitz/cvsroot/movitz/losp/lib/net
In directory common-lisp.net:/tmp/cvs-serv4811
Modified Files:
ip4.lisp
Log Message:
*** empty log message ***
Date: Sun May 22 00:36:17 2005
Author: ffjeld
Index: movitz/losp/lib/net/ip4.lisp
diff -u movitz/losp/lib/net/ip4.lisp:1.17 movitz/losp/lib/net/ip4.lisp:1.18
--- movitz/losp/lib/net/ip4.lisp:1.17 Tue Apr 19 08:50:04 2005
+++ movitz/losp/lib/net/ip4.lisp Sun May 22 00:36:16 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.17 2005/04/19 06:50:04 ffjeld Exp $
+;;;; $Id: ip4.lisp,v 1.18 2005/05/21 22:36:16 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -30,7 +30,9 @@
#:format-udp-header
#:*ip4-nic*
#:*ip4-ip*
- #:*ip4-router*))
+ #:*ip4-router*
+
+ #:with-ip4-header))
(in-package muerte.ip4)
@@ -38,6 +40,123 @@
(defvar *ip4-ip* nil)
(defvar *ip4-router* nil)
+#| RFC 760: http://www.faqs.org/rfcs/rfc760.html
+ 0 1 2 3
+ 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ |Version| IHL |Type of Service| Total Length |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Identification |Flags| Fragment Offset |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Time to Live | Protocol | Header Checksum |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Source Address |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Destination Address |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Options | Padding |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+|#
+
+(defmacro with-ip4-header ((ip4 packet &key (start 0)) &body body)
+ (let ((packet-var (gensym "ip4-packet-"))
+ (start-var (gensym "ip4-packet-start"))
+ (offset-var (gensym "ip4-packet-offset-")))
+ (macrolet ((mmem (offset type)
+ ```(memref ,packet-var (+ ,',offset ,offset-var) :type ,',type :endian :big)))
+ `(let* ((,start-var ,start)
+ (,packet-var (ensure-data-vector ,packet ,start-var 20))
+ (,offset-var (+ ,start-var (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+ (macrolet ((,ip4 (slot)
+ (ecase slot
+ (:version
+ `(ldb (byte 4 4) ,,(mmem 0 :unsigned-byte8)))
+ (:ihl ; IP header-length in 32-bit units.
+ `(ldb (byte 4 0) ,,(mmem 0 :unsigned-byte8)))
+ (:tos ; type-of-service
+ ,(mmem 1 :unsigned-byte8))
+ (:length
+ ,(mmem 2 :unsigned-byte16))
+ (:identification
+ ,(mmem 4 :unsigned-byte16))
+ (:ttl
+ ,(mmem 8 :unsigned-byte8))
+ (:protocol
+ ,(mmem 9 :unsigned-byte8))
+ (:checksum
+ ,(mmem 10 :unsigned-byte16))
+ ((:compute-checksum)
+ `(logxor #xffff (mem-checksum ,',packet-var ,',offset-var 20) #+ignore
+ (checksum-octets ,',packet-var ,',start-var (+ 20 ,',start-var))))
+ (:source
+ ,(mmem 12 :unsigned-byte32))
+ (:destination
+ ,(mmem 16 :unsigned-byte32))
+ (:address-length 4)
+ (:address-offset `(+ 12 ,',offset-var))
+ (:end `(+ 20 ,',start-var)))))
+ , at body)))))
+
+(defmacro with-udp-header ((udp packet &key (start '(ip :end))) &body body)
+ (let ((packet-var (gensym "udp-packet-"))
+ (start-var (gensym "udp-packet-start"))
+ (offset-var (gensym "udp-packet-offset-")))
+ (macrolet ((mmem (offset type)
+ ```(memref ,packet-var (+ ,',offset ,offset-var) :type ,',type :endian :big)))
+ `(let* ((,start-var ,start)
+ (,packet-var (ensure-data-vector ,packet ,start-var 20))
+ (,offset-var (+ ,start-var (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+ (macrolet ((,udp (slot &optional arg)
+ (ecase slot
+ (:source-port
+ ,(mmem 0 :unsigned-byte16))
+ (:destination-port
+ ,(mmem 2 :unsigned-byte16))
+ (:length
+ ,(mmem 4 :unsigned-byte16))
+ (:checksum
+ ,(mmem 6 :unsigned-byte16))
+ ((:compute-checksum)
+ `(logxor #xffff
+ (add-u16-ones-complement (mem-checksum ,',packet-var
+ (,arg :address-offset)
+ (* 2 (,arg :address-length)))
+ +ip-protocol-udp+
+ (,',udp :length)
+ (mem-checksum ,',packet-var ,',offset-var
+ (,',udp :length)))))
+ (:end `(+ 8 ,',start-var)))))
+ , at body)))))
+
+
+(defun mem-checksum (packet offset length)
+ (with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :ebx) packet)
+ (:compile-form (:result-mode :ecx) offset)
+ (:compile-form (:result-mode :esi) length)
+ ;; (:movl :eax :ecx) ; ecx = start
+ ;; (:subl :eax :esi) ; esi = (- end start)
+ ;; (:movl 0 :eax)
+ (:xorl :eax :eax)
+ (:testl :esi :esi)
+ (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
+ (:xorl :edx :edx)
+ (:std)
+ checksum-loop
+ (:movw (:ebx 0 :ecx) :ax)
+ (:xchgb :al :ah)
+ (:addl 2 :ecx)
+ (:addl :eax :edx)
+ (:subl #.(cl:* 2 movitz:+movitz-fixnum-factor+) :esi)
+ (:jnbe 'checksum-loop)
+ (:movw :dx :ax)
+ (:shrl 16 :edx)
+ (:addw :dx :ax)
+ (:movl (:ebp -4) :esi)
+ end-checksum-loop
+ (:shll #.movitz:+movitz-fixnum-shift+ :eax)
+ (:cld)))
+
(defmacro ip4-ref (packet start offset type)
`(memref ,packet (+ (muerte:movitz-type-slot-offset 'movitz-basic-vector 'data)
,start ,offset)
@@ -457,6 +576,12 @@
(defun ip4-address (specifier &optional (start 0))
(or (ignore-errors
(typecase specifier
+ ((unsigned-byte 32)
+ (assert (= 0 start))
+ (loop with address = (make-array 4 :element-type '(unsigned-byte 8))
+ for i from 0 to 3
+ do (setf (aref address (- 3 i)) (ldb (byte 8 (* 8 i)) specifier))
+ finally (return address)))
((simple-array (unsigned-byte 8) (*))
(if (= start 0)
specifier
@@ -487,14 +612,17 @@
muerte.x86-pc.ne2k:*ne2k-probe-addresses*)))
(assert ethernet ethernet "No ethernet device.")
(setf *ip4-nic* ethernet)))
- (unless *ip4-ip*
- (setf *ip4-ip* (ip4-address ip)))
- (unless *ip4-router*
- (setf *ip4-router* (ip4-address router)))
- ;; This is to announce our presence on the LAN..
- (assert (polling-arp *ip4-router* (lambda ()
- (eql #\space (muerte.x86-pc.keyboard:poll-char))))
- () "Unable to resolve ~/ip4:pprint-ip4/ by ARP." *ip4-router*)
+ (when ip
+ (unless *ip4-ip*
+ (setf *ip4-ip* (ip4-address ip))))
+ (when router
+ (unless *ip4-router*
+ (setf *ip4-router* (ip4-address router))))
+ (when *ip4-router*
+ ;; This is to announce our presence on the LAN..
+ (assert (polling-arp *ip4-router* (lambda ()
+ (eql #\space (muerte.x86-pc.keyboard:poll-char))))
+ () "Unable to resolve ~/ip4:pprint-ip4/ by ARP." *ip4-router*))
(values *ip4-nic* *ip4-ip*))
(defun ip4-test ()
More information about the Movitz-cvs
mailing list