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