net.sockets/iface.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; iface.lisp --- Network interface class and operators.
   4 ;;;
   5 ;;; Copyright (C) 2006-2008, Stelian Ionescu  <sionescu@common-lisp.net>
   6 ;;;
   7 ;;; This code is free software; you can redistribute it and/or
   8 ;;; modify it under the terms of the version 2.1 of
   9 ;;; the GNU Lesser General Public License as published by
  10 ;;; the Free Software Foundation, as clarified by the
  11 ;;; preamble found here:
  12 ;;;     http://opensource.franz.com/preamble.html
  13 ;;;
  14 ;;; This program is distributed in the hope that it will be useful,
  15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU Lesser General
  20 ;;; Public License along with this library; if not, write to the
  21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  22 ;;; Boston, MA 02110-1301, USA
  23
  24 (in-package :net.sockets)
  25
  26 (defclass interface ()
  27   ((name  :initarg :name :reader interface-name)
  28    (index :initarg :index :reader interface-index))
  29   (:documentation "Class describing a network interface."))
  30
  31 (defmethod print-object ((interface interface) stream)
  32   (print-unreadable-object (interface stream :type nil :identity nil)
  33     (with-slots (name index) interface
  34       (format stream "Network Interface: ~S Index: ~A" name index))))
  35
  36 (defun make-interface (name index)
  37   "Constructor for INTERFACE objects."
  38   (make-instance 'interface :name name :index index))
  39
  40 (define-condition unknown-interface (system-error)
  41   ((datum :initarg :datum :initform nil :reader unknown-interface-datum))
  42   (:report (lambda (condition stream)
  43              (format stream "Unknown interface: ~A"
  44                      (unknown-interface-datum condition))))
  45   (:documentation "Condition raised when a network interface is not found."))
  46
  47 (defun signal-unknown-interface-error (system-error datum)
  48   (error 'unknown-interface
  49          :code (osicat-sys:system-error-code system-error)
  50          :identifier (osicat-sys:system-error-identifier system-error)
  51          :datum datum))
  52
  53 (defun list-network-interfaces ()
  54   "Returns a list of network interfaces currently available."
  55   (let ((ifptr (null-pointer)))
  56     (macrolet ((%if-slot-value (slot index)
  57                  `(foreign-slot-value
  58                    (mem-aref ifptr 'if-nameindex ,index)
  59                    'if-nameindex ,slot)))
  60       (unwind-protect
  61            (progn
  62              (setf ifptr (%if-nameindex))
  63              (loop :for i :from 0
  64                    :for name := (%if-slot-value 'name i)
  65                    :for index := (%if-slot-value 'index i)
  66                :while (plusp index) :collect (make-interface name index)))
  67         (unless (null-pointer-p ifptr) (%if-freenameindex ifptr))))))
  68
  69 (defun get-interface-by-index (index)
  70   (with-foreign-object (buffer :uint8 ifnamesize)
  71     (handler-case
  72         (%if-indextoname index buffer)
  73       (nix:enxio (error)
  74         (signal-unknown-interface-error error index))
  75       (:no-error (name)
  76         (make-interface name index)))))
  77
  78 (defun get-interface-by-name (name)
  79   (handler-case
  80       (%if-nametoindex name)
  81     (nix:enxio (error)
  82       (signal-unknown-interface-error error name))
  83     (:no-error (index)
  84       (make-interface (copy-seq name) index))))
  85
  86 (defun lookup-interface (interface)
  87   "Lookup an interface by name or index.  UNKNOWN-INTERFACE is
  88 signalled if an interface is not found."
  89   (check-type interface (or unsigned-byte string symbol) "non-negative integer, a string or a symbol")
  90   (let ((interface (ensure-string-or-unsigned-byte interface)))
  91     (etypecase interface
  92       (unsigned-byte (get-interface-by-index interface))
  93       (string        (get-interface-by-name interface)))))