Small improvement in %NORMALIZE-SEND-BUFFER.
[iolib.git] / net.sockets / iface.lisp
blob2d999893dab345d220d2d708fa380cc558e8a461
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-2008, 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
24 (in-package :net.sockets)
26 (defclass interface ()
27 ((name :initarg :name :reader interface-name)
28 (index :initarg :index :reader interface-index))
29 (:documentation "Class describing a network interface."))
31 (defmethod print-object ((interface interface) stream)
32 (print-unreadable-object (interface stream :type nil :identity nil)
33 (with-slots (name index) interface
34 (format stream "Network Interface: ~S Index: ~A" name index))))
36 (defun make-interface (name index)
37 "Constructor for INTERFACE objects."
38 (make-instance 'interface :name name :index index))
40 (define-condition unknown-interface (system-error)
41 ((datum :initarg :datum :initform nil :reader unknown-interface-datum))
42 (:report (lambda (condition stream)
43 (format stream "Unknown interface: ~A"
44 (unknown-interface-datum condition))))
45 (:documentation "Condition raised when a network interface is not found."))
47 (defun signal-unknown-interface-error (system-error datum)
48 (error 'unknown-interface
49 :code (osicat-sys:system-error-code system-error)
50 :identifier (osicat-sys:system-error-identifier system-error)
51 :datum datum))
53 (defun list-network-interfaces ()
54 "Returns a list of network interfaces currently available."
55 (let ((ifptr (null-pointer)))
56 (macrolet ((%if-slot-value (slot index)
57 `(foreign-slot-value
58 (mem-aref ifptr 'if-nameindex ,index)
59 'if-nameindex ,slot)))
60 (unwind-protect
61 (progn
62 (setf ifptr (%if-nameindex))
63 (loop :for i :from 0
64 :for name := (%if-slot-value 'name i)
65 :for index := (%if-slot-value 'index i)
66 :while (plusp index) :collect (make-interface name index)))
67 (unless (null-pointer-p ifptr) (%if-freenameindex ifptr))))))
69 (defun get-interface-by-index (index)
70 (with-foreign-object (buffer :uint8 ifnamesize)
71 (handler-case
72 (%if-indextoname index buffer)
73 (nix:enxio (error)
74 (signal-unknown-interface-error error index))
75 (:no-error (name)
76 (make-interface name index)))))
78 (defun get-interface-by-name (name)
79 (handler-case
80 (%if-nametoindex name)
81 (nix:enxio (error)
82 (signal-unknown-interface-error error name))
83 (:no-error (index)
84 (make-interface (copy-seq name) index))))
86 (defun lookup-interface (interface)
87 "Lookup an interface by name or index. UNKNOWN-INTERFACE is
88 signalled if an interface is not found."
89 (check-type interface (or unsigned-byte string symbol) "non-negative integer, a string or a symbol")
90 (let ((interface (ensure-string-or-unsigned-byte interface)))
91 (etypecase interface
92 (unsigned-byte (get-interface-by-index interface))
93 (string (get-interface-by-name interface)))))