PasteRack.org
Paste # 48925
2018-12-31 08:02:32

Fork as a new paste.

Paste viewed 235 times.


Embed:

scanner.rkt

  1. #lang racket
  2. ;; Code from Why I Like PLT Scheme by Jacob Matthews
  3. ;; http://www.kuro5hin.org/story/2004/3/17/93442/8657
  4. ;; archived as https://web.archive.org/web/20050205000754/http://www.kuro5hin.org/story/2004/3/17/93442/8657
  5. ;; minor changes to port to Racket 7.1
  6. (module+ test
  7.   (require rackunit))
  8.  
  9.  
  10. ; scan : string[hostname] (listof int) -> listof (list int string)
  11. ; gives the number and well-known service name of each port in the given
  12. ; list that is open on the given host
  13. (define (scan host ports)
  14.   (map
  15.    (lambda (p) (list p (port->name p)))
  16.    (open-ports host ports)))
  17.  
  18. (define (range low high)
  19.   (cond
  20.     [(> low high) null]
  21.     [else (cons low (range (+ low 1) high))]))
  22.  
  23. (require racket/contract)
  24.  
  25. (provide/contract
  26.  (scan (string? (listof natural-number/c)
  27.                 . -> .
  28.                 (listof (list/c natural-number/c string?)))))
  29.  
  30. (require (lib "list.ss")) ; for filter
  31.  
  32. ; open-ports : string[hostname] (listof int) -> (listof int)
  33. ; returns the sublist of numbers that represent open ports on the
  34. ; given host, performing all checks concurrently
  35. (define (open-ports host ports)
  36.   (filter (lambda (x) (not (eq? 'closed x)))
  37.           (threaded-map
  38.            (lambda (port) (if (can-connect? host port) port 'closed))
  39.            ports)))
  40.  
  41. ; can-connect? : string[hostname] number -> bool
  42. ; determines if the host is listening on the given port
  43. (define (can-connect? host port)
  44.   (with-handlers ([exn:fail:network? (lambda (e) #f)])
  45.     (let-values ([(ip op) (tcp-connect host port)])
  46.       (close-input-port ip) (close-output-port op) #t) )
  47.   )
  48.  
  49. ; threaded-map : (X -> Y) * (listof X) -> (listof Y)
  50. ; maps the given function over the given list with each computation
  51. ; done in parallel
  52. (define (threaded-map f l)
  53.   (let ((cs (map (lambda (x) (make-channel)) l)))
  54.     (for-each (lambda (x c) (thread (lambda () (channel-put c (f x))))) l cs)
  55.     (map channel-get cs)))
  56.  
  57. (require  net/url) ; for get-pure-port and string->url
  58.  
  59. (define NAMES
  60.   (let ([ip (if (file-exists? "/etc/services")
  61.                 (open-input-file "/etc/services")
  62.                 (get-pure-port (string->url "http://www.iana.org/assignments/port-numbers")))]
  63.         [nametable (make-hash)])
  64.     (while m (regexp-match #px"([^ \n]+)[\\W]+([0-9]+)/tcp[ \t]+([^\r\n])" ip)
  65.            (hash-set! nametable (string->number (bytes->string/utf-8 (list-ref m 2))) (list-ref m 1)))
  66.     nametable))
  67.  
  68. (define (port->name p) (hash-ref! NAMES p (lambda () "unknown")))
  69.  
  70.  
  71. (define-syntax (while stx)
  72.   (syntax-case stx ()
  73.     [(_ var test body)
  74.      (identifier? #'var)
  75.      #'(let loop ((var test))
  76.          (when var body (loop test)))]))
  77.  
  78.  
  79. (module+ test
  80.   ;; Any code in this `test` submodule runs when this file is run using DrRacket
  81.   ;; or with `raco test`. The code here does not run when this file is
  82.   ;; required by another module.
  83.   (scan "racket-lang.org" (range 1 1000))
  84.  
  85.  
  86.   )
  87.  
  88. (module+ main
  89.   ;; (Optional) main submodule. Put code here if you need it to be executed when
  90.   ;; this file is run using DrRacket or the `racket` executable.  The code here
  91.   ;; does not run when this file is required by another module. Documentation:
  92.   ;; http://docs.racket-lang.org/guide/Module_Syntax.html#%28part._main-and-test%29
  93.  
  94.  
  95.   )

=>