diff --git a/Makefile b/Makefile index 2b8c802..4a09791 100644 --- a/Makefile +++ b/Makefile @@ -14,7 +14,7 @@ endif ifndef FB_PASSWORD $(error "Provide FB_PASSWORD variable") endif - ./webcrawler $(FB_USERNAME) $(FB_PASSWORD) + ./webcrawler -d $(FB_USERNAME) $(FB_PASSWORD) .setup: raco pkg install smol-http/ diff --git a/webcrawler b/webcrawler index 44619ce..5da4d3a 100755 --- a/webcrawler +++ b/webcrawler @@ -7,16 +7,55 @@ ;; 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 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 "the credentials are: ~s ~s\n" 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)))