syscalls: Add 'all-network-interfaces'.
* guix/build/syscalls.scm (network-interfaces): Update docstring. (%interface-line): New variable. (all-network-interfaces): New procedure. * tests/syscalls.scm ("all-network-interfaces"): New test. ("network-interfaces"): Change to make sure the result is a subset of (all-network-interfaces).
This commit is contained in:
parent
973eea3478
commit
4d54785c69
|
@ -21,6 +21,7 @@
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:export (errno
|
#:export (errno
|
||||||
|
@ -35,6 +36,7 @@
|
||||||
IFF_UP
|
IFF_UP
|
||||||
IFF_BROADCAST
|
IFF_BROADCAST
|
||||||
IFF_LOOPBACK
|
IFF_LOOPBACK
|
||||||
|
all-network-interfaces
|
||||||
network-interfaces
|
network-interfaces
|
||||||
network-interface-flags
|
network-interface-flags
|
||||||
loopback-network-interface?))
|
loopback-network-interface?))
|
||||||
|
@ -244,7 +246,8 @@ most LEN bytes from BV."
|
||||||
result))))))
|
result))))))
|
||||||
|
|
||||||
(define* (network-interfaces #:optional sock)
|
(define* (network-interfaces #:optional sock)
|
||||||
"Return the list of existing network interfaces."
|
"Return the list of existing network interfaces. This is typically limited
|
||||||
|
to interfaces that are currently up."
|
||||||
(let* ((close? (not sock))
|
(let* ((close? (not sock))
|
||||||
(sock (or sock (socket SOCK_STREAM AF_INET 0)))
|
(sock (or sock (socket SOCK_STREAM AF_INET 0)))
|
||||||
(len (* ifreq-struct-size 10))
|
(len (* ifreq-struct-size 10))
|
||||||
|
@ -264,6 +267,26 @@ most LEN bytes from BV."
|
||||||
(list (strerror err))
|
(list (strerror err))
|
||||||
(list err)))))
|
(list err)))))
|
||||||
|
|
||||||
|
(define %interface-line
|
||||||
|
;; Regexp matching an interface line in Linux's /proc/net/dev.
|
||||||
|
(make-regexp "^[[:blank:]]*([[:alnum:]]+): .*$"))
|
||||||
|
|
||||||
|
(define (all-network-interfaces)
|
||||||
|
"Return all the registered network interfaces, including those that are not
|
||||||
|
up."
|
||||||
|
(call-with-input-file "/proc/net/dev" ;XXX: Linux-specific
|
||||||
|
(lambda (port)
|
||||||
|
(let loop ((interfaces '()))
|
||||||
|
(let ((line (read-line port)))
|
||||||
|
(cond ((eof-object? line)
|
||||||
|
(reverse interfaces))
|
||||||
|
((regexp-exec %interface-line line)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(loop (cons (match:substring match 1) interfaces))))
|
||||||
|
(else
|
||||||
|
(loop interfaces))))))))
|
||||||
|
|
||||||
(define (network-interface-flags socket name)
|
(define (network-interface-flags socket name)
|
||||||
"Return a number that is the bit-wise or of 'IFF*' flags for network
|
"Return a number that is the bit-wise or of 'IFF*' flags for network
|
||||||
interface NAME."
|
interface NAME."
|
||||||
|
|
|
@ -18,6 +18,7 @@
|
||||||
|
|
||||||
(define-module (test-syscalls)
|
(define-module (test-syscalls)
|
||||||
#:use-module (guix build syscalls)
|
#:use-module (guix build syscalls)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
|
@ -43,10 +44,15 @@
|
||||||
;; Both return values have been encountered in the wild.
|
;; Both return values have been encountered in the wild.
|
||||||
(memv (system-error-errno args) (list EPERM ENOENT)))))
|
(memv (system-error-errno args) (list EPERM ENOENT)))))
|
||||||
|
|
||||||
|
(test-assert "all-network-interfaces"
|
||||||
|
(match (all-network-interfaces)
|
||||||
|
(((? string? names) ..1)
|
||||||
|
(member "lo" names))))
|
||||||
|
|
||||||
(test-assert "network-interfaces"
|
(test-assert "network-interfaces"
|
||||||
(match (network-interfaces)
|
(match (network-interfaces)
|
||||||
(((? string? names) ..1)
|
(((? string? names) ..1)
|
||||||
(member "lo" names))))
|
(lset<= string=? names (all-network-interfaces)))))
|
||||||
|
|
||||||
(test-assert "network-interface-flags"
|
(test-assert "network-interface-flags"
|
||||||
(let* ((sock (socket SOCK_STREAM AF_INET 0))
|
(let* ((sock (socket SOCK_STREAM AF_INET 0))
|
||||||
|
|
Loading…
Reference in New Issue