Fixed DEFMETHOD arg parsing.
[iolib/alendvai.git] / net.sockets / iface.lisp
blob91d0b7c88beb852402a253823e604d0fb8d2490c
1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; --- Network interface lookup.
4 ;;;
6 (in-package :net.sockets)
8 (defun make-interface (name index)
9 "Constructor for INTERFACE objects."
10 (cons name index))
12 (define-condition unknown-interface (system-error)
13 ((datum :initarg :datum :initform nil :reader unknown-interface-datum))
14 (:report (lambda (condition stream)
15 (format stream "Unknown interface: ~A"
16 (unknown-interface-datum condition))))
17 (:documentation "Condition raised when a network interface is not found."))
18 (setf (documentation 'unknown-interface-datum 'function)
19 "Return the datum that caused the signalling of an UNKNOWN-INTERFACE condition.")
21 (defun signal-unknown-interface-error (system-error datum)
22 (error 'unknown-interface
23 :code (osicat-sys:system-error-code system-error)
24 :identifier (osicat-sys:system-error-identifier system-error)
25 :datum datum))
27 (defun list-network-interfaces ()
28 "Returns a list of network interfaces currently available."
29 (let ((ifptr (null-pointer)))
30 (macrolet ((%if-slot-value (slot index)
31 `(foreign-slot-value
32 (mem-aref ifptr 'if-nameindex ,index)
33 'if-nameindex ,slot)))
34 (unwind-protect
35 (progn
36 (setf ifptr (%if-nameindex))
37 (loop :for i :from 0
38 :for name := (%if-slot-value 'name i)
39 :for index := (%if-slot-value 'index i)
40 :while (plusp index) :collect (make-interface name index)))
41 (unless (null-pointer-p ifptr) (%if-freenameindex ifptr))))))
43 (defun get-interface-by-index (index)
44 (with-foreign-object (buffer :uint8 ifnamesize)
45 (handler-case
46 (%if-indextoname index buffer)
47 (nix:enxio (error)
48 (signal-unknown-interface-error error index))
49 (:no-error (name)
50 (make-interface name index)))))
52 (defun get-interface-by-name (name)
53 (handler-case
54 (%if-nametoindex name)
55 (nix:enxio (error)
56 (signal-unknown-interface-error error name))
57 (:no-error (index)
58 (make-interface (copy-seq name) index))))
60 (defun interface-name (interface)
61 (car interface))
63 (defun interface-index (interface)
64 (cdr interface))
66 (defun lookup-interface (interface)
67 "Lookup an interface by name or index. UNKNOWN-INTERFACE is
68 signalled if an interface is not found."
69 (check-type interface (or unsigned-byte string symbol) "non-negative integer, a string or a symbol")
70 (let ((parsed (ensure-string-or-unsigned-byte interface :errorp t)))
71 (typecase interface
72 (unsigned-byte (get-interface-by-index parsed))
73 (string (get-interface-by-name parsed)))))