Add raw link.

Li Ian-Xue (b4283)Mon Sep 27 20:10:58+0300 2021

7ec0071

Add raw link.

pastebin/data.scm

1313 
        pb-data-close
1414 
        call-with-dir-as-pb-data
1515 
        pb-data-get-top
16-
        pb-data-new-entry)
16+
        pb-data-new-entry
17+
        pb-get-file-path)
1718 
1819 
(define-record-type <pb-data>
1920 
  (make-pb-data dir)
…
3940 
      (pb-data-close pb-data)
4041 
      R)))
4142 
42-
(define (get-file-path pb-data filename)
43+
(define (pb-get-file-path pb-data filename)
4344 
  (string-append (pb-data-dir pb-data) "/" filename))
4445 
4546 
;; input: <pb-data>, integer
…
4950 
   (lambda (filename)
5051 
     (make-pb-entry
5152 
      filename
52-
      (call-with-input-file (get-file-path pb-data filename)
53+
      (call-with-input-file (pb-get-file-path pb-data filename)
5354 
        (lambda (port)
5455 
          (get-string-all port)))))
5556 
   (let ((file-ls (list-files pb-data)))
…
5960 
;; output: <pb-entry>
6061 
(define (pb-data-new-entry pb-data text)
6162 
  (let ((next-filename (get-next-filename pb-data)))
62-
    (call-with-output-file (get-file-path pb-data next-filename)
63+
    (call-with-output-file (pb-get-file-path pb-data next-filename)
6364 
      (lambda (port)
6465 
        (put-string port text)))
6566 
    (make-pb-entry next-filename text)))
pastebin/httpserver.scm
22 
33 
(use-modules (web request)
44 
             (web response)
5+
             (web uri)
56 
             (sxml simple)
67 
             (pastebin data)
78 
             (rnrs bytevectors)
89 
             (ice-9 textual-ports)
10+
             (ice-9 binary-ports)
911 
             (ice-9 regex)
12+
             (ice-9 match)
1013 
             (srfi srfi-1))
1114 
1215 
(export make-pastebin-handler)
…
5457 
          (meta (@ (name "viewport") (content "width=device-width, initial-scale=1"))))
5558 
         (body ,@body)))
5659 
60+
(define (make-raw-link-pb-entry pb-id)
61+
  `(a (@ (href ,(format #f "/raw/~a" pb-id))) "raw"))
62+
5763 
(define (make-pastebin-handler data-path)
5864 
  (lambda (request request-body)
5965 
    (if (eq? (request-method request) 'POST)
…
7177 
                   (pb-data-new-entry pb-data
7278 
                                      (assoc-ref form-data "text"))))))))
7379 
74-
    (values (build-response
75-
             #:code 200
76-
             #:headers `((content-type . (text/html))))
80+
    ;; match raw file
81+
    (match (split-and-decode-uri-path (uri-path (request-uri request)))
82+
      (("raw" pb-id)
83+
       (values (build-response
84+
                #:code 200
85+
                #:headers `((content-type . (text/plain))))
86+
87+
               (lambda (port)
88+
                 (call-with-input-file
89+
                     ;; the file name
90+
                     (call-with-dir-as-pb-data data-path
91+
                                               (lambda (p) (pb-get-file-path p pb-id)))
92+
                   ;; the input port
93+
                   (lambda (inport)
94+
                     (let A ((inport' inport))
95+
                       (let ((bv (get-bytevector-n inport' 4096)))
96+
                         (if (not (eof-object? bv))
97+
                             (begin
98+
                               (put-bytevector port bv)
99+
                               (A inport'))))))))))
100+
101+
      ;; match everything else
102+
      (_
103+
104+
       (values (build-response
105+
                #:code 200
106+
                #:headers `((content-type . (text/html))))
77107 
78-
            (lambda (port)
79-
              (let* ((top5 (call-with-dir-as-pb-data
80-
                            data-path
81-
                            (lambda (pb-data) (pb-data-get-top pb-data 5))))
82-
                     (sxml (templatize
83-
                            "pastebin"
84-
                            `((form (@ (method "post") (enctype "multipart/form-data"))
85-
                                    (textarea (@ (name "text")) "") (input (@ (type "submit"))))
86-
                              (table (@ (border 1)) (tr (th "id") (th "text"))
87-
                                     ,(map (lambda (entry) `(tr (td ,(pb-entry-id entry))
88-
                                                                (td ,(pb-entry-text entry))))
89-
                                           top5))))))
90-
                (display "<!DOCTYPE html>\n" port)
91-
                (sxml->xml sxml port))))))
108+
               (lambda (port)
109+
                 (let* ((top5 (call-with-dir-as-pb-data
110+
                               data-path
111+
                               (lambda (pb-data) (pb-data-get-top pb-data 5))))
112+
                        (sxml (templatize
113+
                               "pastebin"
114+
                               `((form (@ (method "post") (enctype "multipart/form-data"))
115+
                                       (textarea (@ (name "text")) "") (input (@ (type "submit"))))
116+
                                 (table (@ (border 1)) (tr (th "id") (th "text") (th ""))
117+
                                        ,(map (lambda (entry)
118+
                                                `(tr (td ,(pb-entry-id entry))
119+
                                                     (td ,(pb-entry-text entry))
120+
                                                     (td ,(make-raw-link-pb-entry (pb-entry-id entry)))))
121+
                                              top5))))))
122+
                   (display "<!DOCTYPE html>\n" port)
123+
                   (sxml->xml sxml port))))))))