4 (require web-server/servlet)
5 (require web-server/servlet-env)
6 (require web-server/templates)
8 (require "blacklist.rkt")
10 (define (member-match? itm lst)
11 (ormap (lambda (i) (regexp-match? (regexp i) itm)) lst))
13 (define-values (dispatch generate-url)
16 [("search") do-search]
19 (define (do-head title)
20 (include-template "templates/head.html"))
23 (include-template "templates/footer.html"))
25 (define (do-index req)
26 (http-response (string-append
27 (do-head "Web Search")
28 (include-template "templates/index.html")
31 (define (search query pageno)
32 (define engine (string->url
34 (getenv "SEARX_INSTANCE")
35 "/search?format=json&q="
40 (define response (get-pure-port engine))
41 (define json-raw (port->string response))
42 (close-input-port response)
43 (with-input-from-string json-raw (lambda () (read-json))))
45 (define (http-response content)
53 (string->bytes/utf-8 content))))
55 (define (do-search req)
56 (define binds (request-bindings req))
57 (define query (if (exists-binding? 'q binds)
58 (extract-binding/single 'q binds)
61 (if (non-empty-string? query)
63 (define pageno (if (exists-binding? 'pageno binds)
64 (extract-binding/single 'pageno binds)
71 (url-host (string->url
72 (hash-ref i 'url ""))))
73 (define result-url (hash-ref i 'url ""))
74 (define result-title (hash-ref i 'title ""))
75 (define result-content (hash-ref i 'content ""))
76 (define ht (make-hash))
77 (unless (member-match? result-host blacklist)
79 (hash-set! ht "title" result-title)
80 (hash-set! ht "url" result-url)
81 (hash-set! ht "content" result-content)
85 (hash-ref (search query pageno) 'results)))))
86 (http-response (string-append
87 (do-head (string-append query " | Web Search"))
88 (include-template "templates/search.html")
92 (serve/servlet dispatch
94 #:servlet-regexp #rx""
95 #:extra-files-paths (list (build-path "./static"))
96 #:listen-ip "0.0.0.0")