notes.org 4.7 KB
Useful code snippets
Convert byte vector query string or form data to an alist
The following code is taken from https://notabug.org/jbranso/autoassign/src/master/decode.scm. Comments have been added and code formatting has been changed. Some code has also been changed, for example some define expressions have been rewritten into a let* expression. Semantically though there should be no changes.
(define-module (decode))
(use-modules ;; for match-lambda (ice-9 match)) (use-modules ;; for utf8->string (rnrs bytevectors)) (use-modules ;; for append-map (srfi srfi-1)) (use-modules ;; for cut (srfi srfi-26)) (use-modules ;; for uri-decode (web uri))
(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" (let* ([string (utf8->string bv)] [pairs (map ;; The procedure cut from srfi-26 returns a procedure, which already ;; has some of the arguments specified and still needs to get the ;; arguments in positions of the <>. The following will return a ;; procedure, which splits strings at an equal sign. (cut string-split <> #\=) ;; The procedure append-map from srfi-1 is equivalent to first using ;; map and then using append to make one list out of all the partial ;; lists. ;; semi-colon and amp can be used as pair separator in URLs (append-map (cut string-split <> #\;) (string-split string #\&)))]) (list->alist ;; When query parameters are given in the URI, they need to be decoded, ;; because when they are given, they are, and need to be, URI encoded. (map ;; The procedure match-lambda returns a procedure, which takes one ;; argument and then tries to match the argument with each clause in ;; turn. If one clause matches the argument, its corresponding expression ;; is evaluated. (match-lambda ;; If there is a key value pair ... [(key value) ;; ... uri-decode the key and the value and return those decoded values ;; as a pair. (cons (uri-decode key) (uri-decode value))]) ;; Do this for all key value pairs. pairs))))
Serving static files
The following code snippet is from an e-mail on the Guile user mailing list:
(define (render-static-file root path) ;; PATH is a list of path components (let ((file-name (string-join (cons* root path) "/"))) (if (and (not (any (cut string-contains <> "..") path)) (file-exists? file-name) (not (directory? file-name))) (list `((content-type . ,(assoc-ref file-mime-types (file-extension file-name)))) (call-with-input-file file-name get-bytevector-all)) (not-found (build-uri 'http #:host (assoc-ref %config 'host) #:port (assoc-ref %config 'port) #:path (string-join path "/" 'prefix))))))
Example of sendfile usage
The following code is taken from https://git.savannah.gnu.org/cgit/guix.git/tree/guix/scripts/publish.scm:
(call-with-new-thread (lambda () (set-thread-name "publish file") (catch 'system-error (lambda () (call-with-input-file file (lambda (input) (let* ((size (stat:size (stat input))) (response (write-response (with-content-length response size) client)) (output (response-port response))) (setsockopt client SOL_SOCKET SO_SNDBUF (* 128 1024)) (if (file-port? output) (sendfile output input size) (dump-port input output)) (close-port output) (values))))) (lambda args ;; If the file was GC'd behind our back, that's fine. Likewise if ;; the client closes the connection. (unless (memv (system-error-errno args) (list ENOENT EPIPE ECONNRESET)) (apply throw args)) (values)))))