PasteRack.org
Paste # 45829
2018-12-31 08:21:50

Fork as a new paste.

Paste viewed 410 times.


Embed:

Why I Like PLT Scheme by Jacob Matthews https://web.archive.org/web/20050205000754/http://www.kuro5hin.org/story/2004/3/17/93442/8657

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

=>