src/sockets/iface.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Network interface lookup.
   4 ;;;
   5
   6 (in-package :iolib.sockets)
   7
   8 (defun make-interface (name index)
   9   "Constructor for INTERFACE objects."
  10   (cons name index))
  11
  12 (define-condition unknown-interface (isys:enxio)
  13   ((datum :initarg :datum :initform nil :reader unknown-interface-datum))
  14   (:report (lambda (condition stream)
  15              (format stream "Unknown interface: ~A"
  16                      (unknown-interface-datum condition))))
  17   (:documentation "Condition raised when a network interface is not found."))
  18 (setf (documentation 'unknown-interface-datum 'function)
  19       "Return the datum that caused the signalling of an UNKNOWN-INTERFACE condition.")
  20
  21 (defun signal-unknown-interface-error (syscall datum)
  22   (error 'unknown-interface :syscall syscall :datum datum))
  23
  24 (defun list-network-interfaces ()
  25   "Returns a list of network interfaces currently available."
  26   (let ((ifptr (null-pointer)))
  27     (unwind-protect
  28          (progn
  29            (setf ifptr (%if-nameindex))
  30            (loop :for p := ifptr :then (inc-pointer p (isys:sizeof '(:struct if-nameindex)))
  31                  :for name := (foreign-slot-value p '(:struct if-nameindex) 'name)
  32                  :for index := (foreign-slot-value p '(:struct if-nameindex) 'index)
  33                :while (plusp index) :collect (make-interface name index)))
  34       (unless (null-pointer-p ifptr) (%if-freenameindex ifptr)))))
  35
  36 (defun get-interface-by-index (index)
  37   (with-foreign-object (buffer :uint8 ifnamesize)
  38     (handler-case
  39         (%if-indextoname index buffer)
  40       (isys:enxio ()
  41         (signal-unknown-interface-error "if_indextoname" index))
  42       (:no-error (name)
  43         (make-interface name index)))))
  44
  45 (defun get-interface-by-name (name)
  46   (handler-case
  47       (%if-nametoindex name)
  48     (isys:enxio ()
  49       (signal-unknown-interface-error "if_nametoindex" name))
  50     (:no-error (index)
  51       (make-interface (copy-seq name) index))))
  52
  53 (defun interface-name (interface)
  54   "Return the name of an network interface."
  55   (car interface))
  56
  57 (defun interface-index (interface)
  58   "Return the OS index of a network interface."
  59   (cdr interface))
  60
  61 (defun lookup-interface (interface)
  62   "Lookup an interface by name or index.  UNKNOWN-INTERFACE is
  63 signalled if an interface is not found."
  64   (check-type interface (or unsigned-byte string symbol) "non-negative integer, a string or a symbol")
  65   (let ((parsed (ensure-string-or-unsigned-byte interface :errorp t)))
  66     (typecase interface
  67       (unsigned-byte (get-interface-by-index parsed))
  68       (string        (get-interface-by-name  parsed)))))