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 (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:unix-error-nxio (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:unix-error-nodev (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))))