sunet/scheme/lib/ecm-utilities.scm

58 lines
1.5 KiB
Scheme

;; ecm-utilities.scm -- Utility procedures for ecm-net code
;;
;; $Id: ecm-utilities.scm,v 1.1 2002/06/08 15:05:24 sperber Exp $
;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
;; 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"))))
;; prefer this to :optional
(define (safe-first x) (and (not (null? x)) (car x)))
(define (safe-second x) (and (not (null? x)) (not (null? (cdr x))) (cadr x)))
(define (write-crlf port)
(write-string "\r\n" port)
(force-output port))
(define (dump fd)
(let loop ((c (read-char fd)))
(cond ((not (eof-object? c))
(write-char c)
(loop (read-char fd))))))
(define-syntax when
(syntax-rules ()
((when bool body1 body2 ...)
(if bool (begin body1 body2 ...)))))
(define-syntax unless
(syntax-rules ()
((unless bool body1 body2 ...)
(if (not bool) (begin body1 body2 ...)))))
;; EOF