#lang racket/base
(require racket/system
(planet neil/mcfly))
(module+ test
(require (planet neil/overeasy:2)))
(doc (section "Introduction")
(para "This package permits Racket programs to determined the host
machine's hostname and internal IP addresses.")
(para "This package currently relies on the "
(filepath "/bin/hostname")
" and "
(filepath "/sbin/ifconfig")
" programs, available on various Unix-like systems, like GNU/Linux,
FreeBSD, OpenBSD, and Mac OS X."))
(doc (section "Interface"))
(define %hostname:null-input-port
(make-input-port 'null
(lambda (s) eof)
(lambda (skip s progress-evt) eof)
void
(lambda () never-evt)
(lambda (k progress-evt done-evt)
(error "no successful peeks!"))))
(define (%hostname:system*/string #:error-name error-name
#:use-exn? use-exn?
#:trim-newline? trim-newline?
#:command command
#:args args)
(let* ((stdout-os (open-output-string))
(stderr-os (open-output-string))
(ok? (parameterize ((current-output-port stdout-os)
(current-error-port stderr-os)
(current-input-port %hostname:null-input-port))
(apply system* command args)))
(stdout-str (get-output-string stdout-os))
(stderr-str (get-output-string stderr-os)))
(if ok?
(if (equal? "" stderr-str)
(if trim-newline?
(regexp-replace #rx"\r?\n$" stdout-str "")
stdout-str)
(if use-exn?
(error error-name
"shell command ~S had stderr ~S and stdout ~S"
(cons command args)
stderr-str
stdout-str)
#f))
(if use-exn?
(error error-name
"shell command ~S failed with stderr ~S and stdout ~S"
(cons command args)
stderr-str
stdout-str)
#f))))
(doc (defproc (get-full-hostname)
(or/c #f string?)
(para "Gets the full hostname (aka, fully-qualified domain name, or
FQDN) of the host, or "
(racket #f)
" if unknown.")
(racketinput (get-full-hostname)
#,(racketresult "computer.lan"))))
(provide get-full-hostname)
(define (get-full-hostname)
(or (getenv "HOSTNAME")
(%hostname:system*/string #:error-name 'get-full-hostname
#:use-exn? #f
#:trim-newline? #t
#:command "/bin/hostname"
#:args '("-f"))
(%hostname:system*/string #:error-name 'get-short-hostname
#:use-exn? #f
#:trim-newline? #t
#:command "hostname"
#:args '("-f"))))
(doc (defproc (get-short-hostname)
(or/c #f string?)
(para "Gets the short hostname (i.e., just the hostname of the immediate
host, not qualified with any parent domain names), or "
(racket #f)
" if unknown.")
(racketinput (get-short-hostname)
#,(racketresult "computer"))))
(provide get-short-hostname)
(define (get-short-hostname)
(or (%hostname:system*/string #:error-name 'get-short-hostname
#:use-exn? #f
#:trim-newline? #t
#:command "/bin/hostname"
#:args '("-s"))
(%hostname:system*/string #:error-name 'get-short-hostname
#:use-exn? #f
#:trim-newline? #t
#:command "hostname"
#:args '())))
(define %hostname:parse-ipv4-addrs-from-ifconfig-rx
(let* ((octet "[0-9](?:[0-9](?:[0-9])?)?"))
(regexp (string-append "[ \t]"
"inet"
"[ \t]+"
"(?:" "addr:"
"[ \t]*"
")?" "(" "(?:" "(127)" "|" octet
")" "\\."
octet
"\\."
octet
"\\."
octet
")" ))))
(define (%hostname:parse-ipv4-addrs-from-ifconfig
in
#:normal? (normal? #t)
#:localhost? (localhost? #f))
(let loop ((reverse-results '()))
(cond ((regexp-try-match %hostname:parse-ipv4-addrs-from-ifconfig-rx
in)
=> (lambda (m)
(apply (lambda (whole addr onetwoseven)
(if (if onetwoseven
localhost?
normal?)
(loop (cons (bytes->string/latin-1 addr) reverse-results))
(loop reverse-results)))
m)))
(else (reverse reverse-results)))))
(module+ test
(test (let ((str (string-append
"eth0 Link encap:Ethernet HWaddr 00:11:22:33:44:55 \n"
" UP BROADCAST MULTICAST MTU:1500 Metric:1\n"
" RX packets:0 errors:0 dropped:0 overruns:0 frame:0\n"
" TX packets:0 errors:0 dropped:0 overruns:0 carrier:0\n"
" collisions:0 txqueuelen:1000 \n"
" RX bytes:0 (0.0 B) TX bytes:0 (0.0 B)\n"
" Interrupt:16 Memory:ee000000-ee020000 \n"
"\n"
"lo Link encap:Local Loopback \n"
" inet addr:127.0.0.1 Mask:255.0.0.0\n"
" inet6 addr: ::1/128 Scope:Host\n"
" UP LOOPBACK RUNNING MTU:16436 Metric:1\n"
" RX packets:50 errors:0 dropped:0 overruns:0 frame:0\n"
" TX packets:50 errors:0 dropped:0 overruns:0 carrier:0\n"
" collisions:0 txqueuelen:0 \n"
" RX bytes:3204 (3.1 KiB) TX bytes:3204 (3.1 KiB)\n"
"\n"
"wlan0 Link encap:Ethernet HWaddr 00:11:22:33:44:56 \n"
" inet addr:123.123.1.234 Bcast:123.123.1.255 Mask:255.255.255.0\n"
" inet6 addr: 1111::222:3333:4444:5555/64 Scope:Link\n"
" UP BROADCAST RUNNING MULTICAST MTU:1500 Metric:1\n"
" RX packets:20281 errors:0 dropped:0 overruns:0 frame:0\n"
" TX packets:19318 errors:0 dropped:0 overruns:0 carrier:0\n"
" collisions:0 txqueuelen:1000 \n"
" RX bytes:19514369 (18.6 MiB) TX bytes:2709526 (2.5 MiB)\n")))
(values (%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str))
(%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str) #:localhost? #t)
(%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str) #:normal? #f #:localhost? #t)))
(values '("123.123.1.234")
'("127.0.0.1"
"123.123.1.234")
'("127.0.0.1")))
(test (let ((str (string-append
"en1: flags=8863<UP,BROADCAST,SMART,RUNNING,SIMPLEX,MULTICAST> mtu 1500\n"
" ether 00:23:xx:xx:xx:xx \n"
" inet 192.168.141.99 netmask 0xffffff00 broadcast 192.168.141.255\n"
" inet 192.168.1.112 netmask 0xffffff00 broadcast 192.168.1.255\n"
" media: autoselect\n"
" status: active\n")))
(values (%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str))
(%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str) #:localhost? #t)))
(values '("192.168.141.99"
"192.168.1.112")
'("192.168.141.99"
"192.168.1.112")))
(test (let ((str (string-append
"lo0: flags=8049<UP,LOOPBACK,RUNNING,MULTICAST> mtu 16384\n"
"\tinet6 ::1 prefixlen 128 \n"
"\tinet6 fe80::1%lo0 prefixlen 64 scopeid 0x1 \n"
"\tinet 127.0.0.1 netmask 0xff000000 \n"
"gif0: flags=8010<POINTOPOINT,MULTICAST> mtu 1280\n"
"stf0: flags=0<> mtu 1280\n"
"en0: flags=8863<UP,BROADCAST,SMART,RUNNING,SIMPLEX,MULTICAST> mtu 1500\n"
"\tether 00:11:22:33:44:55 \n"
"\tinet 192.168.2.1 netmask 0xffffff00 broadcast 192.168.2.255\n"
"\tmedia: autoselect\n"
"\tstatus: inactive\n"
"fw0: flags=8863<UP,BROADCAST,SMART,RUNNING,SIMPLEX,MULTICAST> mtu 4078\n"
"\tlladdr 00:11:22:33:44:55:66:77 \n"
"\tmedia: autoselect <full-duplex>\n"
"\tstatus: inactive\n"
"en1: flags=8863<UP,BROADCAST,SMART,RUNNING,SIMPLEX,MULTICAST> mtu 1500\n"
"\tether 00:11:22:33:44:56 \n"
"\tinet6 1111::222:33:4444:555%en1 prefixlen 64 scopeid 0x6 \n"
"\tinet 123.123.1.234 netmask 0xffffff00 broadcast 123.123.1.255\n"
"\tmedia: autoselect\n"
"\tstatus: active\n"
"vboxnet0: flags=8842<BROADCAST,RUNNING,SIMPLEX,MULTICAST> mtu 1500\n"
"\tether 0a:00:27:00:00:00\n")))
(values (%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str))
(%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str) #:localhost? #t)))
(values '("192.168.2.1"
"123.123.1.234")
'("127.0.0.1"
"192.168.2.1"
"123.123.1.234")))
(test (let ((str (string-append
"em0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST> metric 0 mtu 1500\n"
"\toptions=219b<RXCSUM,TXCSUM,VLAN_MTU,VLAN_HWTAGGING,VLAN_HWCSUM,TSO4,WOL_MAGIC>\n"
"\tether xx:xx:xx:xx:xx:xx\n"
"\tinet 10.0.5.2 netmask 0xff00ff00 broadcast 10.255.5.255\n"
"\tmedia: Ethernet autoselect (1000baseT <full-duplex>)\n"
"\tstatus: active\n")))
(values (%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str))
(%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str) #:localhost? #t)))
(values '("10.0.5.2")
'("10.0.5.2")))
(test (let ((str (string-append
"nfe0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST> mtu 1500\n"
" lladdr 00:14:4f:7d:91:ea\n"
" media: Ethernet autoselect (1000baseSX full-duplex)\n"
" status: active\n"
" inet 192.168.100.77 netmask 0xffffff00 broadcast 192.168.100.255\n"
" inet6 fe80::214:4fff:fe7d:91ea%nfe0 prefixlen 64 scopeid 0x1\n")))
(values (%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str))
(%hostname:parse-ipv4-addrs-from-ifconfig (open-input-string str) #:localhost? #t)))
(values '("192.168.100.77")
'("192.168.100.77"))))
(doc (defproc (get-ipv4-addrs (#:normal? normal? boolean? #t)
(#:localhost? localhost? boolean? #f))
(listof string?)
(para "Get a list of IPv4 addresses for this machine, such as gotten
from "
(filepath "/sbin/ifconfig")
".")
(para "If "
(racket normal?)
" is true, then non-localhost addresses are included. If "
(racket localhost?)
" is true, then localhost addresses are included.")
(para "The ordering of the list is unspecified. In event of error,
generally an empty list will be returned (and a "
(racket 'warning)
" message will be posted to "
(racket current-logger)
").")
(racketinput (get-ipv4-addrs)
#,(racketresult '("192.168.141.99"
"192.168.1.112")))
(racketinput (get-ipv4-addrs #:localhost? #t)
#,(racketresult '("127.0.0.1"
"192.168.141.99"
"192.168.1.112")))))
(provide get-ipv4-addrs)
(define (get-ipv4-addrs #:normal? (normal? #t)
#:localhost? (localhost? #f))
(let ((command "/sbin/ifconfig"))
(cond ((with-handlers ((exn:fail?
(lambda (e)
(log-warning (format "get-ipv4-addrs: command ~S failed: ~S"
command
(exn-message e)))
#f)))
(process* command))
=> (lambda (lst)
(apply (lambda (stdout-in stdin-out pid stderr-in proc)
(dynamic-wind
void
(lambda ()
(with-handlers ((exn:fail?
(lambda (e)
(log-warning (format "get-ipv4-addrs: error while parsing output of command ~S: ~S"
command
(exn-message e)))
'())))
(%hostname:parse-ipv4-addrs-from-ifconfig
stdout-in
#:normal? normal?
#:localhost? localhost?)))
(lambda ()
(with-handlers ((exn:fail? void))
(proc 'kill)))))
lst)))
(else '()))))
(doc history
(#:planet 1:2 #:date "2012-10-05"
(itemlist
(item
"Added "
(racket get-ipv4-addrs)
".")))
(#:planet 1:1 #:date "2012-09-29"
(itemlist
(item "Fixed problem with "
(filepath "main.rkt")
".")))
(#:planet 1:0 #:date "2012-09-29"
(itemlist
(item "Initial release."))))
![[logo]](/logo.png){kind=logo}