fix: import random-bytes, JSON parse guard, X-Forwarded-Proto trust, template traversal, byte limit
ober
cf7949c1e1eea147ff83590e2adb3afbe70fbe9f
--- a/sinatra/app.ss +++ b/sinatra/app.ss @@ -33,6 +33,7 @@ ("session-secret" #f) ("session-secure" #t) ("session-same-site" "Lax") + ("trust-proxy" #f) ("static" #t) ("static-max-bytes" 8388608) ("logging" #t) --- a/sinatra/request.ss +++ b/sinatra/request.ss @@ -1,6 +1,8 @@ (import (std net httpd) (std net uri) - (std text json)) + (std text json) + (sinatra context) + (sinatra app)) (export make-sinatra-request sinatra-request? wrap-request @@ -125,12 +127,14 @@ (sinatra-request-body-str-set! req body-string) body-string))) -;; Parse body as JSON +;; Parse body as JSON. Returns #f when the body is not well-formed JSON. (def (sinatra-request-body-json req) (let ((body (sinatra-request-body-string req))) (if (or (not body) (string=? body "")) (make-hash-table) - (string->json-object body)))) + (try + (string->json-object body) + (catch (e) #f))))) ;; Parse body as form-urlencoded params (def (sinatra-request-body-params req) @@ -162,10 +166,14 @@ (let ((xrw (sinatra-request-header req "X-Requested-With"))) (and xrw (string=? (string-downcase xrw) "xmlhttprequest")))) -;; Secure connection? +;; Secure connection? X-Forwarded-Proto is only trusted when the app has +;; enabled the "trust-proxy" setting; otherwise the header is ignored. (def (sinatra-request-secure? req) - (let ((proto (sinatra-request-header req "X-Forwarded-Proto"))) - (and proto (string=? (string-downcase proto) "https")))) + (let ((app (current-app))) + (and app + (app-setting app "trust-proxy") + (let ((proto (sinatra-request-header req "X-Forwarded-Proto"))) + (and proto (string=? (string-downcase proto) "https")))))) ;; User-Agent header (def (sinatra-request-user-agent req) --- a/sinatra/static.ss +++ b/sinatra/static.ss @@ -89,15 +89,15 @@ (def (read-file-limited full-path max-bytes) (call-with-input-file full-path (lambda (port) - (let loop ((chars '()) (count 0)) + (let loop ((chars '())) (let ((ch (read-char port))) - (cond - ((eof-object? ch) - (list->string (reverse chars))) - ((and max-bytes (>= count max-bytes)) - (error "Static file exceeds configured byte limit" full-path)) - (else - (loop (cons ch chars) (+ count 1))))))))) + (if (eof-object? ch) + (let ((str (list->string (reverse chars)))) + (when (and max-bytes + (> (bytevector-length (string->utf8 str)) max-bytes)) + (error "Static file exceeds configured byte limit" full-path)) + str) + (loop (cons ch chars)))))))) ;; Helper: check if str starts with prefix (def (string-prefix? prefix str) --- a/sinatra/template.ss +++ b/sinatra/template.ss @@ -14,11 +14,30 @@ (def (render-sxml sxml-tree) (sxml->html sxml-tree)) +;; Substring search helper used to reject traversal sequences. +(def (template-name-contains? str needle) + (let ((n (string-length str)) + (m (string-length needle))) + (let loop ((i 0)) + (cond + ((> (+ i m) n) #f) + ((string=? (substring str i (+ i m)) needle) #t) + (else (loop (+ i 1))))))) + +;; Reject template names that could escape the views directory. +(def (unsafe-template-name? name-str) + (or (template-name-contains? name-str "..") + (and (> (string-length name-str) 0) + (char=? (string-ref name-str 0) #\/)))) + ;; Resolve view file path relative to the views directory. (def (views-path name (ext ".html")) (let* ((a (current-app)) - (views-dir (if a (app-setting a "views") "./views"))) - (string-append views-dir "/" (if (symbol? name) (symbol->string name) name) ext))) + (views-dir (if a (app-setting a "views") "./views")) + (name-str (if (symbol? name) (symbol->string name) name))) + (when (unsafe-template-name? name-str) + (error 'views-path "unsafe template name" name-str)) + (string-append views-dir "/" name-str ext))) ;; Render a file template with simple variable substitution. ;; Template uses {{key}} placeholders, vars is a hash-table.