1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Arithmetic with addresses and network masks.
6 (in-package :iolib
/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 (declaim (inline count-trailing-zeroes
/32))
65 (defun count-trailing-zeroes/32 (n)
66 (declare (optimize speed
)
67 (type (unsigned-byte 32) n
))
68 (1- (integer-length (logand n
(- n
)))))
70 (defun cidr-subnet-zeroes (netmask)
71 (count-trailing-zeroes/32 (vector-to-integer (address-name netmask
))))
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
) (- 32 (cidr-subnet-zeroes netmask
)))
78 (setf (netmask-of network
) netmask
)
79 (setf (address-of network
)
80 (inet-address-network-portion address netmask
)))
82 (defmethod print-object ((network ipv4-network
) stream
)
85 (address-to-string (address-of network
))
87 (if (or *print-readably
* *print-escape
*)
88 (format stream
"#/~S/~A" 'net namestring
)
89 (write-string namestring stream
))))
91 (defgeneric ipv4-network
= (net1 net2
)
92 (:documentation
"Returns T if the addresses and the netmasks of the
93 two arguments are respectively ADDRESS=.")
94 (:method
((net1 ipv4-network
) (net2 ipv4-network
))
95 (and (address= (address-of net1
) (address-of net2
))
96 (address= (netmask-of net1
) (netmask-of net2
)))))
98 (defgeneric inet-address-in-network-p
(address network
)
99 (:documentation
"Return T if ADDRESS is part of the subnet specified by NETWORK.")
100 (:method
((address ipv4-address
) (network ipv4-network
))
101 (address= (inet-address-network-portion address
(netmask-of network
))
102 (address-of network
))))
104 (defgeneric inet-addresses-in-same-network-p
(address1 address2 network
)
105 (:documentation
"Return T if ADDRESS1 and ADDRESS2 are both part part of the
106 subnet specified by NETWORK.")
107 (:method
((address1 ipv4-address
) (address2 ipv4-address
) (network ipv4-network
))
108 (let ((address1-network (inet-address-network-portion address1
(netmask-of network
)))
109 (address2-network (inet-address-network-portion address2
(netmask-of network
))))
110 (and (address= address1-network
(address-of network
))
111 (address= address2-network
(address-of network
))))))
113 (defgeneric inet-address-network-class
(address)
114 (:documentation
"Return the network class of ADDRESS: one of :A, :B, :C, :D or :E .")
115 (:method
((address ipv4-address
))
116 (let ((octet (aref (address-name address
) 0)))
118 ((= #b0000
(ldb (byte 1 7) octet
)) :a
) ; 0.0.0.0 - 127.255.255.255
119 ((= #b0010
(ldb (byte 2 6) octet
)) :b
) ; 128.0.0.0 - 191.255.255.255
120 ((= #b0110
(ldb (byte 3 5) octet
)) :c
) ; 192.0.0.0 - 223.255.255.255
121 ((= #b1110
(ldb (byte 4 4) octet
)) :d
) ; 224.0.0.0 - 239.255.255.255
122 ((= #b1111
(ldb (byte 4 4) octet
)) :e
) ; 240.0.0.0 - 255.255.255.255
125 (defgeneric inet-address-private-p
(address)
126 (:documentation
"Returns T if ADDRESS is in a private network range.
127 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
128 See http://en.wikipedia.org/wiki/Private_network for details.")
129 (:method
((address ipv4-address
))
130 (let* ((address-name (address-name address
))
131 (first (aref address-name
0))
132 (second (aref address-name
1)))
133 (values (or (= first
10)
138 (inet-address-network-class address
))))
139 (:method
((address address
))