server.rkt

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