sockets/iface.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;   Copyright (C) 2006 by Stelian Ionescu                                 ;
   5 ;                                                                         ;
   6 ;   This program is free software; you can redistribute it and/or modify  ;
   7 ;   it under the terms of the GNU General Public License as published by  ;
   8 ;   the Free Software Foundation; either version 2 of the License, or     ;
   9 ;   (at your option) any later version.                                   ;
  10 ;                                                                         ;
  11 ;   This program is distributed in the hope that it will be useful,       ;
  12 ;   but WITHOUT ANY WARRANTY; without even the implied warranty of        ;
  13 ;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         ;
  14 ;   GNU General Public License for more details.                          ;
  15 ;                                                                         ;
  16 ;   You should have received a copy of the GNU General Public License     ;
  17 ;   along with this program; if not, write to the                         ;
  18 ;   Free Software Foundation, Inc.,                                       ;
  19 ;   51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA              ;
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21
  22 ;; (declaim (optimize (speed 2) (safety 2) (space 1) (debug 2)))
  23 (declaim (optimize (speed 0) (safety 2) (space 0) (debug 2)))
  24
  25 (in-package #:net.sockets)
  26
  27 (defclass interface ()
  28   ((name  :initarg :name
  29           :initform (error "The interface must have a name.")
  30           :reader interface-name)
  31    (index :initarg :index
  32           :initform (error "The interface must have an index.")
  33           :reader interface-index)))
  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   (make-instance 'interface
  43                  :name  name
  44                  :index index))
  45
  46 (define-condition unknown-interface (system-error)
  47   ((name  :initarg :name  :initform nil :reader interface-name)
  48    (index :initarg :index :initform nil :reader interface-index))
  49   (:report (lambda (condition stream)
  50              (if (interface-name condition)
  51                  (format stream "Unknown interface: ~a"
  52                          (interface-name condition))
  53                  (format stream "Unknown interface index: ~a"
  54                          (interface-index condition)))))
  55   (:documentation "Condition raised when a network interface is not found."))
  56
  57 (defun get-network-interfaces ()
  58   (with-alien ((ifptr (* (array (struct et:if-nameindex) 0))))
  59     (setf ifptr (et:if-nameindex))
  60     (unless (null-alien ifptr)
  61       (let* ((ifarr (deref ifptr))
  62              (iflist
  63               (loop
  64                  :for i :from 0
  65                  :for name = (slot (deref ifarr i) 'et:name)
  66                  :for index = (slot (deref ifarr i) 'et:index)
  67                  :while (plusp index)
  68                  :collect (make-interface name index)
  69                  :finally (et:if-freenameindex ifptr))))
  70         (return-from get-network-interfaces iflist)))))
  71
  72 (defun get-interface-by-index (index)
  73   (check-type index unsigned-byte "an unsigned integer")
  74   (with-alien ((buff (array char #.et:ifnamesize)))
  75     (with-alien-saps ((buff-sap buff))
  76       (let (retval)
  77         (handler-case
  78             (setf retval (et::if-indextoname index buff-sap))
  79           (unix-error (err)
  80             (error 'unknown-interface
  81                    :code (error-code err)
  82                    :identifier (error-identifier err)
  83                    :index index)))
  84         (return-from
  85          get-interface-by-index
  86           (make-interface (copy-seq retval) index))))))
  87
  88 (defun get-interface-by-name (name)
  89   (check-type name string "a string")
  90   (sb-sys:with-pinned-objects (name)
  91     (let (retval)
  92       (handler-case
  93           (setf retval (et::if-nametoindex name))
  94         (unix-error (err)
  95           (error 'unknown-interface
  96                  :code (error-code err)
  97                  :identifier (error-identifier err)
  98                  :name name)))
  99       (make-interface (copy-seq name) retval))))
 100
 101 (defun lookup-interface (iface)
 102   (multiple-value-bind (iface-type iface-val)
 103       (string-or-parsed-number iface)
 104     (ecase iface-type
 105       (:number
 106        (get-interface-by-index iface-val))
 107
 108       (:string
 109        (get-interface-by-name iface-val)))))