56 lines
1.7 KiB
Scheme
56 lines
1.7 KiB
Scheme
; some useful utilities
|
|
|
|
(define (host-name-or-ip addr)
|
|
(with-fatal-error-handler
|
|
(lambda (condition more)
|
|
(call-with-values
|
|
(lambda () (socket-address->internet-address addr))
|
|
(lambda (ip port)
|
|
(format-internet-host-address ip))))
|
|
(host-info:name (host-info addr))))
|
|
|
|
(define (on-interrupt interrupt thunk)
|
|
(let lp ((event (most-recent-sigevent)))
|
|
(let ((next (next-sigevent event interrupt)))
|
|
(thunk)
|
|
(lp next))))
|
|
|
|
(define (socket-address->string socket-address . with-port?)
|
|
(let ((with-port? (:optional with-port? #t)))
|
|
(receive (host-address service-port)
|
|
(socket-address->internet-address socket-address)
|
|
(if with-port?
|
|
(format #f "~A:~A"
|
|
(format-internet-host-address host-address)
|
|
(format-port service-port))
|
|
(format #f "~A"
|
|
(format-internet-host-address host-address))))))
|
|
|
|
|
|
(define (dump fd)
|
|
(let loop ((c (read-char fd)))
|
|
(cond ((not (eof-object? c))
|
|
(write-char c)
|
|
(loop (read-char fd))))))
|
|
|
|
;; out from ecm-utilities.scm
|
|
;; please tell me if this doesn't work on your system.
|
|
(define (system-fqdn)
|
|
(let ((sysname (system-name)))
|
|
(if (string-index sysname #\.)
|
|
sysname
|
|
(nslookup-fqdn))))
|
|
|
|
;; This doesn't work on my system. Probably it is not configured well.
|
|
;; Nevertheless, the alternative seems better to me
|
|
;(define (nslookup-fqdn)
|
|
; (let* ((cmd (format #f "nslookup ~a" (system-name)))
|
|
; (raw (string-join (run/strings (nslookup ,(system-name)))))
|
|
; (match (string-match "Name: +([-a-zA-Z0-9.]+)" raw)))
|
|
; (display raw)
|
|
; (match:substring match 1)))
|
|
|
|
(define (nslookup-fqdn)
|
|
(host-info:name (host-info (system-name))))
|
|
; another easy alternative:
|
|
; (car (run/strings (hostname "--long")))) |