sunet/scheme/lib/sunet-utilities.scm

; 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"))))