PasteRack.org
Paste # 84606
2018-12-31 08:27:30

Fork as a new paste.

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

=>