sockets/iface.lisp

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