server.rkt

   1 #lang racket
   2
   3 (require json)
   4 (require net/url)
   5 (require web-server/formlets)
   6 (require web-server/servlet)
   7 (require web-server/servlet-env)
   8 (require web-server/templates)
   9
  10 (require "blacklist.rkt")
  11
  12 (define (member-match? itm lst)
  13   (ormap (lambda (i) (regexp-match? (regexp i) itm)) lst))
  14
  15 (define-values (dispatch generate-url)
  16   (dispatch-rules
  17     [("") do-index]
  18     [("search") do-search]
  19     ))
  20
  21 (define (do-head title)
  22   (include-template "templates/head.html"))
  23
  24 (define (do-footer)
  25   (include-template "templates/footer.html"))
  26
  27 (define (do-index req)
  28   (http-response (string-append
  29                    (do-head "Web Search")
  30                    (include-template "templates/index.html")
  31                    (do-footer))))
  32
  33 (define (search query pageno)
  34   (define engine (string->url
  35                    (string-append
  36                        "https://search.trom.tf/search?format=json&q="
  37                        query
  38                        "&pageno="
  39                        pageno
  40                        )))
  41   (define response (get-pure-port engine))
  42   (define json-raw (port->string response))
  43   (close-input-port response)
  44   (with-input-from-string json-raw (lambda () (read-json))))
  45
  46 (define (http-response content)
  47   (response/full
  48     200
  49     #"OK"
  50     (current-seconds)
  51     TEXT/HTML-MIME-TYPE
  52     '()
  53     (list
  54       (string->bytes/utf-8 content))))
  55
  56 (define (do-search req)
  57   (define binds (request-bindings req))
  58   (define query (if (exists-binding? 'q binds)
  59                   (extract-binding/single 'q binds)
  60                   ""))
  61
  62   (if (non-empty-string? query)
  63     (let ()
  64       (define pageno (if (exists-binding? 'pageno binds)
  65                        (extract-binding/single 'pageno binds)
  66                        "1"))
  67       (define results
  68         (foldr cons '()
  69                (filter hash?
  70                (map (lambda (i)
  71                       (define result-host
  72                         (url-host (string->url
  73                                     (hash-ref i 'url ""))))
  74                           (define result-url (hash-ref i 'url ""))
  75                           (define result-title (hash-ref i 'title ""))
  76                           (define result-content (hash-ref i 'content ""))
  77                         (define ht (make-hash))
  78                         (unless (member-match? result-host blacklist)
  79                           (let ()
  80                             (hash-set! ht "title" result-title)
  81                             (hash-set! ht "url" result-url)
  82                             (hash-set! ht "content" result-content)
  83                             )
  84                           ht
  85                       ))
  86                     (hash-ref (search query pageno) 'results)))))
  87       (http-response (string-append
  88                        (do-head (string-append query " | Web Search"))
  89                        (include-template "templates/search.html")
  90                        (do-footer))))
  91     (redirect-to "/")))
  92
  93 (serve/servlet dispatch
  94                #:command-line? #t
  95                #:servlet-regexp #rx""
  96                #:extra-files-paths (list (build-path "./static")))