#lang racket/base
;; For legal info, see file "info.rkt".

(require racket/system
         (planet neil/mcfly))

(doc (section "Introduction")

     (para "This small package permits determining the hostname in Racket
programs.  It does not support multiple names, nor does it distinguish between
network interfaces.")
     
     (para "This package currently relies on the "
           (filepath "/bin/hostname")
           " program, available on various Unix-like systems, like GNU/Linux
and Mac OS X."))

(doc (section "Interface"))

(define %hostname:null-input-port
  ;; Note: "%hostname:null-input-port" was taken from an example in Racket 5.3 documentation.
  (make-input-port 'null
                   (lambda (s) eof)
                   (lambda (skip s progress-evt) eof)
                   void
                   (lambda () never-evt)
                   (lambda (k progress-evt done-evt)
                     (error "no successful peeks!"))))

(define (%hostname:system*/string #:error-name    error-name
                                  #:use-exn?      use-exn?
                                  #:trim-newline? trim-newline?
                                  #:command       command
                                  #:args          args)
  (let* ((stdout-os  (open-output-string))
         (stderr-os  (open-output-string))
         (ok?        (parameterize ((current-output-port stdout-os)
                                    (current-error-port  stderr-os)
                                    (current-input-port  %hostname:null-input-port))
                       (apply system* command args)))
         (stdout-str (get-output-string stdout-os))
         (stderr-str (get-output-string stderr-os)))
    (if ok?
        (if (equal? "" stderr-str)
            (if trim-newline?
                (regexp-replace #rx"\r?\n$" stdout-str "")
                stdout-str)
            (if use-exn?
                (error error-name
                       "shell command ~S had stderr ~S and stdout ~S"
                       (cons command args)
                       stderr-str
                       stdout-str)
                #f))
        (if use-exn?
            (error error-name
                   "shell command ~S failed with stderr ~S and stdout ~S"
                   (cons command args)
                   stderr-str
                   stdout-str)
            #f))))

(doc (defproc (get-full-hostname)
         (or/c #f string?)
       (para "Gets the full hostname (aka, fully-qualified domain name, or FQDN) of the host, or "
             (racket #f)
             " if unknown.")
       (racketinput (get-full-hostname)
                    #,(racketresult "computer.lan"))))
(provide get-full-hostname)
(define (get-full-hostname)
  (or (getenv "HOSTNAME")
      (%hostname:system*/string #:error-name    'get-full-hostname
                                #:use-exn?      #f
                                #:trim-newline? #t
                                #:command       "/bin/hostname"
                                #:args          '("-f"))
      (%hostname:system*/string #:error-name    'get-short-hostname
                                #:use-exn?      #f
                                #:trim-newline? #t
                                #:command       "hostname"
                                #:args          '("-f"))))

(doc (defproc (get-short-hostname)
         (or/c #f string?)
       (para "Gets the short hostname (i.e., just the hostname of the immediate host, not qualified with any parent domain names), or "
             (racket #f)
             " if unknown.")
       (racketinput (get-short-hostname)
                    #,(racketresult "computer"))))
(provide get-short-hostname)
(define (get-short-hostname)
  ;; TODO: Possibly use (getenv "HOSTNAME") when available, and check whether it has any dots in it.
  (or (%hostname:system*/string #:error-name    'get-short-hostname
                                #:use-exn?      #f
                                #:trim-newline? #t
                                #:command       "/bin/hostname"
                                #:args          '("-s"))
      (%hostname:system*/string #:error-name    'get-short-hostname
                                #:use-exn?      #f
                                #:trim-newline? #t
                                #:command       "hostname"
                                #:args          '())))

(doc history
     
     (#:planet 1:0 #:date "2012-09-29"
               (itemlist
                
                (item "Initial release."))))