;; ecm-utilities.scm -- Utility procedures for ecm-net code ;; ;; $Id: ecm-utilities.scm,v 1.3 2001/12/18 18:08:08 interp Exp $ ;; ;; Please send suggestions and bug reports to ;; 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? (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