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


(define (system-fqdn)
  (let ((host (host-info (system-name))))
    (let loop ((addresses (host-info:addresses host)))
      (if (null? addresses)
	  #f
	  (or (dns-lookup-ip (car addresses))
	      (loop (cdr addresses)))))))