Add debug mode and cookie jar
This commit is contained in:
parent
17b45eb020
commit
47e830154c
2
Makefile
2
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/
|
||||
|
|
41
webcrawler
41
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)))
|
||||
|
|
Loading…
Reference in New Issue