Lisping IP addresses

Here is some no-doubt badly written lisp for working with IP addresses.


;; converted from a C function that looks rather a lot like the MIT bit counter.
( defun count-bits ( x )
( setq x ( - x ( logand ( ash x -1 ) #x55555555)))
( setq x ( + ( logand x #x33333333 ) (logand ( ash x -2 ) #x33333333)))
( setq x ( logand ( + x ( ash x -4 )) #x0F0F0F0F))
( setq x ( + x ( ash x -8))) ( setq x ( + x ( ash x -16)))
( logand x #x0000003F))

;; this has no need to be fast as it is cached below.
(defun power-of-2 (x)
( let ((result 1))
( dotimes (i x result)
(setq result ( * 2 result)))))

;; keep a table of powers of 2.
(defparameter *little-powers-of-2*
( let ( final )
(setq final (make-array 128 :fill-pointer 0))
( dotimes ( value 127 final )
(vector-push (power-of-2 value ) final ))))

;; accessor for powers of 2, x must be < 128 but no checking done.
( defun po-2 (x) ( elt *little-powers-of-2* x))

;;
( defun ip-to-number (ip) " vector or list to number"
( + ( ash (elt ip 0) 24)
( ash (elt ip 1) 16)
( ash (elt ip 2) 8)
(elt ip 3)))

;; a mask is a contiguous run of bits.
;; this mask maker is hardly efficient so is cached.
( defun make-mask (n)
( let (mask)
( setq mask 0)
( dotimes ( value n mask )
(setq mask (+ (po-2 (- 31 value)) mask )))))

;; valid masks
( defparameter *masks*
( let ( my-masks )
(setq my-masks (make-array 33 :fill-pointer 0))
( dotimes ( value 33 my-masks)
(vector-push ( make-mask value) my-masks))))

;; return ip as a vector
( defun make-ip (a b c d)
( make-array 4 :element-type 'byte :initial-contents (list a b c d )))

( defun make-sm (a b c d)
( make-array 4 :element-type 'byte :initial-contents (list a b c d )))

;; looks up the mask for given prefix
( defun prefix-to-mask (prefix) "convenience accessor returns number"
( elt *masks* prefix))

;; different from sm-to-prefix
;; in this case mask is a natural number
( defun mask-to-prefix (mask) " mask is number, return prefix 0-32"
( count-bits mask))

;;
( position mask *masks*))

;; turn a natural number into a vector
( defun number-to-ip ( number ) "make a number into an ip address vector"
( let ( result n )
( setq result (make-array 4 :fill-pointer 0 :element-type 'byte))
( setq n number)
( dotimes ( value 4 result )
( vector-push ( logand n #xFF ) result )
( setq n ( ash n -8)))
(reverse result)))

;; swap between formats for sm masks.
( defun sm-to-prefix (sm) "sm is a vector like 255 255 248 0 prefix is a number like 21" (mask-to-prefix
( ip-to-number sm)))

( defun prefix-to-sm ( prefix ) " prefix is number like 23 , sm is vector like 255 255 254 0"
( number-to-ip
( prefix-to-mask prefix)))

;; might be good to remove this..
;; apply mask to ip returning network part.
see also logandip that works on two vectors.
( defun mask (ip sm ) " convert the ip and sm from vector to number, mask them returning a number"
( logand (ip-to-number sm)
(ip-to-number ip )))

;; used to add an offset to an ip address.
( defun incr-ip (ip n) "returns ip as vector incremented by n"
( number-to-ip (+ (ip-to-number ip) n)))

;; calc the hosts from the available host bits in an ip address.
( defun ip-hosts-from-prefix (p)
( po-2 (- 32 p)))

;; convenience to correct results.
( defun subtracting-broadcast (n)
( - n 1))

( defun subtracting-network (n)
( - n 1))

;; return the class of this ip where ip is a list or vector
( defun ip-to-class ( ip )
( let ( n )
( setq n (elt ip 0))
( cond
( ( >= n 240 ) "E")
( ( >= n 224 ) "D")
( ( >= n 192 ) "C")
( ( >= n 128 ) "B")
( ( >= n 1 ) "A"))))

;; natural is classful.
( defun ip-natural-prefix ( ip ) "class full"
( let ( n )
( setq n (elt ip 0))
( cond
( ( >= n 240 ) 24)
( ( >= n 224 ) 24)
( ( >= n 192 ) 24)
( ( >= n 128 ) 16)
( ( >= n 1 ) 8))))

;; combines the above
( defun ip-class-and-prefix ( ip )
( let ( n )
( setq n (elt ip 0))
( cond
( ( >= n 240 ) ( list 24 "E" ))
( ( >= n 224 ) ( list 24 "D" ))
( ( >= n 192 ) ( list 24 "C" ))
( ( >= n 128 ) ( list 16 "B" ))
( ( >= n 1 ) ( list 8 "A" )))))

;; various ways of working out the subnets

( defun subnets-from-reserv-with-prefix ( reserv prefix ) "the total number of subnets available"
(po-2 ( abs ( - reserv prefix))))
( defun subnets-from-ip-with-prefix ( ip prefix ) "the total number of subnets available for an ip of a given class"
( subnets-from-reserv-with-prefix ( ip-natural-prefix ip) prefix))

( defun classfull-subnets-from-ip-mask ( ip sm ) "the total number of subnets available for a given class"
( subnets-from-reserv-with-prefix
( ip-natural-prefix ip)
(sm-to-prefix sm)))

;; operations on ip addresses and masks as pairs of vectors.
;; operations on single elements
( defun logandelt (v1 v2 element)
( logand (elt v1 element)
(elt v2 element)))

( defun equalelt (v1 v2 element)
( = (elt v1 element) (elt v2 element)))

;; operations on 4 element vectors or lists (nn nn nn nn )
( defun logandip (v1 v2 ) "and an ip address and mask - return network address"
( vector
( logandelt v1 v2 0)
( logandelt v1 v2 1)
( logandelt v1 v2 2)
( logandelt v1 v2 3)))

( defun equalip ( v1 v2 ) " compare one ip with another"
( and
( equalelt v1 v2 0)
( equalelt v1 v2 1)
( equalelt v1 v2 2)
( equalelt v1 v2 3)))

( defun network-address-of-ip-and-sm (v1 v2) "works on ip & sm as vector, returns vector" ( logandip v1 v2))

( defun network-address-of-ip-and-prefix ( ip prefix) "works on ip as vector and prefix as number, returns vector"
( logandip ip (number-to-ip ( prefix-to-mask prefix))))

( defun classfull-network-base ( ip ) " what is the base class network"
( network-address-of-ip-and-prefix ip (ip-natural-prefix ip) ))

;; subnet is a class that contains useful information about ip subnets.;;(defclass subnet () ((ipaddress
;; normally an array of bytes or a list.
:accessor ip-address
:initform (make-ip 192 168 0 0)
:initarg :set-ipaddress)
(prefix ;; a small value 0-32
:accessor prefix
:initform 'undefined
:initarg :set-prefix)
(reserv ;; a small value 0-32, the natural prefix of this ip
:accessor reserv :initform 'undefined
:initarg :set-reserv)
(mask ;; a subnet mask, normally an array of bytes
:accessor mask
:initform 'undefined
:initarg :set-mask)
(ip-class ;; A,B,C,D,E
:accessor ip-class
:initform 'undefined
:initarg :set-mask) )
( :documentation "Instances of Subnet store network and mask information" ))

;; how many subnets are there, within the natural network..
( defmethod nets (( net subnet))
(subnets-from-reserv-with-prefix
(reserv net)
(prefix net)))

;; how many are hosts per subnet ?
( defmethod hosts (( net subnet))
(ip-hosts-from-prefix
(prefix net)))

;; find this net, make a network by masking out the host bits to return this networks network address
( defmethod thisnet (( net subnet ))
( make-instance 'subnet
:set-ipaddress ( network-address-of-ip-and-sm ( ip-address net) ( mask net))
:set-prefix ( prefix net) ))

;; find base network, make a network by classfully determining network 0 in this range of subnets.
( defmethod basenet (( net subnet ))
( make-instance 'subnet
:set-ipaddress ( classfull-network-base ( ip-address net) )
:set-prefix ( prefix net) ))

;; make a network with an IP address set to the broadcast address of thisnet.
( defmethod broadcast (( net subnet ))
( make-instance 'subnet
:set-ipaddress ( incr-ip ( ip-address ( thisnet net ) ) (- ( hosts net) 1))
:set-prefix ( prefix net)))

;; make a network by classfully determining the base network.
;; Then finding the nth subnet.
( defmethod nth-net (( thenet subnet ) n )
( make-instance 'subnet
:set-ipaddress ( incr-ip ( ip-address (basenet thenet) ) ( * (hosts thenet) n) )
:set-prefix ( prefix thenet)))

;; test for equality - if prefix, ip and sm are the same - we are equal
( defun equalnet ( n1 n2 )
( and ( equal ( prefix n1) ( prefix n2))
( equalip ( ip-address n1 ) ( ip-address n2) )
( equalip ( mask n1) ( mask n2))))

;; computes some helpful default values when a subnet is created.
( defmethod initialize-instance :after (( net subnet) &key )
( let (( ip ( slot-value net 'ipaddress )))
( progn
( cond (( eq (slot-value net 'prefix) 'undefined )
(setf ( slot-value net 'prefix)
( ip-natural-prefix ip ))))
( cond (( eq (slot-value net 'reserv) 'undefined )
(setf ( slot-value net 'reserv)
( ip-natural-prefix ip ))))
( cond (( eq (slot-value net 'mask) 'undefined )
(setf ( slot-value net 'mask)
( prefix-to-sm (slot-value net 'prefix )))))
( cond (( eq (slot-value net 'ip-class) 'undefined )
(setf ( slot-value net 'ip-class)
( ip-to-class ip )))))))

;; ip-cursors are created on a subnet.
;; a cursor moves over an IP address range
;; knowing the base network, the start of this network, the broadcast address it moves across the hosts within
;; a subnet, providing next-host, previous-host and host-at methods.
;;
(defclass ip-cursor ()
((subnet ;; a subnet
:accessor subnet
:initform ( make-instance 'subnet :set-ipaddress (make-ip 192 168 0 0 ))
:initarg :set-subnet )
(offset ;; and a position
:accessor offset
:initform 0
:initarg :set-offset))
( :documentation "ip-cursor is used to move across a subnet" ))

( defun make-cursor-on-subnet ( net )
( make-instance 'ip-cursor :set-subnet ( thisnet net)))
( defmethod next-ip (( cursor ip-cursor ))
( setf (offset cursor) (+ ( offset cursor) 1))
( make-instance 'subnet
:set-ipaddress ( incr-ip ( ip-address ( subnet cursor))
(offset cursor))
:set-prefix ( prefix ( subnet cursor))))

( defmethod previous-ip (( cursor ip-cursor ))
( setf (offset cursor) (- ( offset cursor) 1))
( make-instance 'subnet
:set-ipaddress ( incr-ip ( ip-address ( subnet cursor)) (offset cursor))
:set-prefix ( prefix ( subnet cursor))))