contrib/sb-bsd-sockets/inet.lisp

   1 (in-package :sb-bsd-sockets)
   2
   3 ;;; Our class and constructor
   4
   5 (eval-when (:compile-toplevel :load-toplevel :execute)
   6   (defclass inet-socket (socket)
   7     ((family :initform sockint::AF-INET))
   8     (:documentation "Class representing TCP and UDP sockets.
   9
  10 Examples:
  11
  12  (make-instance 'inet-socket :type :stream :protocol :tcp)
  13
  14  (make-instance 'inet-socket :type :datagram :protocol :udp)
  15 ")))
  16
  17 ;;; XXX should we *...* this?
  18 (defparameter inet-address-any (vector 0 0 0 0))
  19
  20 ;;; binding a socket to an address and port.  Doubt that anyone's
  21 ;;; actually using this much, to be honest.
  22
  23 (defun make-inet-address (dotted-quads)
  24   "Return a vector of octets given a string DOTTED-QUADS in the format
  25 \"127.0.0.1\". Signals an error if the string is malformed."
  26   (declare (type string dotted-quads))
  27   (labels ((oops ()
  28              (error "~S is not a string designating an IP address."
  29                     dotted-quads))
  30            (check (x)
  31              (if (typep x '(unsigned-byte 8))
  32                  x
  33                  (oops))))
  34     (let* ((s1 (position #\. dotted-quads))
  35            (s2 (if s1 (position #\. dotted-quads :start (1+ s1)) (oops)))
  36            (s3 (if s2 (position #\. dotted-quads :start (1+ s2)) (oops)))
  37            (u0 (parse-integer dotted-quads :end s1))
  38            (u1 (parse-integer dotted-quads :start (1+ s1) :end s2))
  39            (u2 (parse-integer dotted-quads :start (1+ s2) :end s3)))
  40       (multiple-value-bind (u3 end) (parse-integer dotted-quads :start (1+ s3) :junk-allowed t)
  41         (unless (= end (length dotted-quads))
  42           (oops))
  43         (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
  44           (setf (aref vector 0) (check u0)
  45                 (aref vector 1) (check u1)
  46                 (aref vector 2) (check u2)
  47                 (aref vector 3) (check u3))
  48           vector)))))
  49
  50 (define-condition unknown-protocol ()
  51   ((name :initarg :name
  52          :reader unknown-protocol-name))
  53   (:report (lambda (c s)
  54              (format s "Protocol not found: ~a" (prin1-to-string
  55                                                  (unknown-protocol-name c))))))
  56
  57 ;;; getprotobyname only works in the internet domain, which is why this
  58 ;;; is here
  59 (defun get-protocol-by-name (name)      ;exported
  60   "Returns the network protocol number associated with the string NAME,
  61 using getprotobyname(2) which typically looks in NIS or /etc/protocols"
  62   ;; for extra brownie points, could return canonical protocol name
  63   ;; and aliases as extra values
  64   (let ((ent (sockint::getprotobyname name)))
  65     (if (sb-alien::null-alien ent)
  66         (error 'unknown-protocol :name name))
  67     (sockint::protoent-proto ent)))
  68
  69 ;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
  70 ;;; bits-of-sockaddr
  71
  72 (defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address &aux (host (first address)) (port (second address)))
  73   (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-in))))
  74     (when (and host port)
  75       (setf host (coerce host '(simple-array (unsigned-byte 8) (4))))
  76       ;; port and host are represented in C as "network-endian" unsigned
  77       ;; integers of various lengths.  This is stupid.  The value of the
  78       ;; integer doesn't matter (and will change depending on your
  79       ;; machine's endianness); what the bind(2) call is interested in
  80       ;; is the pattern of bytes within that integer.
  81
  82       ;; We have no truck with such dreadful type punning.  Octets to
  83       ;; octets, dust to dust.
  84
  85       (setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet)
  86       (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0) (ldb (byte 8 8) port))
  87       (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1) (ldb (byte 8 0) port))
  88
  89       (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 0) (elt host 0))
  90       (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 1) (elt host 1))
  91       (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 2) (elt host 2))
  92       (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 3) (elt host 3)))
  93     sockaddr))
  94
  95 (defmethod free-sockaddr-for ((socket inet-socket) sockaddr)
  96   (sockint::free-sockaddr-in sockaddr))
  97
  98 (defmethod size-of-sockaddr ((socket inet-socket))
  99   sockint::size-of-sockaddr-in)
 100
 101 (defmethod bits-of-sockaddr ((socket inet-socket) sockaddr)
 102   "Returns address and port of SOCKADDR as multiple values"
 103   (values
 104    (coerce (loop for i from 0 below 4
 105                  collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
 106            '(vector (unsigned-byte 8) 4))
 107    (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
 108       (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1))))
 109
 110 (defun make-inet-socket (type protocol)
 111   "Make an INET socket.  Deprecated in favour of make-instance"
 112   (make-instance 'inet-socket :type type :protocol protocol))