🏄 Experimental Racket module I wrote to do some HTTPS tesing..

SilverSurfer-HTTPS.rkt

#lang racket

(require racket/base)
(require racket/date)
(require racket/match)
(require racket/vector)
(require net/http-client)

(date-display-format 'rfc2822)

(define-values (stdin stdout stderr) (values (current-input-port) (current-output-port) (current-error-port))
)

(define-values (word-size sys-type) (values (system-type 'word) (system-type 'os)))
(define-values (register-width os-type) (values word-size sys-type))
(define-values (word-size-str sys-type-str)
  (values (number->string word-size)
          (cond
      [(eq? sys-type 'macosx) "Apple Mac OSX"]
      [(eq? sys-type 'windows) "Microsoft Windows"]
      [(eq? sys-type 'linux) "Linux"])))

(newline stderr)
(display (string-append "*** " (banner)) stderr)
(displayln (string-append "*** Today is " (date->string (seconds->date (current-seconds)))) stderr)
(displayln (string-append "*** Platform is " word-size-str "-bit " sys-type-str) stderr)
(newline stderr)

;(define Host (vector "Host" "127.0.0.1" "localhost" "0.0.0.0"))
(define Host (vector "www.google.com"))
(define User-Agent (vector "User-Agent" "MSIE" "Edge" "Mozilla FireFox"))
(define Connection (vector "Connection" "Close"))

(define (vector-car v) (vector-ref v 0))
(define (vector-cdr v) (vector-drop v 1))
(define-values (vector-first vector-rest) (values vector-car vector-cdr))
;(define-values (vector-first vector-rest) (values vector-car vector-cdr))

#|(define-values (vector-first vector-rest)
                      (define-syntax vector-first
                       (syntax-rules () ([(vector-first av) (vector-car av)])))
                      (define-syntax vector-rest
                       (syntax-rules () ([(vector-rest av) (vector-cdr av)]))))|#

#|(define-syntax (vector-rest
  (syntax-rules ()
    ([(vector-rest av) (vector-cdr av)])))|#
    (displayln (string-append "*** Today is " (date->string (seconds->date (current-seconds)))) stderr)
(displayln (string-append "*** Platform is " word-size-str "-bit " sys-type-str) stderr)
(newline stderr)

;(define Host (vector "Host" "127.0.0.1" "localhost" "0.0.0.0"))
(define Host (vector "www.google.com"))
(define User-Agent (vector "User-Agent" "MSIE" "Edge" "Mozilla FireFox"))
(define Connection (vector "Connection" "Close"))

(define (vector-car v) (vector-ref v 0))
(define (vector-cdr v) (vector-drop v 1))
(define-values (vector-first vector-rest) (values vector-car vector-cdr))
;(define-values (vector-first vector-rest) (values vector-car vector-cdr))

#|(define-values (vector-first vector-rest)
                      (define-syntax vector-first
                       (syntax-rules () ([(vector-first av) (vector-car av)])))
                      (define-syntax vector-rest
                       (syntax-rules () ([(vector-rest av) (vector-cdr av)]))))|#

#|(define-syntax (vector-rest
  (syntax-rules ()
    ([(vector-rest av) (vector-cdr av)])))|#
    (define PHP-credits-guid "?=PHPB8B5F2A0-3C92-11d3-A3A9-4C7B08C10000")
(define PHP-query-strs (vector PHP-logo-guid PHP-egg-logo-guid PHP-zend-logo-guid PHP-credits-guid))

(define (http-headers avec)
  (random-seed (current-seconds))
  (define (http-headers-rand rrest)
    (random-seed (current-seconds))
    (vector-ref rrest (random (vector-length rrest))))
  (define (http-headers-help amemb arest)
    (random-seed (current-seconds))
    (string-append amemb ": " (http-headers-rand arest)))
  (random-seed (current-seconds))
  (http-headers-help (vector-car avec) (vector-cdr avec)))

(define http-version-edge-cases-vector (vector "-9.-9" "+9.9" "0.0" "0" "-1"))
(define http-version-one-pt-zero "1.0")
(define http-version-one-pt-one  "1.1")
(define http-version-one-vector (vector http-version-one-pt-zero http-version-one-pt-one))
(define http-version-zero-pt-nine "0.9")
(define http-version-two-pt-zero "2.0")
(define http-version-near-one-vector (vector
                                      http-version-zero-pt-nine
                                      http-version-one-pt-zero
                                      http-version-one-pt-one))
                                      (define http-version-all-vals-vector (vector-append
                                      (vector http-version-two-pt-zero)
                                      http-version-edge-cases-vector
                                      http-version-near-one-vector))

(define http-version-vector http-version-one-vector)
(define prev-ms (current-milliseconds))

(define-values (status headers in)
  (let ([xheaders (vector (http-headers Host) (http-headers User-Agent) (http-headers Connection))]
        [xversion (vector-ref http-version-vector (random (vector-length http-version-vector)))]
        [xmethod "GET"]
        [xpath "/"]
        [xhost "www.google.com"])
    (displayln (vector->list xheaders) stderr)
    (displayln (vector-car xversion) stderr)
    (newline stderr)
    (http-sendrecv xhost
      xpath
      #:ssl? #t
      #:version (vector-car xversion)
      #:method xmethod
      #:headers (vector->list xheaders))))
            #:ssl? #t
      #:version (vector-car xversion)
      #:method xmethod
      #:headers (vector->list xheaders))))

(define adoc (map (λ (l) (begin (displayln l) l))
                  (string-split (string-normalize-spaces (port->string in)) "\r\n")))

(let ([remp (regexp-match-positions #rx"Set-Cookie:" (car adoc))])
  (newline stderr)
  (if (false? remp)
    (displayln "*** No Cookie response header!" stderr)
    (displayln remp stderr)))

(displayln (status) stderr)
(newline stderr)
(displayln (headers) stderr)

;;; TODO: Output this debugging info to stderr
(letrec
    ([curr-ms (current-milliseconds)] [diff-ms (- curr-ms prev-ms)])
        (displayln (string-append "*** Milliseconds: " (number->string diff-ms)) stderr)
        (newline stderr))