suzanne.soy/pasterack
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

replace global redis connection; restructure tmp files

Browse Source 
- replace global redis connection with finer grain connect/disconnects
- compile pastes in tmp/<pastenum>/ so image-generating evals dont clash

closes #22
This commit is contained in:
Stephen Chang 2013-10-08 00:30:17 -04:00
parent e02b99ccd1
commit 40e99765c0
1 changed files with 78 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
pasterack.rkt
View File

@ -3,12 +3,13 @@
(require web-server/servlet web-server/dispatch) (require web-server/servlet web-server/dispatch)
(require xml xml/path) (require xml xml/path)
(require racket/system racket/runtime-path) (require racket/system racket/runtime-path)
(require redis data/ring-buffer) (require (rename-in (prefix-in re: redis)
[re:with-redis-connection with-redis-connection]
[re:bytes->symbol bytes->symbol])
data/ring-buffer)
(require "pasterack-utils.rkt") (require "pasterack-utils.rkt")
(provide/contract (start (request? . -> . response?))) (provide/contract (start (request? . -> . response?)))
(current-redis-connection (connect))
(define-runtime-path htdocs-dir "htdocs") (define-runtime-path htdocs-dir "htdocs")
(define-runtime-path here ".") (define-runtime-path here ".")
(define-runtime-path tmp-dir "tmp") (define-runtime-path tmp-dir "tmp")
@ -24,7 +25,8 @@
(define (mk-link url txt) `(a ((href ,url)) ,txt)) (define (mk-link url txt) `(a ((href ,url)) ,txt))
(define (fresh-str) (define (fresh-str)
(let loop () (define str (mk-rand-str)) (if (EXISTS str) (loop) str))) (with-redis-connection
(let loop () (define str (mk-rand-str)) (if (re:EXISTS str) (loop) str))))
(define sample-pastes (define sample-pastes
'("4474" ; Sierpinski '("4474" ; Sierpinski
@ -48,10 +50,11 @@
; "5752" ; bs ipsum (as text) ; "5752" ; bs ipsum (as text)
)) ))
(define sample-pastes-htmls (define sample-pastes-htmls
(with-redis-connection
(for/list ([pnum sample-pastes]) (for/list ([pnum sample-pastes])
(define name (HGET/str pnum 'name)) (define name (re:HGET/str pnum 'name))
`(tr (td ,(mk-link (mk-paste-url pnum) pnum)) `(tr (td ,(mk-link (mk-paste-url pnum) pnum))
(td ((style "width:1px"))) (td ,name)))) (td ((style "width:1px"))) (td ,name)))))
(define NUM-RECENT-PASTES 16) (define NUM-RECENT-PASTES 16)
(define recent-pastes (empty-ring-buffer NUM-RECENT-PASTES)) (define recent-pastes (empty-ring-buffer NUM-RECENT-PASTES))
@ -84,9 +87,8 @@
"define default-continuation-prompt-tag")) "define default-continuation-prompt-tag"))
;; returns generated pastenum ;; returns generated pastenum
(define (write-codeblock-scrbl-file code pastenum) (define (write-codeblock-scrbl-file code pnum)
; (define tmp-name (mk-rand-str)) (define tmp-scrbl-file (build-path tmp-dir pnum (++ pnum "code.scrbl")))
(define tmp-scrbl-file (build-path tmp-dir (++ pastenum "code.scrbl")))
(define-values (lang code-no-lang) (hashlang-split code)) (define-values (lang code-no-lang) (hashlang-split code))
(define lang-lst (define lang-lst
(cond [(scribble-lang? lang) (list "racket" lang)] (cond [(scribble-lang? lang) (list "racket" lang)]
@ -112,12 +114,10 @@
code)) code))
#:mode 'text #:mode 'text
#:exists 'replace)) #:exists 'replace))
; tmp-name) (define (write-eval-scrbl-file code pnum)
(define (write-eval-scrbl-file code pastenum)
; parse out #lang if it's there, otherwise use racket ; parse out #lang if it's there, otherwise use racket
(define-values (lang code-no-lang) (hashlang-split code)) (define-values (lang code-no-lang) (hashlang-split code))
; (define tmp-name (mk-rand-str)) (define tmp-scrbl-file (build-path tmp-dir pnum (++ pnum "eval.scrbl")))
(define tmp-scrbl-file (build-path tmp-dir (++ pastenum "eval.scrbl")))
(with-output-to-file tmp-scrbl-file (with-output-to-file tmp-scrbl-file
(lambda () (lambda ()
(printf (printf
@ -144,32 +144,49 @@
code-no-lang)) code-no-lang))
#:mode 'text #:mode 'text
#:exists 'replace)) #:exists 'replace))
; tmp-name)
(define (compile-scrbl-file/get-html name) (define (compile-scrbl-file/get-html pnum)
(define err (open-output-file (build-path tmp-dir (++ name ".err")))) (define new-tmpdir (build-path tmp-dir pnum))
(and (define err (open-output-file (build-path new-tmpdir (++ pnum "code.err"))))
(parameterize ([current-error-port err]) (define scrbl-file (build-path new-tmpdir (++ pnum "code.scrbl")))
(begin0 (define html-file (build-path new-tmpdir (++ pnum "code.html")))
(system (++ "/home/stchang/pltpkg/racket/bin/scribble --html +m " (and (parameterize ([current-error-port err])
"--redirect-main " racket-docs-url " " (begin0 (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html "
"--dest " (path->string tmp-dir) " " "+m --redirect-main " racket-docs-url " "
(path->string (build-path tmp-dir (++ name ".scrbl"))))) "--dest " (path->string new-tmpdir) " "
(path->string scrbl-file)))
(close-output-port err))) (close-output-port err)))
(with-input-from-file (build-path tmp-dir (++ name ".html")) port->bytes))) (with-input-from-file html-file port->bytes)))
(define (compile-eval-scrbl-file/get-html name) (define (compile-eval-scrbl-file/get-html pnum)
(and (define new-tmpdir (build-path tmp-dir pnum))
(system (++ "/home/stchang/pltpkg/racket/bin/scribble --html " (define scrbl-file (build-path new-tmpdir (++ pnum "eval.scrbl")))
"--dest " (path->string tmp-dir) " " (define html-file (build-path new-tmpdir (++ pnum "eval.html")))
(path->string (build-path tmp-dir (++ name ".scrbl"))))) (and (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html "
(with-input-from-file (build-path tmp-dir (++ name ".html")) port->bytes))) "--dest " (path->string new-tmpdir) " "
(path->string scrbl-file)))
(with-input-from-file html-file port->bytes)))
;; files/directories layout ---------------------------------------------------
;; web-server files are in htdocs/
;; each paste creates a directory tmp/<pastenum>
;; - scrbl for code is tmp/<pastenum>/<pastenum>code.scrbl
;; - compiled code is tmp/<pastenum>/<pastenum>code.html
;; -- if code scrbl file couldn't be compiled, then error is in
;; tmp/<pastenum>/<pastenum>code.err
;; - scrbl for eval is tmp/<pastenum>/<pastenum>eval.scrbl
;; - compiled eval is tmp/<pastenum>/<pastenum>eval.html
;; -- if eval results in 1 pict: tmp/<pastenum>/pict.png
;; -- if eval results in n picts: tmp/<pastenum>/pict_1.png through pict_n.png
(define (generate-paste-html code pastenum) (define (generate-paste-html code pastenum)
(define paste-dir (build-path tmp-dir pastenum))
(unless (directory-exists? paste-dir) (make-directory paste-dir))
(write-codeblock-scrbl-file code pastenum) (write-codeblock-scrbl-file code pastenum)
(compile-scrbl-file/get-html (++ pastenum "code"))) (compile-scrbl-file/get-html pastenum))
(define (generate-eval-html code pastenum) (define (generate-eval-html code pastenum)
;; should check that tmp/pastenum dir exists here
(write-eval-scrbl-file code pastenum) (write-eval-scrbl-file code pastenum)
(compile-eval-scrbl-file/get-html (++ pastenum "eval"))) (compile-eval-scrbl-file/get-html pastenum))
(define google-analytics-script (define google-analytics-script
(++ "var _gaq = _gaq || [];\n" (++ "var _gaq = _gaq || [];\n"
@ -233,17 +250,18 @@
(div ((style ,(~~ "position:absolute;left:1em;top:2em" (div ((style ,(~~ "position:absolute;left:1em;top:2em"
"width:12em" "width:12em"
"font-size:95%"))) "font-size:95%")))
(h4 "Total pastes: " ,(number->string (DBSIZE))) (h4 "Total pastes: " ,(number->string (re:DBSIZE)))
(h4 "Sample pastes:") (h4 "Sample pastes:")
(table ((style "margin-top:-15px;font-size:95%")) (table ((style "margin-top:-15px;font-size:95%"))
,@sample-pastes-htmls) ,@sample-pastes-htmls)
(h4 "Recent pastes:") (h4 "Recent pastes:")
(table ((style "margin-top:-15px;font-size:95%")) ,(with-redis-connection
`(table ((style "margin-top:-15px;font-size:95%"))
,@(reverse ,@(reverse
(for/list ([pnum recent-pastes] #:when pnum) (for/list ([pnum recent-pastes] #:when pnum)
(define name (bytes->string/utf-8 (HGET pnum 'name))) (define name (re:HGET/str pnum 'name))
`(tr (td ,(mk-link (mk-paste-url pnum) pnum)) `(tr (td ,(mk-link (mk-paste-url pnum) pnum))
(td ((style "width:1px"))) (td ,name)))))) (td ((style "width:1px"))) (td ,name)))))))
;; middle ------------------------------------------------------------ ;; middle ------------------------------------------------------------
(div ((style ,(~~ "position:absolute;left:14em;top:2em"))) (div ((style ,(~~ "position:absolute;left:14em;top:2em")))
(center (center
@ -313,11 +331,11 @@
;; unless as-text was explicitly checked ;; unless as-text was explicitly checked
(if (exists-binding? 'astext bs) #f (if (exists-binding? 'astext bs) #f
(with-input-from-file (with-input-from-file
(build-path tmp-dir (++ paste-num "code.err")) (build-path tmp-dir paste-num (++ paste-num "code.err"))
port->string)))) port->string))))
(define paste-url (mk-paste-url paste-num)) (define paste-url (mk-paste-url paste-num))
(ring-buffer-push! recent-pastes paste-num) (ring-buffer-push! recent-pastes paste-num)
(SET/hash paste-num (hash 'name paste-name (re:SET/hash paste-num (hash 'name paste-name
'code pasted-code 'code pasted-code
'code-html paste-html-str 'code-html paste-html-str
'eval-html (or eval-html-str "") 'eval-html (or eval-html-str "")
@ -354,8 +372,10 @@
[href "http://pasterack.org/racket.css"]))) [href "http://pasterack.org/racket.css"])))
(define (serve-paste request pastenum) (define (serve-paste request pastenum)
(when (HEXISTS pastenum 'views) (HINCRBY pastenum 'views 1)) (define retrieved-paste-hash
(define retrieved-paste-hash (GET/hash pastenum #:map-key bytes->symbol)) (with-redis-connection
(when (re:HEXISTS pastenum 'views) (re:HINCRBY pastenum 'views 1))
(re:GET/hash pastenum #:map-key bytes->symbol)))
(cond (cond
[(equal? (hash) retrieved-paste-hash) [(equal? (hash) retrieved-paste-hash)
(response/xexpr (response/xexpr
@ -441,8 +461,10 @@
(match-define (list _ base offset) rxmatch) (match-define (list _ base offset) rxmatch)
(define new-file (define new-file
(++ pastenum (if offset (++ "_" offset) "") ".png")) (++ pastenum (if offset (++ "_" offset) "") ".png"))
(define curr-file-path (build-path tmp-dir filename)) (define curr-file-path
(define new-file-path (build-path tmp-dir new-file)) (build-path tmp-dir pastenum filename))
(define new-file-path
(build-path htdocs-dir new-file))
(unless (file-exists? new-file-path) (unless (file-exists? new-file-path)
(copy-file curr-file-path new-file-path) (copy-file curr-file-path new-file-path)
(delete-file curr-file-path)) (delete-file curr-file-path))
@ -534,6 +556,6 @@
#:quit? #f #:quit? #f
#:listen-ip #f #:listen-ip #f
#:port 8000 #:port 8000
#:extra-files-paths (list htdocs-dir tmp-dir) #:extra-files-paths (list htdocs-dir)
#:servlet-path "/" #:servlet-path "/"
#:servlet-regexp #rx".*") #:servlet-regexp #rx".*")