CS3700-project4/webcrawler

#!/usr/bin/env racket
#lang racket
; vim: ft=racket
(require xml)
(require smol-http)

;; scheme is bad and it should feel bad
(define member? member)

(define DEFAULT-HDRS '((user-agent . "🦈 hash-lang-uwu crawler v1.0")
                       ;; christo pls do not track thanks
                       (dnt . "1")))

(struct cj [jar cache sema] #:transparent)
(define (make-cookie-jar)
  (cj (make-hash) (box (cons 'cookie "")) (make-semaphore 1)))
(define (update-cookie-jar! jar hdrs)
  (call-with-semaphore
    (cj-sema jar)
    (lambda ()
      (for ([hdr (in-list hdrs)])
        (when (symbol=? 'set-cookie (car hdr))
          (define kv (string-trim (first (string-split (cdr hdr) ";"))))
          (match-define (list k v) (string-split kv "="))
          (hash-set! (cj-jar jar) k v)))
      (set-box!
        (cj-cache jar)
        (cons 'cookie
              (string-join
                (for/list ([(k v) (in-hash jar)])
                  (format "~a=~a" k v)) "; "))))))
(define (cookie-jar->header jar)
  (call-with-semaphore (cj-sema jar) (curry unbox (cj-cache jar))))

(define test-data
  (xml->xexpr
    (document-element
      (read-xml (open-input-string
                  "<doc><bold>hi<h2 class='secret_flag' style='color:red'>FLAG: 64-characters-of-random-alphanumerics</h2></bold> there!</doc>")))))

(define (find-flag xexpr)
  (match xexpr
    [(list _ (? (curry member? '(class "secret_flag"))) str)
     str]
    [(list tag params rst ...)
     (ormap find-flag rst)]
    [_ #f]))

(find-flag test-data)


(define debug-mode? (make-parameter #f))
(define current-cookie-jar (make-parameter (make-cookie-jar)))

(define (printf-debug . args)
  (when (debug-mode?) (apply printf args)))

(define (print-progress total-pages in-flight crawled-pages num-flags)
  (when (debug-mode?)
    (printf "\r\x1b[KStatus: ~a/~a (~a in flight) | Flags: ~a"
            crawled-pages total-pages in-flight num-flags)
    (flush-output (current-output-port))))

(define (print-complete)
  (when (debug-mode?)
    (printf "\r\x1b[KCrawl complete\n")))

(define req
  (make-http-req 'GET "/hello-world" DEFAULT-HDRS))

(define (run-webcrawler username password)
  (printf-debug "the credentials are: ~s ~s\n" username password)
  (write-http-msg req))

(module+ main
  (command-line
    #:program "webcrawler"
    #:once-each
    [("-d") "Debug mode" (debug-mode? #t)]
    #:args
    (username password)
    (run-webcrawler username password)))