+;;; -*-lisp-*-
+;;;
+;;; System-specific functions
+;;;
+;;; (c) 2008 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:defpackage #:net-sys
+ (:use #:common-lisp)
+ (:export #:gethostname #:resolve-hostname #:canonify-hostname))
+(cl:in-package #:net-sys)
+
+;;;--------------------------------------------------------------------------
+;;; Functions provided.
+
+#+ecl
+(cffi:defcfun gethostname :int
+ (name :pointer)
+ (len :uint))
+
+(defun gethostname ()
+ "Return the hostname (not necessarily canonical) of the current host."
+
+ #+cmu
+ (unix:unix-gethostname)
+
+ #+sbcl
+ (sb-unix:unix-gethostname)
+
+ #+clisp
+ (unix:get-host-name)
+
+ #+ecl
+ (cffi:with-foreign-pointer-as-string (buffer 256 len)
+ (let ((rc (gethostname buffer len)))
+ (unless (zerop rc)
+ (error "gethostname(2) failed (rc = ~A)." rc))))
+
+ #-(or cmu sbcl clisp ecl)
+ "<unknown-host>")
+
+(defun resolve-hostname (name)
+ "Resolve a hostname to an IP address using the DNS, or return nil."
+
+ #+cmu
+ (let ((he (ext:lookup-host-entry name)))
+ (and he (ext:host-entry-addr he)))
+
+ #+sbcl
+ (handler-case
+ (let* ((he (sb-bsd-sockets:get-host-by-name name))
+ (addr (sb-bsd-sockets:host-ent-address he)))
+ (reduce (lambda (acc byte) (logior (ash acc 8) byte)) addr))
+ (sb-bsd-sockets:name-service-error () nil))
+
+ #+clisp
+ (let ((he (ext:resolve-host-ipaddr name)))
+ (and he (string-ipaddr (car (ext:hostent-addr-list he)))))
+
+ #+ecl
+ (nth-value 2 (ext:lookup-host-entry name))
+
+ #-(or cmu sbcl clisp ecl)
+ nil)
+
+(defun canonify-hostname (name)
+ "Resolve a hostname to canonical form using the DNS, or return nil."
+
+ #+cmu
+ (let ((he (ext:lookup-host-entry name)))
+ (and he (ext:host-entry-name he)))
+
+ #+sbcl
+ (handler-case
+ (let ((he (sb-bsd-sockets:get-host-by-name name)))
+ (sb-bsd-sockets:host-ent-name he))
+ (sb-bsd-sockets:name-service-error () nil))
+
+ #+clisp
+ (let ((he (ext:resolve-host-ipaddr name)))
+ (and he (ext:hostent-name he)))
+
+ #+ecl
+ (nth-value 0 (ext:lookup-host-entry name))
+
+ #-(or cmu sbcl clisp ecl)
+ name)
+
+;;;----- That's all, folks --------------------------------------------------