/
icmp.lisp
162 lines (139 loc) · 5.54 KB
/
icmp.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
;; ICMP implementation
;; Copyright (C) 2010 Dr. John A.R. Williams
;; Author: Dr. John A.R. Williams <J.A.R.Williams@jarw.org.uk>
;; Keywords:
;; This file is part of Lisp Educational Network Simulator (LENS)
;; This is free software released under the GNU General Public License (GPL)
;; See <http://www.gnu.org/copyleft/gpl.html>
;;; Commentary:
;;
;;; Code:
(in-package :protocol.layer3)
(defenumeration ICMP-msg-type
((echo-reply 0)
(destination-unreachable 3)
(source-quench 4)
(redirect 5)
(echo 8)
(time-exceeded 11)
(parameter-problem 12)
(timestamp 13)
(timestamp-reply 14)
(information-request 15)
(information-reply 16)))
(defenumeration destination-unreachable-code
(net-unreachable
host-unreachable
protocol-unreachable
port-unreachable
cant-fragment
source-route-failed))
(defenumeration time-exceeded-code
(ttl-exceeded
reassembly-exceeded))
(defclass icmp-header(pdu)
((name :initform "ICMP" :reader name :allocation :class)
(trace-format :initform '(icmp-type code
identifier seq
originated received transmitted)
:reader trace-format
:allocation :class)
(icmp-type :accessor icmp-type :type ICMP-msg-type :initarg :type)
(code :reader code :initarg :code :initform nil
:type (or null destination-unreachable-code time-exceeded-code))
(identifier :type seq
:reader identifier :initarg :identifier)
(seq :type seq :reader seq
:initarg :seq)
(originated :type time-type :reader originated)
(received :type time-type :reader received)
(transmitted :type time-type :reader transmitted)))
(register-protocol 'icmp 1)
(defmethod initialize-instance :after((pdu icmp-header) &key &allow-other-keys)
(case (icmp-type pdu)
((timestamp timestamp-reply)
(setf (slot-value pdu 'originated) (simulation-time)))))
(defmethod length-bytes((h icmp-header))
(ecase (icmp-type h)
((echo echo-reply) 8)
((destination-unreachable source-quench time-exceeded) (+ 8 8))
((timestamp timestamp-reply) (+ 8 12))
((redirect information-request information-reply parameter-problem)
;; not implemented
0)))
(defmethod copy((h icmp-header))
(copy-with-slots
h
'(icmp-type code identifier seq originated received transmitted)))
(defun icmp-receive(ipv4 packet ipv4hdr)
(when (icmp-enabled-p ipv4)
(let ((icmphdr (pop-pdu packet)))
(ecase (icmp-type icmphdr)
(echo (echo-reply ipv4 ipv4hdr icmphdr))
(timestamp (timestamp-reply ipv4 ipv4hdr icmphdr))
(destination-unreachable
(kill-pending-connection ipv4 packet))
((echo-reply source-quench time-exceeded redirect
information-request information-reply parameter-problem)
;; not implemented
)))))
(defun destination-unreachable(ipv4 ipv4-header layer4-header &key (code 'host-unreachable))
(when(icmp-enabled-p ipv4)
(let ((packet (make-instance 'packet:packet))
(icmp-header (make-instance 'icmp-header
:type 'destination-unreachable
:code code)))
(push-pdu (copy ipv4-header) packet)
(when layer4-header (push-pdu (copy layer4-header) packet))
(push-pdu icmp-header packet)
(send ipv4 packet 'icmp
:src-address (network-address (node ipv4))
:dst-address (src-address ipv4-header)))))
(defun time-exceeded(ipv4 ipv4-header &key (code 'ttl-exceeded))
(when(icmp-enabled-p ipv4)
(let ((packet (make-instance 'packet:packet)))
(push-pdu (make-instance 'icmp-header
:type 'destination-unreachable
:code code)
packet)
(send ipv4 packet 'icmp
:src-address nil
:dst-address (src-address ipv4-header)))))
(defun echo-reply(ipv4 ipv4-header icmp-header)
(when (icmp-enabled-p ipv4)
(let ((packet (make-instance 'packet))
(icmp-header (copy icmp-header)))
(setf (icmp-type icmp-header) 'echo-reply)
(push-pdu icmp-header packet)
(send ipv4 packet 'icmp
:src-address nil
:dst-address (src-address ipv4-header)))))
(defun echo(ipv4 dst)
(when(icmp-enabled-p ipv4)
(let ((packet (make-instance 'packet)))
(push-pdu (make-instance 'icmp-header :type 'echo) packet)
(send ipv4 packet 'icmp
:src-address nil
:dst-address dst))))
(defun timestamp(ipv4 dst &key identifier seq)
(let ((packet (make-instance 'packet))
(icmp-header (make-instance 'icmp-header
:type 'timestamp
:originated (simulation-time)
:seq seq
:identifier identifier)))
(push-pdu icmp-header packet)
(send ipv4 packet 'icmp
:src-address (network-address (node ipv4))
:dst-address dst)))
(defun timestamp-reply(ipv4 ipv4-header icmp-header)
(let ((packet (make-instance 'packet))
(icmp-header (copy icmp-header)))
(push-pdu icmp-header packet)
(setf (icmp-type icmp-header) 'timestamp-reply)
(setf (slot-value 'icmp-header 'received) (simulation-time))
(setf (slot-value 'icmp-header 'transmitted) (simulation-time))
(send ipv4 packet 'icmp
:src-address (network-address (node ipv4))
:dst-address (src-address ipv4-header))))
;; kill-pending-connection in tcp.lisp