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     [("index") do-index]
  18     [("search") do-search]
  19     ))
  20
  21 (define (do-index req)
  22       (http-response (include-template "index.html")))
  23
  24 (define (search query)
  25   (define engine (string->url
  26                    (string-append
  27                      "https://search.trom.tf/search?format=json&q=" query)))
  28   (define response (get-pure-port engine))
  29   (define json-raw (port->string response))
  30   (close-input-port response)
  31   (with-input-from-string json-raw (lambda () (read-json))))
  32
  33 (define (http-response content)  ; The 'content' parameter should be a string.
  34   (response/full
  35     200                  ; HTTP response code.
  36     #"OK"                ; HTTP response message.
  37     (current-seconds)    ; Timestamp.
  38     TEXT/HTML-MIME-TYPE  ; MIME type for content.
  39     '()                  ; Additional HTTP headers.
  40     (list                ; Content (in bytes) to send to the browser.
  41       (string->bytes/utf-8 content))))
  42
  43 (define (do-search req)
  44   (define binds (request-bindings req))
  45   (define query (if (exists-binding? 'q binds)
  46                   (extract-binding/single 'q binds)
  47                   ""))
  48
  49   (if (non-empty-string? query)
  50     (let ()
  51       (define results
  52         (foldr cons '()
  53                (filter hash?
  54                (map (lambda (i)
  55                       (define result-host
  56                         (url-host (string->url
  57                                     (hash-ref i 'url ""))))
  58                           (define result-url (hash-ref i 'url ""))
  59                           (define result-title (hash-ref i 'title ""))
  60                           (define result-content (hash-ref i 'content ""))
  61                         (define ht (make-hash))
  62                         (unless (member-match? result-host blacklist)
  63                           (let ()
  64                             (hash-set! ht "title" result-title)
  65                             (hash-set! ht "url" result-url)
  66                             (hash-set! ht "content" result-content)
  67                             )
  68                           ht
  69                       ))
  70                     (hash-ref (search query) 'results)))))
  71       (http-response (include-template "search.html")))
  72     (do-index req)))
  73
  74 (serve/servlet dispatch
  75                #:command-line? #t
  76                #:servlet-regexp #rx""
  77                #:extra-files-paths (list (build-path "./static")))