;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*- ;;; ;;; Touched: Wed Apr 18 20:51:00 2007 +0530 ;;; Time-stamp: <2007-04-21 04:23:28 madhu> ;;; Copyright 2007 (C) Madhu. All Rights Reserved. ;;; Status: Experimental. DO NOT REDISTRIBUTE. ;;; Bugs-To: ;;; #+nil (user:lc "home:cmu/binary-types-0.90/binary-types") (defpackage "LIBPCAP-PARSER-1-1" (:use "CL" "BINARY-TYPES") (:export)) (in-package "LIBPCAP-PARSER-1-1") ;;; ;;; Text and definitions takenfrom /usr/include/pcap.h from ;;; libpcap-0.7.2. ;;; (define-binary-class pcap-file-header () ((magic :binary-type 'u32 :documentation "magic.") (major-version :binary-type 'u16 :documentation "version_major. 2.") (minor-version :binary-type 'u16 :documentation "version_minor. 4.") (this-zone :binary-type 's32 :documentation "thiszone. GMT to local correction.") (sigfigs :binary-type 'u32 :documentation "sigfigs. Accuracy of timestamps.") (snaplen :binary-type 'u32 :documentation "snaplen. Max length saved portion of each packet.") (linktype :binary-type 'u32 :documentation "linktype. Data link type (LINKTYPE_*).")) (:documentation "pcap_file_header. The first record in the file contains saved values for some of the flags used in the printout phases of tcpdump. Many fields here are 32 bit ints so compilers won't insert unwanted padding; these files need to be interchangeable across architectures.")) (defvar *pcap-file-header-magic* '((:big-endian #xa1b2c3d4) (:little-endian #xd4c3b2a1)) "Lookup table.") ;; ;; Table lookup Utilities. Each Lookup Table has lists of the form ;; (:KEYWORD NUM [DESC]) ;; (defun table-lookup (num table) (rassoc num table :key #'car)) (defun table-lookup-type (num table) (car (rassoc num table :key #'car))) (defun table-lookup-desc (num table) (caddr (rassoc num table :key #'car))) (define-binary-class timeval () ; hokey ((tv-sec :binary-type 'u32 :documentation "tv_sec. Seconds since the epoch") (tv-usec :binary-type 's32 :documentation "tv_usec. Signed count of microseconds")) (:documentation "timeval. A time value that is accurate to the nearest microsecond but also has a range of years. Taken from ussr/include/bits/type.h.")) #+nil (defmethod print-object ((obj timeval) stream) (print-unreadable-object (obj stream :type t :identity t) (when (and (slot-boundp obj 'tv-sec) (slot-boundp obj 'tv-usec)) (with-slots (tv-sec tv-usec) obj (user:date :utime (truncate (+ user::+unix-epoch+ tv-sec (/ tv-usec 1000000))) :stream stream))))) (define-binary-class pcap-packet-header () ((timestamp :binary-type 'timeval :documentation "ts. Time stamp.") (caplen :binary-type 'u32 :documentation "Length of portion present.") (len :binary-type 'u32 :documentation "Length this packet (off wire).")) (:documentation "pcap_pkthdr. Each packet in the dump file is prepended with this generic header. This gets around the problem of different headers for different packet interfaces.")) ;;; ;;; ;;; Data-link level type codes. Taken from /usr/include/net/bpf.h ;;; (defvar *data-link-level-type-codes* '((:DLT_NULL 0 "No link-layer encapsulation.") (:DLT_EN10MB 1 "Ethernet (10Mb).") (:DLT_EN3MB 2 "Experimental Ethernet (3Mb).") (:DLT_AX25 3 "Amateur Radio AX.25.") (:DLT_PRONET 4 "Proteon ProNET Token Ring.") (:DLT_CHAOS 5 "Chaos.") (:DLT_IEEE802 6 "IEEE 802 Networks.") (:DLT_ARCNET 7 "ARCNET.") (:DLT_SLIP 8 "Serial Line IP.") (:DLT_PPP 9 "Point-to-point Protocol.") (:DLT_FDDI 10 "FDDI.") ;; ;; These are values from the traditional libpcap "bpf.h". ;; Ports of this to particular platforms should replace these definitions ;; with the ones appropriate to that platform, if the values are ;; different on that platform. ;; (:DLT_ATM_RFC1483 11 "LLC/SNAP encapsulated ATM.") (:DLT_RAW 12 "Raw IP.") ;; ;; These are values from BSD/OS's "bpf.h". ;; These are not the same as the values from the traditional libpcap ;; "bpf.h"; however, these values shouldn't be generated by any ;; OS other than BSD/OS, so the correct values to use here are the ;; BSD/OS values. ;; ;; Platforms that have already assigned these values to other ;; DLT_ codes, however, should give these codes the values ;; from that platform, so that programs that use these codes will ;; continue to compile - even though they won't correctly read ;; files of these types. ;; ;;#ifdef __NetBSD__ ;;#ifndef DLT_SLIP_BSDOS ;;(:DLT_SLIP_BSDOS 13 "BSD/OS Serial Line IP.") ;;(:DLT_PPP_BSDOS 14 "BSD/OS Point-to-point Protocol.") ;;#endif ;;#else (:DLT_SLIP_BSDOS 15 "BSD/OS Serial Line IP.") (:DLT_PPP_BSDOS 16 "BSD/OS Point-to-point Protocol.") ;;#endif ;; (:DLT_ATM_CLIP 19 "Linux Classical-IP over ATM.") ;; ;; These values are defined by NetBSD; other platforms should refrain from ;; using them for other purposes, so that NetBSD savefiles with link ;; types of 50 or 51 can be read as this type on all platforms. ;; (:DLT_PPP_SERIAL 50 "PPP over serial with HDLC encapsulation.") (:DLT_PPP_ETHER 51 "PPP over Ethernet.") ;PPPoE header RFC 2516 ;; ;; Values between 100 and 103 are used in capture file headers as ;; link-layer types corresponding to DLT_ types that differ ;; between platforms; don't use those values for new DLT_ new types. ;; ;; ;; This value was defined by libpcap 0.5; platforms that have defined ;; it with a different value should define it here with that value - ;; a link type of 104 in a save file will be mapped to DLT_C_HDLC, ;; whatever value that happens to be, so programs will correctly ;; handle files with that link type regardless of the value of ;; DLT_C_HDLC. ;; ;; The name DLT_C_HDLC was used by BSD/OS; we use that name for source ;; compatibility with programs written for BSD/OS. ;; ;; libpcap 0.5 defined it as DLT_CHDLC; we define DLT_CHDLC as well, ;; for source compatibility with programs written for libpcap 0.5. ;; (:DLT_C_HDLC 104 "Cisco HDLC.") (:DLT_CHDLC 104 "Cisco HDLC for source compatibility with programs written for libpcap 0.5") ;; (:DLT_IEEE802_11 105 "IEEE 802.11 wireless.") ;; ;; 106 is reserved for Linux Classical IP over ATM; it's like DLT_RAW, ;; except when it isn't. (I.e., sometimes it's just raw IP, and ;; sometimes it isn't.) We currently handle it as DLT_LINUX_SLL, ;; so that we don't have to worry about the link-layer header.) ;; ;; Reserved for Frame Relay; BSD/OS has a DLT_FR, with a value of 11, ;; but that collides with other values. DLT_FR and DLT_FRELAY packets ;; start with the Frame Relay header (DLCI, etc.). ;; (:DLT_FRELAY 107 "Frame Relay") ;; ;; OpenBSD DLT_LOOP, for loopback devices; it's like DLT_NULL, except ;; that the AF_ type in the link-layer header is in network byte order. ;; ;; OpenBSD defines it as 12, but that collides with DLT_RAW, so we ;; define it as 108 here. If OpenBSD picks up this file, it should ;; define DLT_LOOP as 12 in its version, as per the comment above - ;; and should not use 108 as a DLT_ value. ;; (:DLT_LOOP 108) ;; ;; Values between 109 and 112 are used in capture file headers as ;; link-layer types corresponding to DLT_ types that might differ ;; between platforms; don't use those values for new DLT_ types ;; other than the corresponding DLT_ types. ;; (:DLT_LINUX_SLL 113 "Linux Cooked sockets") (:DLT_LTALK 114 "Apple LocalTalk hardware.") (:DLT_ECONET 115 "Acorn Econet.") (:DLT_IPFILTER 116 "Reserved for use with OpenBSD ipfilter.") ;; ;; Reserved for use in capture-file headers as a link-layer type ;; corresponding to OpenBSD DLT_PFLOG; DLT_PFLOG is 17 in OpenBSD, ;; but that's DLT_LANE8023 in SuSE 6.3, so we can't use 17 for it ;; in capture-file headers. ;; (:DLT_PFLOG 117) ;; (:DLT_CISCO_IOS 118 "Registered for Cisco-internal use.") ;; ;; Reserved for 802.11 cards using the Prism II chips, with a link-layer ;; header including Prism monitor mode information plus an 802.11 ;; header. ;; (:DLT_PRISM_HEADER 119) ;; ;; Reserved for Aironet 802.11 cards, with an Aironet link-layer header ;; (see Doug Ambrisko's FreeBSD patches). ;; (:DLT_AIRONET_HEADER 120) ;; ;; Reserved for Siemens HiPath HDLC. ;; (:DLT_HHDLC 121) ;; ;; Reserved for RFC 2625 IP-over-Fibre Channel, as per a request from ;; Don Lee . ;; ;; This is not for use with raw Fibre Channel, where the link-layer ;; header starts with a Fibre Channel frame header; it's for IP-over-FC, ;; where the link-layer header starts with an RFC 2625 Network_Header ;; field. ;; (:DLT_IP_OVER_FC 122) ;; ;; Reserved for capturing on Solaris with SunATM. ;; (:DLT_SUNATM 123 "Solaris+SunATM.")) "Lookup table.") ;;; ;;; From man pcap(3) libpcap-0.7.2 ;;; (define-unsigned network-short 2 :big-endian) (define-binary-string string64 8) ; 64bit string (define-binary-class pcap-linux-cooked-encapsulation-header () ((pkttype :binary-type network-short :documentation " A 2-byte ``packet type'', in network byte order, which is one of: 0 packet was sent to us by somebody else 1 packet was broadcast by somebody else 2 packet was multicast, but not broadcast, by somebody else 3 packet was sent by somebody else to somebody else 4 packet was sent by us") (devtype :binary-type network-short :documentation " A 2-byte field, in network byte order, containing a Linux ARPHRD_ value for the link layer device type;") (sendaddrlen :binary-type network-short :documentation " A 2-byte field, in network byte order, containing the length of the link layer address of the sender of the packet (which could be 0);") (dlheader :binary-type string64 :documentation " An 8-byte field containing that number of bytes of the link layer header (if there are more than 8 bytes, only the first 8 are present);") (protocol-type :binary-type network-short :documentation " a 2-byte field containing an Ethernet protocol type, in network byte order, or containing 1 for Novell 802.3 frames without an 802.2 LLC header or 4 for frames beginning with an 802.2 LLC header.")) (:documentation "Link Layer header for Linux ``cooked'' capture encapsulation viz. :DLT_LINUX_SLL.")) ;;; ;;; ;;; 48-bit Ethernet MAC address. ;;; #+nil (define-unsigned mac-address 6 :big-endian) ; XXX TODO intern octet array (defmacro with-mac-address-octets ((u1-var u2-var u3-var u4-var u5-var u6-var) ether-address &body body) (let ((address (gensym))) `(let* ((,address ,ether-address) (,u1-var (ldb (byte 8 40) ,address)) (,u2-var (ldb (byte 8 32) ,address)) (,u3-var (ldb (byte 8 24) ,address)) (,u4-var (ldb (byte 8 16) ,address)) (,u5-var (ldb (byte 8 8) ,address)) (,u6-var (ldb (byte 8 0) ,address))) (declare (type (unsigned-byte 8) ,u1-var ,u2-var ,u3-var ,u4-var ,u5-var ,u6-var) (ignorable ,u1-var ,u2-var ,u3-var ,u4-var ,u5-var ,u6-var)) ,@body))) (defun print-mac-address (mac-address stream) (with-mac-address-octets (u1 u2 u3 u4 u5 u6) mac-address (write u1 :stream stream :base 16) (write-char #\: stream) (write u2 :stream stream :base 16) (write-char #\: stream) (write u3 :stream stream :base 16) (write-char #\: stream) (write u4 :stream stream :base 16) (write-char #\: stream) (write u5 :stream stream :base 16) (write-char #\: stream) (write u6 :stream stream :base 16))) (define-binary-class mac-address () ((mac-string :binary-type (define-unsigned mac-number 6 :big-endian)))) ;; #+nil (defmethod print-object ((obj mac-address) stream) (print-unreadable-object (obj stream :identity t :type t) (with-slots (mac-string) obj (print-mac-address mac-string stream)))) ;;; ;;; Text and definitions taken from /usr/include/net/ethernet.h ;;; (define-binary-class ethernet-header () ((destination :binary-type mac-address :documentation "ether_dhost. Destinaton ethernet address.") (source :binary-type mac-address :documentation "ether_shost. Source ethernet address.") (protocol-type :binary-type 'u16 :documentation "ether_type. Packet type ID field.")) (:documentation "ether_header. Ethernet 10Mb/s frame header.")) (defvar *ethernet-protocol-Ids* '((:ETHERTYPE_PUP #x0200 "Xerox PUP.") (:ETHERTYPE_IP #x0800 "IP.") (:ETHERTYPE_ARP #x0806 "Address resolution.") (:ETHERTYPE_REVARP #x8035 "Reverse ARP") ;; ;; The following are from Linux 2.6.18.2 ;; (:ETH_P_LOOP #x0060 "Ethernet Loopback packet") (:ETH_P_PUP #x0200 "Xerox PUP packet") (:ETH_P_PUPAT #x0201 "Xerox PUP Addr Trans packet") (:ETH_P_IP #x0800 "Internet Protocol packet") (:ETH_P_X25 #x0805 "CCITT X.25") (:ETH_P_ARP #x0806 "Address Resolution packet") (:ETH_P_BPQ #x08FF "G8BPQ AX.25 Ethernet Packet[ NOT AN OFFICIALLY REGISTERED ID ]") (:ETH_P_IEEEPUP #x0a00 "Xerox IEEE802.3 PUP packet") (:ETH_P_IEEEPUPAT #x0a01 "Xerox IEEE802.3 PUP Addr Trans packet") (:ETH_P_DEC #x6000 "DEC Assigned proto") (:ETH_P_DNA_DL #x6001 "DEC DNA Dump/Load") (:ETH_P_DNA_RC #x6002 "DEC DNA Remote Console") (:ETH_P_DNA_RT #x6003 "DEC DNA Routing") (:ETH_P_LAT #x6004 "DEC LAT") (:ETH_P_DIAG #x6005 "DEC Diagnostics") (:ETH_P_CUST #x6006 "DEC Customer use") (:ETH_P_SCA #x6007 "DEC Systems Comms Arch") (:ETH_P_RARP #x8035 "Reverse Addr Res packet") (:ETH_P_ATALK #x809B "Appletalk DDP") (:ETH_P_AARP #x80F3 "Appletalk AARP") (:ETH_P_8021Q #x8100 "802.1Q VLAN Extended Header") (:ETH_P_IPX #x8137 "IPX over DIX") (:ETH_P_IPV6 #x86DD "IPv6 over bluebook") (:ETH_P_SLOW #x8809 "Slow Protocol. See 802.3ad 43B") (:ETH_P_WCCP #x883E "Web-cache coordination protocol defined in draft-wilson-wrec-wccp-v2-00.txt") (:ETH_P_PPP_DISC #x8863 "PPPoE discovery messages ") (:ETH_P_PPP_SES #x8864 "PPPoE session messages") (:ETH_P_MPLS_UC #x8847 "MPLS Unicast traffic ") (:ETH_P_MPLS_MC #x8848 "MPLS Multicast traffic") (:ETH_P_ATMMPOA #x884c "MultiProtocol Over ATM") (:ETH_P_ATMFATE #x8884 "Frame-based ATM Transport over Ethernet") (:ETH_P_AOE #x88A2 "ATA over Ethernet") (:ETH_P_TIPC #x88CA "TIPC") ;; Non DIX types. Won't clash for 1500 types. (:ETH_P_802_3 #x0001 "Dummy type for 802.3 frames ") (:ETH_P_AX25 #x0002 "Dummy protocol id for AX.25 ") (:ETH_P_ALL #x0003 "Every packet (be careful!!!)") (:ETH_P_802_2 #x0004 "802.2 frames") (:ETH_P_SNAP #x0005 "Internal only") (:ETH_P_DDCMP #x0006 "DEC DDCMP: Internal only") (:ETH_P_WAN_PPP #x0007 "Dummy type for WAN PPP frames") (:ETH_P_PPP_MP #x0008 "Dummy type for PPP MP frames") (:ETH_P_LOCALTALK #x0009 "Localtalk pseudo type ") (:ETH_P_PPPTALK #x0010 "Dummy type for Atalk over PPP") (:ETH_P_TR_802_2 #x0011 "802.2 frames") (:ETH_P_MOBITEX #x0015 "Mobitex (kaz@cafe.net)") (:ETH_P_CONTROL #x0016 "Card specific control frames") (:ETH_P_IRDA #x0017 "Linux-IrDA") (:ETH_P_ECONET #x0018 "Acorn Econet") (:ETH_P_HDLC #x0019 "HDLC frames") (:ETH_P_ARCNET #x001A "1A for ArcNet :-)")) "Lookup table.") ;;; ;;; IPv4 Address. RFC 791. From /usr/include/netinet/in.h ;;; #+nil (define-unsigned ipv4-address 4 :big-endian) (defmacro with-ipv4-octets ((u1-var u2-var u3-var u4-var) ipv4-address &body body) (let ((address (gensym))) `(let* ((,address ,ipv4-address) (,u1-var (ldb (byte 8 24) ,address)) (,u2-var (ldb (byte 8 16) ,address)) (,u3-var (ldb (byte 8 8) ,address)) (,u4-var (ldb (byte 8 0) ,address))) (declare (type (unsigned-byte 8) ,u1-var ,u2-var ,u3-var ,u4-var) (type (unsigned-byte 32) ,address)) ,@body))) (defun print-ipv4-address (ipv4-address stream) (declare (type (unsigned-byte 32) ipv4-address)) (with-ipv4-octets (u1 u2 u3 u4) ipv4-address (format stream "~D.~D.~D.~D" u1 u2 u3 u4))) ;; ;; TODO: HOWTO INTERN THESE OBJECTS AS THEY ARE CREATED IN THE ;; BINARY-TYPES LAYERS??? ;; (define-binary-class ipv4-address () ((ipv4-number :binary-type (define-unsigned ipv4-number 4 :big-endian)))) ;; #+nil (defmethod print-object ((obj ipv4-address) stream) (print-unreadable-object (obj stream :identity t :type t) (with-slots (ipv4-number) obj (print-ipv4-address ipv4-number stream)))) ;;; ;;; ARP HEADERS. Field names used correspond to RFC 826. Text and ;;; definitions taken from /usr/include/net/if_arp.h ;;; (define-binary-class arp-header () ((hardware-type :binary-type 'u16 :documentation "ar_hrd. Format of hardware address.") (protocol-type :binary-type 'u16 :documentation "ar_pro. Format of protocol address.") (hardware-length :binary-type 'u8 :documentation "ar_hln. Length of hardware address.") (protocol-length :binary-type 'u8 :documentation "Length of protocol address.") (operation :binary-type 'u16 :documentation "ARP opcode (command).") ;; Variable sized portion follows ) (:documentation "arphdr. See RFC 826 for protocol description. ARP packets are variable in size; the arphdr structure defines the fixed-length portion. Protocol type values are the same as those for 10 Mb/s Ethernet. It is followed by the variable-sized fields ar_sha, arp_spa, arp_tha and arp_tpa in that order, according to the lengths specified.")) (define-binary-class arp-header-vlfeth () ((sender-ha :binary-type mac-address :documentation "__ar_sha[ETH_ALEN]. SenderHardware Address") (sender-ip :binary-type ipv4-address :documentation "__ar_sip[4]. Sender IP address.") (target-ha :binary-type mac-address :documentation "__ar_tha[ETH_ALEN]. Target hardware address.") (target-ip :binary-type ipv4-address :documentation "__ar_tip[4]. Target IP address.")) (:documentation "arp-header variable sized fields, for Ethernet.")) (defvar *ARP-protocol-opcodes* '((:ARPOP_REQUEST 1 "ARP request.") (:ARPOP_REPLY 2 "ARP reply.") (:ARPOP_RREQUEST 3 "RARP request.") (:ARPOP_RREPLY 4 "RARP reply.") (:ARPOP_InREQUEST 8 "InARP request.") (:ARPOP_InREPLY 9 "InARP reply.") (:ARPOP_NAK 10 "(ATM)ARP NAK.")) "Lookup table.") (defvar *arp-protocol-hardware-identifiers* '((:ARPHRD_NETROM 0 "From KA9Q: NET/ROM pseudo.") (:ARPHRD_ETHER 1 "Ethernet 10/100Mbps.") (:ARPHRD_EETHER 2 "Experimental Ethernet.") (:ARPHRD_AX25 3 "AX.25 Level 2.") (:ARPHRD_PRONET 4 "PROnet token ring.") (:ARPHRD_CHAOS 5 "Chaosnet.") (:ARPHRD_IEEE802 6 "IEEE 802.2 Ethernet/TR/TB.") (:ARPHRD_ARCNET 7 "ARCnet.") (:ARPHRD_APPLETLK 8 "APPLEtalk.") (:ARPHRD_DLCI 15 "Frame Relay DLCI.") (:ARPHRD_ATM 19 "ATM.") (:ARPHRD_METRICOM 23 "Metricom STRIP (new IANA id).") (:ARPHRD_IEEE1394 24 "IEEE 1394 IPv4 - RFC 2734.") (:ARPHRD_EUI64 27 "EUI-64.") (:ARPHRD_INFINIBAND 32 "InfiniBand.") ;; ;; Dummy types for non ARP hardware ;; (:ARPHRD_SLIP 256) (:ARPHRD_CSLIP 257) (:ARPHRD_SLIP6 258) (:ARPHRD_CSLIP6 259) (:ARPHRD_RSRVD 260 "Notional KISS type.") (:ARPHRD_ADAPT 264) (:ARPHRD_ROSE 270) (:ARPHRD_X25 271 "CCITT X.25.") (:ARPHRD_HWX25 272 "Boards with X.25 in firmware.") ; XXX TYPO (:ARPHRD_PPP 512) (:ARPHRD_CISCO 513 "Cisco HDLC.") (:ARPHD_HDLC 513) (:ARPHRD_LAPB 516 "LAPB.") (:ARPHRD_DDCMP 517 "Digital's DDCMP.") (:ARPHRD_RAWHDLC 518 "Raw HDLC.") ;; (:ARPHRD_TUNNEL 768 "IPIP tunnel.") (:ARPHRD_TUNNEL6 769 "IPIP6 tunnel.") (:ARPHRD_FRAD 770 "Frame Relay Access Device.") (:ARPHRD_SKIP 771 "SKIP vif.") (:ARPHRD_LOOPBACK 772 "Loopback device.") (:ARPHRD_LOCALTLK 773 "Localtalk device.") (:ARPHRD_FDDI 774 "Fiber Distributed Data Interface.") (:ARPHRD_BIF 775 "AP1000 BIF.") (:ARPHRD_SIT 776 "sit0 device - IPv6-in-IPv4.") (:ARPHRD_IPDDP 777 "IP-in-DDP tunnel.") (:ARPHRD_IPGRE 778 "GRE over IP.") (:ARPHRD_PIMREG 779 "PIMSM register interface.") (:ARPHRD_HIPPI 780 "High Performance Parallel I'face.") (:ARPHRD_ASH 781 "(Nexus Electronics) Ash.") (:ARPHRD_ECONET 782 "Acorn Econet.") (:ARPHRD_IRDA 783 "Linux-IrDA.") (:ARPHRD_FCPP 784 "Point to point fibrechanel.") (:ARPHRD_FCAL 785 "Fibrechanel arbitrated loop.") (:ARPHRD_FCPL 786 "Fibrechanel public loop.") (:ARPHRD_FCFABRIC 787 "Fibrechanel fabric.") (:ARPHRD_IEEE802_TR 800 "Magic type ident for TR.") (:ARPHRD_IEEE80211 801 "IEEE 802.11.")) "Lookup table.") ;;; ;;; INTERNET PROTOCOL HEADERS. RFC 791. Text and definitions taken ;;; from /usr/include/netinet/ip.h. ;;; ;;; bitfields addressing is implicitly little endian. ;;#+little-endian (define-bitfield iphdr-version-field (u8) ;; (((:numeric header-length 4 0)) ((:numeric version 4 4)))) #+nil ;;#+big-endian (define-bitfield iphdr-version-field (u8) (((:numeric version 4 0)) ((:numeric header-length 4 4)))) (define-bitfield iphdr-offset-field (u16) (((:enum :byte (3 13)) :IP_RF 4 ; #x8000 ;Reserved fragment flag. :IP_DF 2 ; #x4000 ;Don't fragment flag. :IP_MF 1 ; #x2000 ;More fragments flag. ) ((:numeric fragment-offset 13 0)))) (define-binary-class ipv4-header-opt () ((length-and-version-field :binary-type iphdr-version-field :documentation "ihl and version.") (tos :binary-type 'u8 :documentation "tos") (total-length :binary-type 'u16 :documentation "tot_len.") (id :binary-type 'u16 :documentation "id.") (offset-field :binary-type iphdr-offset-field :documentation "frag_off.") (ttl :binary-type 'u8 :documentation "ttl.") (protocol :binary-type 'u8 :documentation "protocol.") (checksum :binary-type 'u16 :documentation "check.") (source :binary-type 'ipv4-address :documentation "saddr.") (dest :binary-type 'ipv4-address :documentation "daddr.") ;; The options start here ) (:documentation "iphdr. Including options.")) (define-binary-class ipv4-header () ((length-and-version :binary-type iphdr-version-field :documentation "ip_hl, ip_v.") (tos :binary-type 'u8 :documentation "ip_tos. Type of service.") (total-length :binary-type 'u16 :documentation "ip_len. Total length.") (id :binary-type 'u16 :documentation "ip_id. Identification.") (offset-field :binary-type iphdr-offset-field :documentation "ip_off. Fragment offset field.") (ttl :binary-type 'u8 :documentation "ip_ttl. Time to live.") (protocol :binary-type 'u8 :documentation "ip_p. Protocol") (checksum :binary-type 'u16 :documentation "ip_sum. Checksum.") (source :binary-type 'ipv4-address :documentation "ip_src. Source address.") (dest :binary-type 'ipv4-address :documentation "ip_dst. Destination address.")) (:documentation "ip. Structure of an internet header, naked of options.")) ;; ;; Standard well-defined IP protocols. XXX This should be an ENUM. ;; From /usr/include/netinet/in.h ;; (defvar *ip-protocol-ids* '((:IPPROTO_IP 0 "Dummy protocol for TCP.") (:IPPROTO_HOPOPTS 0 "IPv6 Hop-by-Hop options.") (:IPPROTO_ICMP 1 "Internet Control Message Protocol.") (:IPPROTO_IGMP 2 "Internet Group Management Protocol.") (:IPPROTO_IPIP 4 "IPIP tunnels (older KA9Q tunnels use 94).") (:IPPROTO_TCP 6 "Transmission Control Protocol.") (:IPPROTO_EGP 8 "Exterior Gateway Protocol.") (:IPPROTO_PUP 12 "PUP protocol.") (:IPPROTO_UDP 17 "User Datagram Protocol.") (:IPPROTO_IDP 22 "XNS IDP protocol.") (:IPPROTO_TP 29 "SO Transport Protocol Class 4.") (:IPPROTO_IPV6 41 "IPv6 header.") (:IPPROTO_ROUTING 43 "IPv6 routing header.") (:IPPROTO_FRAGMENT 44 "IPv6 fragmentation header.") (:IPPROTO_RSVP 46 "Reservation Protocol.") (:IPPROTO_GRE 47 "General Routing Encapsulation.") (:IPPROTO_ESP 50 "encapsulating security payload.") (:IPPROTO_AH 51 "authentication header.") (:IPPROTO_ICMPV6 58 "ICMPv6.") (:IPPROTO_NONE 59 "IPv6 no next header.") (:IPPROTO_DSTOPTS 60 "IPv6 destination options.") (:IPPROTO_MTP 92 "Multicast Transport Protocol.") (:IPPROTO_ENCAP 98 "Encapsulation Header.") (:IPPROTO_PIM 103 "Protocol Independent Multicast.") (:IPPROTO_COMP 108 "Compression Header Protocol.") (:IPPROTO_SCTP 132 "Stream Control Transmission Protocol.") (:IPPROTO_RAW 255 "Raw IP packets.")) "Lookup Table.") ;; ;; Standard well-known ports. XXX This should be an ENUM. From ;; /usr/include/netinet/in.h ;; (defvar *ip-port-numbers* '((:IPPORT_ECHO 7 "Echo service.") (:IPPORT_DISCARD 9 "Discard transmissions service.") (:IPPORT_SYSTAT 11 "System status service.") (:IPPORT_DAYTIME 13 "Time of day service.") (:IPPORT_NETSTAT 15 "Network status service.") (:IPPORT_FTP 21 "File Transfer Protocol.") (:IPPORT_TELNET 23 "Telnet protocol.") (:IPPORT_SMTP 25 "Simple Mail Transfer Protocol.") (:IPPORT_TIMESERVER 37 "Timeserver service.") (:IPPORT_NAMESERVER 42 "Domain Name Service.") (:IPPORT_WHOIS 43 "Internet Whois service.") (:IPPORT_MTP 57) (:IPPORT_TFTP 69 "Trivial File Transfer Protocol.") (:IPPORT_RJE 77) (:IPPORT_FINGER 79 "Finger service.") (:IPPORT_TTYLINK 87) (:IPPORT_SUPDUP 95 "SUPDUP protocol.") (:IPPORT_EXECSERVER 512 "execd service.") (:IPPORT_LOGINSERVER 513 "rlogind service.") (:IPPORT_CMDSERVER 514) (:IPPORT_EFSSERVER 520) ;; ;; UDP ports ;; (:IPPORT_BIFFUDP 512) (:IPPORT_WHOSERVER 513) (:IPPORT_ROUTESERVER 520) ;; ;; Ports less than this value are reserved for privileged processes ;; (:IPPORT_RESERVED 1024) ;; ;; ;; Ports greater this value are reserved for (non-privileged) servers. ;; (:IPPORT_USERRESERVED 5000)) "Lookup Table.") ;;; ;;; UDP header as specified by RFC 768, August 1980. From ;;; /usr/include/netinet/udp.h ;;; (define-binary-class udp-header () ((source :binary-type 'u16 :documentation "uh_sport. Source port.") (dest :binary-type 'u16 :documentation "uh_dport. Destination port.") (len :binary-type 'u16 :documentation "uh_ulen. UDP length.") (check :binary-type 'u16 :documentation "uh_sum. UDP checksum.")) (:documentation "udphdr")) ;;; ;;; TCP header. Per RFC 793, September, 1981. From ;;; /usr/include/netinet/tcp.h ;;; ;; #+little-endian (define-bitfield tcphdr-offset (u8) (((:numeric res1 4 4)) ((:numeric doff 4 0)))) #+nil ;; #+big-endian (define-bitfield tcphdr-offset (u8) (((:numeric res1 4 4)) ((:numeric doff 4 0)))) ;; #+little-endian (define-bitfield tcphdr-flags (u8) (((:bits :byte (6 0)) fin 0 syn 1 rst 2 psh 3 ack 4 urg 5) ((:numeric res2 2 6)))) #+nil ;; #+big-endian (define-bitfield tcphdr-flags (u16) (((:numeric res2 2 0)) ((:bits :byte (6 2)) fin 5 syn 4 rst 3 psh 2 ack 1 urg 0))) (define-binary-class tcp-header () ((source :binary-type 'u16 :documentation "th_sport. Source port.") (dest :binary-type 'u16 :documentation "th_dport. Destination port.") (seq :binary-type 'u32 :documentation "th_seq. Sequence Number.") (ack_seq :binary-type 'u32 :documentation "th_ack. Acknowledgement.") (offset :binary-type 'tcphdr-offset) (flags :binary-type 'tcphdr-flags) (window :binary-type 'u16 :documentation "th_win. Window.") (check :binary-type 'u16 :documentation "th_sum. Check sum.") (urp :binary-type 'u16 :documentation "th_urp. Urgent pointer.")) (:documentation "tcphdr.")) ;;; ;;; PPPoE (RFC 2516). From Linux 2.6.18.2 ;;; ;;+little-endian (define-bitfield pppoehdr-version-field (u8) (((:numeric ver 4 0)) ((:numeric type 4 0)))) (define-binary-class pppoe-header () ((version-and-type :binary-type pppoehdr-version-field) (code :binary-type 'u8) (sid :binary-type 'u8 :documentation "Session ID.") (length :binary-type 'u16 :documentation "Payload length.") ;; Tag table follows ) (:documentation "pppoe_hdr.")) ;;; ;;; The data for the following two tables are taken from ethereal ;;; 0.10.11. ;;; (defvar *pppoe-codes* '((:PPPOE_CODE_SESSION #x00 "Session Data") (:PPPOE_CODE_PADO #x7 "Active Discovery Offer (PADO)") (:PPPOE_CODE_PADI #x9 "Active Discovery Initiation (PADI)") (:PPPOE_CODE_PADR #x19 "Active Discovery Request (PADR)") (:PPPOE_CODE_PADS #x65 "Active Discovery Session-confirmation (PADS)") (:PPPOE_CODE_PADT #xa7 "Active Discovery Terminate (PADT)")) "Lookup table.") (defvar *pppoe-tags* '((:PPPOE_TAG_EOL #x0000 "End-Of-List") (:PPPOE_TAG_SVC_NAME #x0101 "Service-Name") (:PPPOE_TAG_AC_NAME #x0102 "AC-Name") (:PPPOE_TAG_HOST_UNIQ #x0103 "Host-Uniq") (:PPPOE_TAG_AC_COOKIE #x0104 "AC-Cookie") (:PPPOE_TAG_VENDOR #x0105 "Vendor-Specific") (:PPPOE_TAG_RELAY_ID #x0110 "Relay-Session-Id") (:PPPOE_TAG_SVC_ERR #x0201 "Service-Name-Error") (:PPPOE_TAG_AC_ERR #x0202 "AC-System-Error") (:PPPOE_TAG_GENERIC_ERR #x0203 "Generic-Error")) "Lookup Table.") ;;; ;;; Example Usage: A Simple framework for Dissecting and Printing ;;; capture files. ;;; (defgeneric dissect (obj input-stream output-stream)) (defun read-dump (pathname &optional *errorp* (*n-frames* 10)) "PATHNAME is a pathname to a pcap savefile. Dissect and print the first N-FRAMES. If ERRORP is non-NIL raise a cerror on unhandled network protocols." (declare (special *errorp* *n-frames*)) (let ((*endian* :little-endian)) (with-open-file (stream pathname :element-type '(unsigned-byte 8)) (let* ((*pos* (file-position stream))) (declare (special *pos*)) (dissect 'pcap-file-header stream *standard-output*))))) (defun check-pos (stream &optional curpos (incr 0) (update-p nil)) "Internal. Invariant checker. Also used for effects." (declare (special *pos*)) (when *pos* (unless curpos (setq curpos (file-position stream))) (assert (= curpos (+ *pos* incr)) nil "Current position ~A does not match *POS* + INCR ~A: (~A+~A)" curpos (+ *pos* incr) *pos* incr) (when update-p (assert (file-position stream curpos) nil "Failed to update file-position to ~A" curpos) (setq *pos* curpos)))) (defmethod dissect ((obj symbol) stream ostream) (check-pos stream) (let (binary-type) (declare (special *errorp*)) (cond ((or (keywordp obj) (not (setq binary-type (find-binary-type obj)))) (if *errorp* (cerror "Continue." "~&No dissect method matching symbol: ~S." obj) (format ostream "~&No dissect method matching symbol: ~S.~&" obj))) (t (multiple-value-bind (binary-object read-size) (read-binary binary-type stream) (check-pos stream nil read-size t) (dissect binary-object stream ostream)))))) (defmethod dissect ((obj pcap-file-header) stream ostream) (with-slots (magic linktype snaplen major-version minor-version sigfigs this-zone) obj (let* ((*pcap-endian* (table-lookup-type magic *pcap-file-header-magic*)) (*dlt-type* (table-lookup-type linktype *data-link-level-type-codes*)) (*snaplen* snaplen) (*frameno* 0)) (declare (special *pcap-endian* *dlt-type* *snaplen* *frameno* *n-frames*)) (assert (member *pcap-endian* '(:big-endian :little-endian)) nil "Endian=~S. Current=~S." *pcap-endian* *ENDIAN*) (format ostream "~%~S~&Magic=~X(~A). LINK-TYPE=~D ~A~@[: ~A~]. Version ~D.~D TZ-offset=~D. Packet Maximum length=~D. Accuracy of timestamps: ~D significant digits.~&" obj magic *pcap-endian* linktype *dlt-type* (table-lookup-desc linktype *data-link-level-type-codes*) major-version minor-version this-zone snaplen sigfigs) (assert (keywordp *dlt-type*) nil "Unknown Data Link type ~D" linktype) (handler-case (loop (incf *frameno*) (format ostream "~%~%Frame:~D~&" *frameno*) (dissect 'pcap-packet-header stream ostream) (unless (< *frameno* *n-frames*) (return))) (end-of-file () :EOF))))) (defmethod dissect ((obj pcap-packet-header) stream ostream) (declare (special *dlt-type* *pcap-endian*)) (with-slots (timestamp caplen len) obj (format ostream "~S~&Timestamp=~S.~&Captured length=~S (Total ~S).~&" obj timestamp caplen len) (check-pos stream) (let ((*caplen* caplen) (*endian* *pcap-endian*) ; endian shennanigans (pos (file-position stream))) (declare (special *caplen*)) (prog1 (dissect *dlt-type* stream ostream) (let ((curpos (file-position stream)) (newpos (+ pos caplen))) (assert (<= pos curpos newpos)) (unless (= curpos newpos) (format ostream "Skipping ~D bytes to position ~D" (- newpos curpos) newpos) (check-pos stream newpos (- newpos curpos) t))))))) (defmethod dissect ((obj (eql :DLT_LINUX_SLL)) stream ostream) (dissect 'pcap-linux-cooked-encapsulation-header stream ostream)) (defmethod dissect ((obj (eql :DLT_EN10MB)) stream ostream) (dissect 'ethernet-header stream ostream)) (defmethod dissect ((obj pcap-linux-cooked-encapsulation-header) stream ostream) (with-slots (pkttype devtype sendaddrlen dlheader protocol-type) obj (format ostream "~S~&~A.~&" obj (ecase pkttype (0 "Packet was sent to us by somebody else") (1 "Packet was broadcast by somebody else") (2 "Packet was multicast, but not broadcast, by somebody else") (3 "Packet was sent by somebody else to somebody else") (4 "Packet was sent by us"))) (format ostream "ARP Device-type: ~A: ~A~@[: ~A~].~&" devtype (table-lookup-type devtype *arp-protocol-hardware-identifiers*) (table-lookup-desc devtype *arp-protocol-hardware-identifiers*)) (format ostream "Sender address length: ~D.~&" sendaddrlen) (let ((protocol (table-lookup-type protocol-type *ethernet-protocol-Ids*))) (assert (keywordp protocol) nil "Unknown protocol ~A" protocol-type) (format ostream "Ethernet protocol type: ~A: ~A~&~&" protocol-type (case protocol-type (1 "Novell 802.3 without an 802.2 LLC header") (4 "frames beginning with an 802.2 LLC header.") (t (format nil "~A~@[: ~A~]" protocol (table-lookup-desc protocol-type *ethernet-protocol-Ids*))))) (dissect protocol stream ostream)))) (defmethod dissect ((obj (eql :ETHERTYPE_IP)) stream ostream) (dissect 'ipv4-header stream ostream)) (defmethod dissect ((obj ipv4-header) stream ostream) (with-slots (tos total-length id protocol checksum source dest length-and-version offset-field) obj (let ((protocol-key (table-lookup-type protocol *ip-protocol-ids*))) (assert (keywordp protocol-key) nil "Unknown protocol ~A" protocol) (format ostream "~&~S~&Version and Length:~S.~&Total Length ~A. Source: ~S.~&Dest: ~S.~&Protocol: ~A ~S~@[: ~A~]. Type of Service: ~A.~&Offset-Field: ~S.~&" obj length-and-version source dest protocol protocol-key (table-lookup-desc protocol *ip-protocol-ids*) tos total-length offset-field) (dissect protocol-key stream ostream)))) (defmethod dissect ((obj ethernet-header) stream ostream) (with-slots (destination source protocol-type) obj (format ostream "~&~S~&Source: ~S.~&Destination: ~S.~&" obj source destination) (let ((protocol (table-lookup-type protocol-type *ethernet-protocol-Ids*))) (assert (keywordp protocol) nil "Unknown protocol ~A" protocol-type) (format ostream "Protocol-Type: #x~X ~S~@[: ~A~].~&" protocol-type protocol (table-lookup-desc protocol-type *ethernet-protocol-Ids*)) (dissect protocol stream ostream)))) #+nil (read-dump "/var/local/dump3" t) ;;; Local Variables: ;;; emacs-lisp-docstring-fill-column: 78 ;;; End: