diff --git a/cgi-server.scm b/cgi-server.scm index ecaffec..a107216 100644 --- a/cgi-server.scm +++ b/cgi-server.scm @@ -188,7 +188,7 @@ ("PATH_TRANSLATED" . ,path-translated) ("SCRIPT_NAME" . ,script-name) - ("REMOTE_HOST" . ,(host-info:name (host-info raddr))) + ("REMOTE_HOST" . ,(host-name-or-empty raddr)) ("REMOTE_ADDR" . ,(format-internet-host-address rhost)) ;; ("AUTH_TYPE" . xx) ; Random authentication diff --git a/httpd-core.scm b/httpd-core.scm index 833b961..d75a608 100644 --- a/httpd-core.scm +++ b/httpd-core.scm @@ -180,11 +180,10 @@ (let ((line (read-crlf-line))) ;; Blat out some logging info. - - (if *http-log?* - (let* ((addr (socket-remote-address sock)) - (host (host-info:name (host-info addr)))) - (http-log "~a: ~a~%" host line))) + (if *http-log?* + (let* ((addr (socket-remote-address sock)) + (host (host-name-or-empty addr))) + (http-log "~a: ~a~%" host line))) (if (eof-object? line) (fatal-syntax-error "EOF while parsing request.") diff --git a/modules.scm b/modules.scm index 8240879..6fbb0eb 100644 --- a/modules.scm +++ b/modules.scm @@ -281,6 +281,7 @@ uri url formats + sunet-utilities scheme) (files httpd-core)) @@ -328,6 +329,7 @@ scsh ; syscalls formats ; format format-net ; FORMAT-INTERNET-HOST-ADDRESS + sunet-utilities ; host-name-or-empty scheme) (files cgi-server)) @@ -682,3 +684,14 @@ (define (eval-safely exp) (ignore-errors (lambda () (eval exp (new-safe-package))))))) + +(define-structure sunet-utilities (export host-name-or-empty) + (open scsh + scheme + handle-fatal-error) + (begin + (define (host-name-or-empty addr) + (with-fatal-error-handler + (lambda (condition more) + "") + (host-info:name (host-info addr))))))