net.sockets/iface.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Network interface class and operators.
   4 ;;;
   5
   6 (in-package :net.sockets)
   7
   8 (defclass interface ()
   9   ((name  :initarg :name :reader interface-name)
  10    (index :initarg :index :reader interface-index))
  11   (:documentation "Class describing a network interface."))
  12 (unset-method-docstring #'interface-name () '(interface))
  13 (set-function-docstring 'interface-name "Return the name of an INTERFACE.")
  14 (unset-method-docstring #'interface-index () '(interface))
  15 (set-function-docstring 'interface-index "Return the index number of an INTERFACE.")
  16
  17 (defmethod print-object ((interface interface) stream)
  18   (print-unreadable-object (interface stream :type nil :identity nil)
  19     (with-slots (name index) interface
  20       (format stream "Network Interface: ~S Index: ~A" name index))))
  21
  22 (defun make-interface (name index)
  23   "Constructor for INTERFACE objects."
  24   (make-instance 'interface :name name :index index))
  25
  26 (define-condition unknown-interface (system-error)
  27   ((datum :initarg :datum :initform nil :reader unknown-interface-datum))
  28   (:report (lambda (condition stream)
  29              (format stream "Unknown interface: ~A"
  30                      (unknown-interface-datum condition))))
  31   (:documentation "Condition raised when a network interface is not found."))
  32 (setf (documentation 'unknown-interface-datum 'function)
  33       "Return the datum that caused the signalling of an UNKNOWN-INTERFACE condition.")
  34
  35 (defun signal-unknown-interface-error (system-error datum)
  36   (error 'unknown-interface
  37          :code (osicat-sys:system-error-code system-error)
  38          :identifier (osicat-sys:system-error-identifier system-error)
  39          :datum datum))
  40
  41 (defun list-network-interfaces ()
  42   "Returns a list of network interfaces currently available."
  43   (let ((ifptr (null-pointer)))
  44     (macrolet ((%if-slot-value (slot index)
  45                  `(foreign-slot-value
  46                    (mem-aref ifptr 'if-nameindex ,index)
  47                    'if-nameindex ,slot)))
  48       (unwind-protect
  49            (progn
  50              (setf ifptr (%if-nameindex))
  51              (loop :for i :from 0
  52                    :for name := (%if-slot-value 'name i)
  53                    :for index := (%if-slot-value 'index i)
  54                :while (plusp index) :collect (make-interface name index)))
  55         (unless (null-pointer-p ifptr) (%if-freenameindex ifptr))))))
  56
  57 (defun get-interface-by-index (index)
  58   (with-foreign-object (buffer :uint8 ifnamesize)
  59     (handler-case
  60         (%if-indextoname index buffer)
  61       (nix:enxio (error)
  62         (signal-unknown-interface-error error index))
  63       (:no-error (name)
  64         (make-interface name index)))))
  65
  66 (defun get-interface-by-name (name)
  67   (handler-case
  68       (%if-nametoindex name)
  69     (nix:enxio (error)
  70       (signal-unknown-interface-error error name))
  71     (:no-error (index)
  72       (make-interface (copy-seq name) index))))
  73
  74 (defun lookup-interface (interface)
  75   "Lookup an interface by name or index.  UNKNOWN-INTERFACE is
  76 signalled if an interface is not found."
  77   (check-type interface (or unsigned-byte string symbol) "non-negative integer, a string or a symbol")
  78   (let ((interface (ensure-string-or-unsigned-byte interface)))
  79     (etypecase interface
  80       (unsigned-byte (get-interface-by-index interface))
  81       (string        (get-interface-by-name interface)))))