Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
#lang racket
;;;
;;; Author: Bahman Movaqar <Bahman AT BahmanM.com>
;;;
(require net/url)
(require sxml)
(require net/uri-codec)
(require net/http-client)
(require (planet neil/html-parsing))
(require net/cookies)
;;;
(define LOGIN-ERR-MSG
"you entered an invalid email address and password combination")
(define XPATH-LOGIN-ERR "//div[contains(@class, 'error')][contains(., '~a')]")
(define XPATH-FORM-BUILD-ID
"//input[@type='hidden'][substring(@id, 1, 4)='form'][substring(@value, 1, 4)='form']//@value")
(define XPATH-BOOK-URL "//a[contains(@class, 'twelve-days-claim')]//@href")
(current-cookie-jar (new list-cookie-jar%))
;;;
(define (login-params form-build-id)
(alist->form-urlencoded
(list (cons 'email "YOUR-EMAIL-ADDRESS")
(cons 'password "YOUR-PASSWORD")
(cons 'op "Login")
(cons 'form_id "packt_user_login_form")
(cons 'form_build_id form-build-id))))
;;;
(define (url->xexp a-url)
(html->xexp (call/input-url
a-url
get-pure-port
(λ (in-port) (port->string in-port)))))
;;;
(define (req-with-cookies conn uri method data headers url)
(http-conn-send! conn uri #:method method #:data data #:headers headers)
(let-values ([(status-line header-list inport) (http-conn-recv! conn)])
(extract-and-save-cookies! header-list url)
inport))
;;;
(define (login-to-packt form-build-id fl-url)
(let* [(in-port (req-with-cookies
(http-conn-open "www.packtpub.com" #:ssl? #t)
"/packt/offers/free-learning"
#"POST"
(login-params form-build-id)
`("Content-Type: application/x-www-form-urlencoded")
fl-url))
(html-doc (html->xexp (port->string in-port)))
(error-xpath (format XPATH-LOGIN-ERR LOGIN-ERR-MSG))
(login-success? (equal? '() ((txpath error-xpath) html-doc)))]
(if login-success? #t (error "Login failed"))))
;;;
(define (claim-the-book book-uri fl-url)
(req-with-cookies (http-conn-open "www.packtpub.com" #:ssl? #t)
book-uri
#"GET"
#""
`(,(format "Cookie: ~a" (cookie-header fl-url)))
fl-url))
;;;
(let* [(fl-url (string->url "https://www.packtpub.com/packt/offers/free-learning"))
(html-doc (url->xexp fl-url))
(form-build-id (second (car ((txpath XPATH-FORM-BUILD-ID) html-doc))))
(book-uri (second (car ((txpath XPATH-BOOK-URL) html-doc))))]
(login-to-packt form-build-id fl-url)
(claim-the-book book-uri fl-url)
(println "Book is claimed."))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment