Add to show the raw url after paste.

Li Ian-Xue (b4283)Thu Sep 30 19:39:46+0300 2021

29c6af5

Add to show the raw url after paste. This allows pasting through curl using command line like this: `curl -F "text=<helloworld.cs" -F showUrl=1 http://localhost:8080/post` Also refactoring the URI handler to somewhat sanitize it...? I don't know. I had to at least hard code the 'http URI scheme in my code.

pastebin/httpserver.scm

5757 
          (meta (@ (name "viewport") (content "width=device-width, initial-scale=1"))))
5858 
         (body ,@body)))
5959 
60-
(define (make-raw-link-pb-entry pb-id)
61-
  `(a (@ (href ,(format #f "/raw/~a" pb-id))) "raw"))
60+
(define (post-handler request request-body pb-data-path)
61+
  (if (eq? (request-method request) 'POST)
62+
      (let* ((headers (request-headers request))
63+
             (content-type-all (assq-ref headers 'content-type))
64+
             (content-type (if content-type-all
65+
                               (car content-type-all)
66+
                               #f))
67+
             (boundary (if (eq? content-type 'multipart/form-data)
68+
                           (assq-ref (cdr content-type-all) 'boundary)
69+
                           #f))
70+
             (reqbody-string (utf8->string request-body))
71+
             (form-data (if boundary
72+
                            (read-multipart-form-data reqbody-string boundary)
73+
                            #f))
74+
             (new-pb-data (if form-data
75+
                              (call-with-dir-as-pb-data
76+
                               pb-data-path
77+
                               (lambda (pb-data)
78+
                                 (pb-data-new-entry pb-data
79+
                                                    (assoc-ref form-data "text"))))
80+
                              #f)))
81+
82+
        ;; determine what to respond
83+
        (if (and new-pb-data
84+
                 (assoc-ref form-data "showUrl"))
85+
86+
            ;; show url after paste
87+
            (values (build-response
88+
                     #:code 200
89+
                     #:headers '((content-type . (text/plain))))
90+
                    (lambda (port)
91+
                      (let* ((hostp (assq-ref headers 'host)))
92+
                        (put-string
93+
                         port
94+
                         (uri->string
95+
                          (build-uri 'http
96+
                                     #:host (car hostp)
97+
                                     #:port (cdr hostp)
98+
                                     #:path (format #f "/raw/~a\r\n"
99+
                                                    (pb-entry-id new-pb-data))))))))
100+
101+
            ;; respond with 303 See Other
102+
            (values (build-response
103+
                     #:code 303
104+
                     #:headers `((location . ,(build-uri-reference #:path "/"))))
105+
                    (lambda (port) 1))))
106+
107+
      ;; INVALID request: access /post without HTTP POST
108+
      (values (build-response #:code 400)
109+
              (lambda (port) 1))))
62110 
63111 
(define (make-pastebin-handler data-path)
64112 
  (lambda (request request-body)
65-
    (if (eq? (request-method request) 'POST)
66-
        (let* ((headers (request-headers request))
67-
               (content-type-all (assq-ref headers 'content-type))
68-
               (content-type (if content-type-all (car content-type-all) #f))
69-
               (boundary (if (eq? content-type 'multipart/form-data)
70-
                             (assq-ref (cdr content-type-all) 'boundary) #f))
71-
               (reqbody-string (utf8->string request-body)))
72-
          (if boundary
73-
              (let ((form-data (read-multipart-form-data reqbody-string boundary)))
74-
                (call-with-dir-as-pb-data
75-
                 data-path
76-
                 (lambda (pb-data)
77-
                   (pb-data-new-entry pb-data
78-
                                      (assoc-ref form-data "text"))))))))
79-
80-
    ;; match raw file
81113 
    (match (split-and-decode-uri-path (uri-path (request-uri request)))
114+
115+
      ;; URI: /post -- create paste
116+
      (("post" . _)
117+
       (post-handler request request-body data-path))
118+
119+
      ;; URI: /raw/<id> -- return raw content of the paste
82120 
      (("raw" pb-id)
83121 
       (values (build-response
84122 
                #:code 200
85-
                #:headers `((content-type . (text/plain))))
123+
                #:headers '((content-type . (text/plain))))
86124 
87125 
               (lambda (port)
88126 
                 (call-with-input-file
89127 
                     ;; the file name
90-
                     (call-with-dir-as-pb-data data-path
91-
                                               (lambda (p) (pb-get-file-path p pb-id)))
128+
                     (call-with-dir-as-pb-data
129+
                      data-path
130+
                      (lambda (p) (pb-get-file-path p pb-id)))
131+
92132 
                   ;; the input port
93133 
                   (lambda (inport)
94134 
                     (let A ((inport' inport))
…
98138 
                               (put-bytevector port bv)
99139 
                               (A inport'))))))))))
100140 
101-
      ;; match everything else
141+
      ;; URI: * -- everything else -- show the top 5 paste list
102142 
      (_
103-
104143 
       (values (build-response
105144 
                #:code 200
106-
                #:headers `((content-type . (text/html))))
145+
                #:headers '((content-type . (text/html))))
107146 
108147 
               (lambda (port)
109148 
                 (let* ((top5 (call-with-dir-as-pb-data
…
111150 
                               (lambda (pb-data) (pb-data-get-top pb-data 5))))
112151 
                        (sxml (templatize
113152 
                               "pastebin"
114-
                               `((form (@ (method "post") (enctype "multipart/form-data"))
115-
                                       (textarea (@ (name "text")) "") (input (@ (type "submit"))))
153+
                               `((form (@ (method "post") (enctype "multipart/form-data")
154+
                                          (action "/post"))
155+
                                       (textarea (@ (name "text")) "")
156+
                                       (input (@ (type "checkbox") (name "showUrl")
157+
                                                 (id "showUrl") (value "1")))
158+
                                       (label (@ (for "showUrl")) "Show raw URL after paste")
159+
                                       (input (@ (type "submit"))))
116160 
                                 (table (@ (border 1)) (tr (th "id") (th "text") (th ""))
117161 
                                        ,(map (lambda (entry)
118162 
                                                `(tr (td ,(pb-entry-id entry))
119163 
                                                     (td ,(pb-entry-text entry))
120-
                                                     (td ,(make-raw-link-pb-entry (pb-entry-id entry)))))
164+
                                                     (td
165+
                                                      (a (@ (href
166+
                                                             ,(format #f "/raw/~a"
167+
                                                                      (pb-entry-id entry))))
168+
                                                         "raw"))))
121169 
                                              top5))))))
122170 
                   (display "<!DOCTYPE html>\n" port)
123171 
                   (sxml->xml sxml port))))))))