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-foreign-object (ifptr :pointer)
  59     (setf ifptr (et:if-nameindex))
  60     (unless (null-pointer-p ifptr)
  61       (let* ((iflist
  62               (loop
  63                  :for i :from 0
  64                  :for name := (foreign-slot-value (mem-aref ifptr 'et:if-nameindex i)
  65                                                   'et:if-nameindex 'et:name)
  66                  :for index := (foreign-slot-value (mem-aref ifptr 'et:if-nameindex i)
  67                                                    'et:if-nameindex 'et:index)
  68                  :while (plusp index)
  69                  :collect (make-interface name index)
  70                  :finally (et:if-freenameindex ifptr))))
  71         iflist))))
  72
  73 (defun get-interface-by-index (index)
  74   (check-type index unsigned-byte "an unsigned integer")
  75   (with-foreign-object (buff :uint8 et:ifnamesize)
  76     (let (retval)
  77       (handler-case
  78           (setf retval (et:if-indextoname index buff))
  79         (et:unix-error-nxio (err)
  80           (error 'unknown-interface
  81                  :code (error-code err)
  82                  :identifier (error-identifier err)
  83                  :index index)))
  84       (make-interface (copy-seq retval) index))))
  85
  86 (defun get-interface-by-name (name)
  87   (check-type name string "a string")
  88   (let (retval)
  89     (handler-case
  90         (setf retval (et:if-nametoindex name))
  91       (et:unix-error-nodev (err)
  92         (error 'unknown-interface
  93                :code (error-code err)
  94                :identifier (error-identifier err)
  95                :name name)))
  96     (make-interface (copy-seq name) retval)))
  97
  98 (defun lookup-interface (iface)
  99   (let ((parsed-number (parse-number-or-nil iface)))
 100     (if parsed-number
 101         (get-interface-by-index parsed-number)
 102         (get-interface-by-name iface))))