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-2007, 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           :initform (error "The interface must have a name.")
  29           :documentation "The interface's name.")
  30    (index :initarg :index :reader interface-index
  31           :initform (error "The interface must have an index.")
  32           :documentation "The interface's index number."))
  33   (:documentation "Class describing a network interface."))
  34
  35 (defmethod print-object ((iface interface) stream)
  36   (print-unreadable-object (iface stream :type nil :identity nil)
  37     (with-slots (name id) iface
  38       (format stream "Network Interface: ~S Index: ~A"
  39               (interface-name iface) (interface-index iface)))))
  40
  41 (defun make-interface (name index)
  42   "Constructor for INTERFACE objects."
  43   (make-instance 'interface :name  name :index index))
  44
  45 (define-condition unknown-interface (system-error)
  46   ((name  :initarg :name  :initform nil :reader interface-name)
  47    (index :initarg :index :initform nil :reader interface-index))
  48   (:report (lambda (condition stream)
  49              (if (interface-name condition)
  50                  (format stream "Unknown interface: ~A"
  51                          (interface-name condition))
  52                  (format stream "Unknown interface index: ~A"
  53                          (interface-index condition)))))
  54   (:documentation "Condition raised when a network interface is not found."))
  55
  56 (defun list-network-interfaces ()
  57   "Returns a list of network interfaces currently available."
  58   (with-foreign-object (ifptr :pointer)
  59     (setf ifptr (if-nameindex))
  60     (unless (null-pointer-p ifptr)
  61       (loop :for i :from 0
  62             :for name := (foreign-slot-value
  63                           (mem-aref ifptr 'if-nameindex i)
  64                                  'if-nameindex 'name)
  65             :for index := (foreign-slot-value
  66                            (mem-aref ifptr 'if-nameindex i)
  67                                   'if-nameindex 'index)
  68             :while (plusp index)
  69             :collect (make-interface name index)
  70             :finally (if-freenameindex ifptr)))))
  71
  72 (defun get-interface-by-index (index)
  73   (with-foreign-object (buff :uint8 ifnamesize)
  74     (handler-case
  75         (if-indextoname index buff)
  76       (nix:enxio (err)
  77         (error 'unknown-interface
  78                :code (osicat-sys:system-error-code err)
  79                :identifier (osicat-sys:system-error-identifier err)
  80                :index index))
  81       (:no-error (retval)
  82         (make-interface (copy-seq retval) index)))))
  83
  84 (defun get-interface-by-name (name)
  85   (handler-case
  86       (if-nametoindex name)
  87     (nix:enodev (err)
  88       (error 'unknown-interface
  89              :code (osicat-sys:system-error-code err)
  90              :identifier (osicat-sys:system-error-identifier err)
  91              :name name))
  92     (:no-error (index)
  93       (make-interface (copy-seq name) index))))
  94
  95 (defun lookup-interface (iface)
  96   "Lookup an interface by name or index.  UNKNOWN-INTERFACE is
  97 signalled if an interface is not found."
  98   (check-type iface (or unsigned-byte string symbol) "non-negative integer, a string or a symbol")
  99   (let ((iface (ensure-string-or-unsigned-byte iface)))
 100     (etypecase iface
 101       (unsigned-byte (get-interface-by-index iface))
 102       (string        (get-interface-by-name iface)))))