123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105 |
- #|
- (define-module (web decode))
- (use-modules (ice-9 match))
- (use-modules (rnrs bytevectors))
- (use-modules (srfi srfi-1))
- (use-modules (srfi srfi-26))
- (use-modules (web uri))
- ;;;
- ;;; decode
- ;;;
- (define (acons-list k v alist)
- "Add V to K to alist as list"
- (let ((value (assoc-ref alist k)))
- (if value
- (let ((alist (alist-delete k alist)))
- (acons k (cons v value) alist))
- (acons k (list v) alist))))
- (define (list->alist lst)
- "Build a alist of list based on a list of key and values.
- Multiple values can be associated with the same key"
- (let next ((lst lst)
- (out '()))
- (if (null? lst)
- out
- (next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
- (define-public (decode bv)
- "Convert BV querystring or form data to an alist"
- (define string (utf8->string bv))
- (define pairs (map (cut string-split <> #\=)
- ;; semi-colon and amp can be used as pair separator
- (append-map (cut string-split <> #\;)
- (string-split string #\&))))
- (list->alist (map (match-lambda
- ((key value)
- (cons (uri-decode key) (uri-decode value)))) pairs)))
- |#
- #|
- (define (serve-file request body)
- (let* ((path (request-path-components request))
- (file-path (public-file-path path)))
- (if (and file-path (file-exists? file-path))
- (values '((content-type . (text/plain)))
- (open-input-file file-path))
- (not-found request))))
- (define (file-server)
- (run-server serve-file))
- |#
- ;; "Here is the piece of code that handles files for the curious:"
- #;(let ((file-path (public-file-path path)))
- (if (file-exists? file-path)
- (let* ((mime-type (mime-type-ref file-path))
- (mime-type-symbol (mime-type-symbol mime-type)))
- (if (text-mime-type? mime-type)
- (values
- `((content-type . (,mime-type-symbol)))
- (lambda (out-port)
- (call-with-input-file file-path
- (lambda (in-port)
- (display (read-delimited "" in-port)
- out-port)))))
- (values
- `((content-type . (,mime-type-symbol)))
- (call-with-input-file file-path
- (lambda (in-port)
- (get-bytevector-all in-port))))))
- (not-found request)))
- #|
- (define-module (glider mime-types)
- :export (mime-type-ref text-mime-type? mime-type-symbol))
- (define *mime-types* (make-hash-table 31))
- (hash-set! *mime-types* "css" '("text" . "css"))
- (hash-set! *mime-types* "txt" '("text" . "plain"))
- (hash-set! *mime-types* "png" '("image" . "png"))
- (hash-set! *mime-types* "jpg" '("image" . "jpeg"))
- (hash-set! *mime-types* "jpeg" '("image" . "jpeg"))
- (hash-set! *mime-types* "gif" '("image" . "gif"))
- (define (mime-type-ref file-name)
- (let* ((dot-position (string-rindex file-name #\.))
- (extension (and dot-position
- (string-copy file-name (+ dot-position 1))))
- (mime-type (and dot-position
- (hash-ref *mime-types* extension))))
- (if mime-type mime-type '("application" . "octet-stream"))))
- (define (mime-type-symbol mime-type)
- (string->symbol (string-append (car mime-type) "/" (cdr mime-type))))
- (define (text-mime-type? mime-type)
- (if (equal? (car mime-type) "text") #t #f))
- |#
|