1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Arithmetic with addresses and network masks.
6 (in-package :net.sockets
)
8 (defun make-netmask (&key cidr class
)
9 "Create a subnet mask by specifying either its class(:A, :B or :C) or
10 a CIDR suffix(a number between 0 and 32)."
11 (assert (or cidr class
) (cidr class
) "You must either specify a CIDR or a network class.")
13 (cidr (check-type cidr
(mod 33) "a number between 0 and 32"))
14 (class (check-type class
(member :a
:b
:c
)
15 "a valid network class - one of :A, :B or :C")
16 (setf cidr
(case class
(:a
8) (:b
16) (:c
24)))))
17 (let ((mask #xFFFFFFFF
))
18 (declare (type ub32 mask
))
19 (setf (ldb (byte (- 32 cidr
) 0) mask
) 0)
20 (make-instance 'ipv4-address
:name
(integer-to-vector mask
))))
22 (defun ensure-netmask (thing)
23 "If THING is of type IPV4-ADDRESS it is returned as is; if keyword it must be one of
24 :A, :B or :C otherwise it's treated as a CIDR suffix."
27 (unsigned-byte (make-netmask :cidr thing
))
28 (keyword (make-netmask :class thing
))))
30 (defgeneric inet-address-network-portion
(address netmask
)
31 (:documentation
"Apply network netmask NETMASK to ADDRESS in order to calculate the
32 network part of ADDRESS.")
33 (:method
((address ipv4-address
) netmask
)
34 (setf netmask
(ensure-netmask netmask
))
35 (let ((v (make-array 4 :element-type
'ub8
))
36 (av (address-name address
))
37 (mv (address-name netmask
)))
42 (make-instance 'ipv4-address
:name v
))))
44 (defgeneric inet-address-host-portion
(address netmask
)
45 (:documentation
"Apply network netmask NETMASK to ADDRESS in order to calculate the
46 host part of ADDRESS.")
47 (:method
((address ipv4-address
) netmask
)
48 (setf netmask
(ensure-netmask netmask
))
49 (let ((v (make-array 4 :element-type
'ub8
))
50 (av (address-name address
))
51 (mv (address-name netmask
)))
55 (logxor (aref mv i
) 255))))
56 (make-instance 'ipv4-address
:name v
))))
58 (defclass ipv4-network
()
59 ((address :accessor address-of
)
60 (netmask :accessor netmask-of
)
61 (cidr :accessor cidr-of
))
62 (:documentation
"IPv4 network: an address plus a netmask."))
64 (defun compute-cidr-prefix-from-netmask (netmask)
65 (let ((ub32-address (vector-to-integer (address-name netmask
))))
66 (loop :with count
:= 0
68 :do
(if (logbitp i ub32-address
)
71 :finally
(return count
))))
73 (defmethod initialize-instance :after
((network ipv4-network
)
75 (check-type address ipv4-address
"an Ipv4 address")
76 (check-type netmask ipv4-address
"an Ipv4 netmask")
77 (setf (cidr-of network
) (compute-cidr-prefix-from-netmask netmask
))
78 (setf (address-of network
)
79 (inet-address-network-portion address netmask
)))
81 (defmethod print-object ((network ipv4-network
) stream
)
82 (format stream
"@~A/~A"
83 (address-to-string (address-of network
))
86 (defgeneric ipv4-network
= (net1 net2
)
87 (:documentation
"Returns T if the addresses and the netmasks of the
88 two arguments are respectively ADDRESS=.")
89 (:method
((net1 ipv4-network
) (net2 ipv4-network
))
90 (and (address= (address-of net1
) (address-of net2
))
91 (address= (netmask-of net1
) (netmask-of net2
)))))
93 (defgeneric inet-address-in-network-p
(address network
)
94 (:documentation
"Return T if ADDRESS is part of the subnet specified by NETWORK.")
95 (:method
((address ipv4-address
) (network ipv4-network
))
96 (address= (inet-address-network-portion address
(netmask-of network
))
97 (address-of network
))))
99 (defgeneric inet-addresses-in-same-network-p
(address1 address2 network
)
100 (:documentation
"Return T if ADDRESS1 and ADDRESS2 are both part part of the
101 subnet specified by NETWORK.")
102 (:method
((address1 ipv4-address
) (address2 ipv4-address
) (network ipv4-network
))
103 (let ((address1-network (inet-address-network-portion address1
(netmask-of network
)))
104 (address2-network (inet-address-network-portion address2
(netmask-of network
))))
105 (and (address= address1-network
(address-of network
))
106 (address= address2-network
(address-of network
))))))
108 (defgeneric inet-address-network-class
(address)
109 (:documentation
"Return the network class of ADDRESS: one of :A, :B, :C, :D or :E .")
110 (:method
((address ipv4-address
))
111 (let ((octet (aref (address-name address
) 0)))
113 ((= #b0000
(ldb (byte 1 7) octet
)) :a
)
114 ((= #b0010
(ldb (byte 2 6) octet
)) :b
)
115 ((= #b0110
(ldb (byte 3 5) octet
)) :c
)
116 ((= #b1110
(ldb (byte 4 4) octet
)) :d
)
117 ((= #b1111
(ldb (byte 4 4) octet
)) :e
)))))
119 (defgeneric inet-address-private-p
(address)
120 (:documentation
"Returns T if ADDRESS is in a private network range.
121 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
122 See http://en.wikipedia.org/wiki/Private_network for details.")
123 (:method
((address ipv4-address
))
124 (let* ((address-name (address-name address
))
125 (first (aref address-name
0))
126 (second (aref address-name
1)))
127 (values (or (= first
10)
132 (inet-address-network-class address
))))
133 (:method
((address address
))