contrib/sb-bsd-sockets/inet.lisp

   1 (in-package :sb-bsd-sockets)
   2
   3 ;;;
   4
   5 (define-condition unknown-protocol (error)
   6   ((name :initarg :name
   7          :reader unknown-protocol-name))
   8   (:report (lambda (condition stream)
   9              (format stream "Protocol not found: ~A"
  10                      (prin1-to-string (unknown-protocol-name condition))))))
  11
  12 (defvar *protocols*
  13   `((:tcp ,sockint::ipproto_tcp "tcp" "TCP")
  14     (:udp ,sockint::ipproto_udp "udp" "UDP")
  15     (:ip ,sockint::ipproto_ip "ip" "IP")
  16     (:ipv6 ,sockint::ipproto_ipv6 "ipv6" "IPV6")
  17     (:icmp ,sockint::ipproto_icmp "icmp" "ICMP")
  18     (:igmp ,sockint::ipproto_igmp "igmp" "IGMP")
  19     (:raw ,sockint::ipproto_raw "raw" "RAW")))
  20
  21 ;;; Try to get to a protocol quickly, falling back to calling
  22 ;;; getprotobyname if it's available.
  23 (defun get-protocol-by-name (name)
  24   "Given a protocol name, return the protocol number, the protocol name, and
  25 a list of protocol aliases"
  26   (let ((result (cdr (if (keywordp name)
  27                          (assoc name *protocols*)
  28                          (assoc name *protocols* :test #'string-equal)))))
  29     (if result
  30         (values (first result) (second result) (third result))
  31         #-android
  32         (getprotobyname (string-downcase name))
  33         #+android (error 'unknown-protocol :name name))))
  34
  35 #+(and sb-thread (not os-provides-getprotoby-r) (not android))
  36 ;; Since getprotobyname is not thread-safe, we need a lock.
  37 (sb-ext:defglobal **getprotoby-lock** (sb-thread:make-mutex :name "getprotoby lock"))
  38
  39 ;;; msan sanitizer does not intercept getprotobyname_r() and reports that the output
  40 ;;; parameter does not get written by the library function. Minimal test program:
  41 ;;;   #include <netdb.h>
  42 ;;;   #include <stdio.h>
  43 ;;;   #include <sanitizer/msan_interface.h>
  44 ;;;
  45 ;;;   long __attribute__((no_sanitize_memory)) get(void* p){ return *(long*)p; }
  46 ;;;   void main() {
  47 ;;;     struct protoent ent, *answer;
  48 ;;;     char strings[1024];
  49 ;;;     answer = (void*)0xaabbccddee;
  50 ;;;     __msan_allocated_memory(&answer, 8); // mark it as poisoned
  51 ;;;     int rc = getprotobyname_r("nosuchproto", &ent, strings, 1024, &answer);
  52 ;;;     printf("rc=%d answer=%lx\n", rc, get(&answer));
  53 ;;;     __msan_check_mem_is_initialized(&answer, 8);
  54 ;;;   }
  55 ;;; Result:
  56 ;;;   rc=0 res=0
  57 ;;;   Uninitialized bytes in __msan_check_mem_is_initialized at offset 0 inside [0x7ffca9a14580, 8)
  58 ;;;   ==110705==WARNING: MemorySanitizer: use-of-uninitialized-value
  59
  60 ;;; getprotobyname only works in the internet domain, which is why this
  61 ;;; is here
  62 #-android
  63 (defun getprotobyname (name)
  64   ;; Brownie Points.  Hopefully there's one person out there using
  65   ;; RSPF sockets and SBCL who will appreciate the extra info
  66   (labels ((protoent-to-values (protoent)
  67              (values
  68               (sockint::protoent-proto protoent)
  69               (sockint::protoent-name protoent)
  70               (let ((index 0))
  71                 (loop
  72                   for alias = (sb-alien:deref
  73                                (sockint::protoent-aliases protoent) index)
  74                   while (not (sb-alien:null-alien alias))
  75                   do (incf index)
  76                   collect (sb-alien::c-string-to-string
  77                            (sb-alien:alien-sap alias)
  78                            (sb-impl::default-external-format)
  79                            'character))))))
  80     #+(and sb-thread os-provides-getprotoby-r)
  81     (let ((buffer-length 1024)
  82           (max-buffer 10000)
  83           (result-buf nil)
  84           (buffer nil)
  85           #-solaris
  86           (result nil))
  87       (declare (type fixnum buffer-length)
  88                (type fixnum max-buffer))
  89       (loop
  90         (unwind-protect
  91              (progn
  92                (setf result-buf (sb-alien:make-alien sockint::protoent)
  93                      buffer (sb-alien:make-alien sb-alien:char buffer-length))
  94                #-solaris
  95                (setf result (sb-alien:make-alien (* sockint::protoent)))
  96                (when (or (sb-alien:null-alien result-buf)
  97                          (sb-alien:null-alien buffer)
  98                          (sb-alien:null-alien result))
  99                  (error "Could not allocate foreign memory."))
 100                (let ((res (sockint::getprotobyname-r
 101                            name result-buf buffer buffer-length #-solaris result)))
 102                  (cond ((eql res 0)
 103                         #-solaris
 104                         (when (sb-alien:null-alien
 105                                ;; See comment above about spurious failure under MSAN.
 106                                (locally (declare (optimize (safety 0)))
 107                                  (sb-alien:deref result 0)))
 108                           (error 'unknown-protocol :name name))
 109                         (return-from getprotobyname
 110                           (protoent-to-values result-buf)))
 111                        (t
 112                         (let ((errno (sb-alien:get-errno)))
 113                           (cond ((eql errno sb-unix:enoent)
 114                                  ;; Usually caused by missing /etc/protocols
 115                                  (error 'unknown-protocol :name name))
 116                                 ((eql errno sockint::erange)
 117                                  (incf buffer-length 1024)
 118                                  (when (> buffer-length max-buffer)
 119                                    (error "Exceeded max-buffer of ~d" max-buffer)))
 120                                 (t
 121                                  (error "Unexpected errno ~d" errno))))))))
 122           (when result-buf
 123             (sb-alien:free-alien result-buf))
 124           (when buffer
 125             (sb-alien:free-alien buffer))
 126           #-solaris
 127           (when result
 128             (sb-alien:free-alien result)))))
 129     #+(or (not sb-thread) (not os-provides-getprotoby-r))
 130     (tagbody
 131        (flet ((get-it ()
 132                 (let ((ent (sockint::getprotobyname name)))
 133                   (if (sb-alien::null-alien ent)
 134                       (go :error)
 135                       (return-from getprotobyname (protoent-to-values ent))))))
 136          #+sb-thread
 137          (sb-int:with-system-mutex (**getprotoby-lock**)
 138            (get-it))
 139          #-sb-thread
 140          (get-it))
 141      :error
 142        (error 'unknown-protocol :name name))))