contrib/sb-bsd-sockets/inet6.lisp

   1 (in-package :sb-bsd-sockets)
   2
   3 ;;; Socket class and constructor
   4
   5 (eval-when (:compile-toplevel :load-toplevel :execute)
   6   (defclass inet6-socket (socket)
   7     ((family :initform sockint::AF-INET6))
   8     (:documentation "Class representing TCP and UDP over IPv6 sockets.
   9
  10 Examples:
  11
  12  (make-instance 'sb-bsd-sockets:inet6-socket :type :stream :protocol :tcp)
  13
  14  (make-instance 'sb-bsd-sockets:inet6-socket :type :datagram :protocol :udp)
  15 ")))
  16
  17 (defparameter *inet6-address-any* (vector 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
  18
  19 (defun address-numbers/v6 (address)
  20   (loop for i from 0 below 16 by 2 collect
  21        (+ (* 256 (elt address i)) (elt address (1+ i)))))
  22
  23 (defun endpoint-string/v6 (address port)
  24   (assert (= (length address) 16))
  25   (format nil "[~A]:~A" (unparse-inet6-address address) port))
  26
  27 (defmethod socket-namestring ((socket inet6-socket))
  28   (ignore-errors
  29     (multiple-value-bind (address port) (socket-name socket)
  30       (endpoint-string/v6 address port))))
  31
  32 (defmethod socket-peerstring ((socket inet6-socket))
  33   (ignore-errors
  34    (multiple-value-bind (address port) (socket-peername socket)
  35      (endpoint-string/v6 address port))))
  36
  37 (defun unparse-inet6-address (address)
  38   (let ((max-length sockint::INET6-ADDRSTRLEN))
  39     (sb-alien:with-alien ((octets (array char 16))
  40                           (storage (sb-alien:c-string) (make-string max-length)))
  41       (dotimes (i 16)
  42         (setf (sb-alien:deref octets i) (elt address i)))
  43       (socket-error-case ("inet_ntop"
  44                           (sockint::inet-ntop
  45                            sockint::af-inet6
  46                            (sb-alien:cast octets (* sb-alien:unsigned-char))
  47                            storage max-length)
  48                           result (null result))
  49           result))))
  50
  51 (defun make-inet6-address (colon-separated-integers)
  52   "Return a vector of octets given a string representation of an IPv6
  53 address COLON-SEPARATED-INTEGERS. Signal an error if the string is
  54 malformed."
  55   (declare (type string colon-separated-integers))
  56   (sb-alien:with-alien ((octets (array sb-alien:unsigned-char 16)))
  57     (socket-error-case ("inet_pton"
  58                         (sockint::inet-pton
  59                          sockint::af-inet6 colon-separated-integers
  60                          (sb-alien:cast octets (* sb-alien:unsigned-char)))
  61                         result (and (/= result 0) (/= result 1)))
  62         (if (zerop result)
  63             (error "~@<~S does not designate an IPv6 address.~@:>"
  64                    colon-separated-integers)
  65             (let ((result (make-array 16 :element-type '(unsigned-byte 8))))
  66               (dotimes (i 16)
  67                 (setf (elt result i) (sb-alien:deref octets i)))
  68               result)))))
  69
  70 ;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
  71 ;;; bits-of-sockaddr
  72
  73 (defmethod make-sockaddr-for ((socket inet6-socket) &optional sockaddr
  74                               &rest address)
  75   (check-type address (or null (cons sequence (cons (unsigned-byte 16)))))
  76   (let ((host (first address))
  77         (port (second address))
  78         (sockaddr (or sockaddr (sockint::allocate-sockaddr-in6))))
  79     (when (and host port)
  80       (assert (= (length host) 16))
  81       ;; port and host are represented in C as "network-endian" unsigned
  82       ;; integers of various lengths.  This is stupid.  The value of the
  83       ;; integer doesn't matter (and will change depending on your
  84       ;; machine's endianness); what the bind(2) call is interested in
  85       ;; is the pattern of bytes within that integer.
  86
  87       ;; We have no truck with such dreadful type punning.  Octets to
  88       ;; octets, dust to dust.
  89
  90       (setf (sockint::sockaddr-in6-family sockaddr)
  91             sockint::af-inet6
  92             (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 0)
  93             (ldb (byte 8 8) port)
  94             (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 1)
  95             (ldb (byte 8 0) port))
  96       (dotimes (i 4)
  97         (setf (sb-alien:deref (sockint::sockaddr-in6-flowinfo sockaddr) i) 0))
  98       (dotimes (i 16)
  99         (setf (sb-alien:deref (sockint::sockaddr-in6-addr sockaddr) i) (elt host i)))
 100       (dotimes (i 4)
 101         (setf (sb-alien:deref (sockint::sockaddr-in6-scope-id sockaddr) i) 0)))
 102     sockaddr))
 103
 104 (defmethod free-sockaddr-for ((socket inet6-socket) sockaddr)
 105   (sockint::free-sockaddr-in6 sockaddr))
 106
 107 (defmethod size-of-sockaddr ((socket inet6-socket))
 108   sockint::size-of-sockaddr-in6)
 109
 110 (defmethod bits-of-sockaddr ((socket inet6-socket) sockaddr)
 111   "Returns address and port of SOCKADDR as multiple values"
 112   (values
 113    (coerce (loop for i from 0 below 16
 114                  collect (sb-alien:deref (sockint::sockaddr-in6-addr sockaddr) i))
 115            '(vector (unsigned-byte 8) 16))
 116    (+ (* 256 (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 0))
 117       (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 1))))