Add INLINE declamations for foreign wrappers.
[iolib/alendvai.git] / net.sockets / address-arithmetic.lisp
blob12aca35b129d14ad4a3f130494641e5e5ea48e9b
1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; --- Arithmetic with addresses and network masks.
4 ;;;
6 (in-package :net.sockets)
8 (defun make-subnet-mask (&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.")
12 (cond
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-subnet-mask (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."
25 (etypecase thing
26 (ipv4-address thing)
27 (unsigned-byte (make-subnet-mask :cidr thing))
28 (keyword (make-subnet-mask :class thing))))
30 (defgeneric inet-address-network-portion (address mask)
31 (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
32 network part of ADDRESS.")
33 (:method ((address ipv4-address) mask)
34 (setf mask (ensure-subnet-mask mask))
35 (let ((v (make-array 4 :element-type 'ub8))
36 (av (address-name address))
37 (mv (address-name mask)))
38 (dotimes (i 4)
39 (setf (aref v i)
40 (logand (aref av i)
41 (aref mv i))))
42 (make-instance 'ipv4-address :name v))))
44 (defgeneric inet-address-host-portion (address mask)
45 (:documentation "Apply network mask MASK to ADDRESS in order to calculate the
46 host part of ADDRESS.")
47 (:method ((address ipv4-address) mask)
48 (setf mask (ensure-subnet-mask mask))
49 (let ((v (make-array 4 :element-type 'ub8))
50 (av (address-name address))
51 (mv (address-name mask)))
52 (dotimes (i 4)
53 (setf (aref v i)
54 (logand (aref av i)
55 (logxor (aref mv i) 255))))
56 (make-instance 'ipv4-address :name v))))
58 (defgeneric inet-address-in-network-p (address network mask)
59 (:documentation "Return T if ADDRESS is part of the subnet specified by
60 NETWORK and MASK.")
61 (:method ((address ipv4-address) (network ipv4-address) mask)
62 (setf mask (ensure-subnet-mask mask))
63 (address= (inet-address-network-portion address mask)
64 (inet-address-network-portion network mask))))
66 (defgeneric inet-addresses-in-same-network-p (address1 address2 network mask)
67 (:documentation "Return T if ADDRESS1 and ADDRESS2 are both part part of the
68 subnet specified by NETWORK and MASK.")
69 (:method ((address1 ipv4-address) (address2 ipv4-address) (network ipv4-address) mask)
70 (setf mask (ensure-subnet-mask mask))
71 (let ((address1-network (inet-address-network-portion address1 mask))
72 (address2-network (inet-address-network-portion address2 mask))
73 (subnet (inet-address-network-portion network mask)))
74 (and (address= address1-network subnet)
75 (address= address2-network subnet)))))
77 (defgeneric inet-address-network-class (address)
78 (:documentation "Return the network class of ADDRESS: one of :A, :B, :C, :D OR :E .")
79 (:method ((address ipv4-address))
80 (let ((octet (aref (address-name address) 0)))
81 (cond
82 ((= #b0000 (ldb (byte 1 7) octet)) :a)
83 ((= #b0010 (ldb (byte 2 6) octet)) :b)
84 ((= #b0110 (ldb (byte 3 5) octet)) :c)
85 ((= #b1110 (ldb (byte 4 4) octet)) :d)
86 ((= #b1111 (ldb (byte 4 4) octet)) :e)))))
88 (defgeneric inet-address-private-p (address)
89 (:documentation "Returns T if ADDRESS is in a private network range.
90 Private IPv4 networks are 10.0.0.0/8, 172.16.0.0/12 and 192.168.0.0/16.
91 See http://en.wikipedia.org/wiki/Private_network for details.")
92 (:method ((address ipv4-address))
93 (let* ((address-name (address-name address))
94 (first (aref address-name 0))
95 (second (aref address-name 1)))
96 (values (or (= first 10)
97 (and (= first 172)
98 (<= 16 second 31))
99 (and (= first 192)
100 (= second 168)))
101 (inet-address-network-class address))))
102 (:method ((address address))
103 nil))