(module scanner mzscheme
  
  (require (lib "contract.ss")
           (lib "url.ss" "net")
           (lib "list.ss"))
  
  (provide/contract 
   (scan (string? (listof natural-number?) . -> . (listof (list/p natural-number? string?)))))
  
  
  ;; ============================================================
  ;; SOME LIBRARY CODE
  ;; ============================================================
  
  (define-syntax (while stx)
    (syntax-case stx ()
      [(_ var test body)
       (identifier? #'var)
       #'(let loop ((var test))
           (when var body (loop test)))]))
  
  (define (threaded-map f l)
    (let ((cs (map (lambda (x) (make-channel)) l)))
      (for-each (lambda (x c) (thread (lambda () (channel-put c (f x))))) l cs)
      (map channel-get cs)))
  
  (define (range i j)
    (cond
      [(>= i j) '()]
      [else (cons i (range (+ i 1) j))]))
  
  ;; ============================================================
  ;; THE SCANNER
  ;; ============================================================
  
  ; scan : string[hostname] (listof int) -> listof (list int string)
  ; gives the number and well-known service name of each port in the given
  ; list that is open on the given host
  (define (scan host ports)
    (map (lambda (p) (list p (port->name p))) (open-ports host ports)))
  
  ; open-ports : string[hostname] (listof int) -> (listof int)
  (define (open-ports host ports)
    (filter (lambda (x) (not (eq? 'closed x)))
            (threaded-map
             (lambda (port) (if (can-connect? host port) port 'closed)) 
             ports)))
  
  ; can-connect? : string[url] number -> bool
  ; determines if the host is listening on the given port
  (define (can-connect? host port)
    (with-handlers ([exn:i/o:tcp? (lambda (e) #f)])
      (let-values ([(ip op) (tcp-connect host port)])
        (close-input-port ip) (close-output-port op) #t)))
  
  (define (port->name p) (hash-table-get NAMES p (lambda () "unknown")))
  
  (define NAMES
    (let ([ip (if (file-exists? "/etc/services")
                  (open-input-file "/etc/services")
                  (get-pure-port (string->url "http://www.iana.org/assignments/port-numbers")))]
          [nametable (make-hash-table)])
      (while m (regexp-match "([^ \t\r\n]*)[ \t]+([0-9]+)/tcp[ \t]+([^\r\n]*)" ip)
             (hash-table-put! nametable (string->number (list-ref m 2)) (list-ref m 1)))
      nametable)))