Emit secmon telemetry from Sinatra HTTP
ober
0d5a7bbcf9b30b924c8a6efc704fd0aaa4c7f647
--- a/sinatra/handler.ss +++ b/sinatra/handler.ss @@ -1,5 +1,8 @@ (import (std text json) (std sugar) + (only (std secmon telemetry) + secmon-telemetry-from-env + secmon-telemetry-emit!) (prefix (std net thread-httpd) th:) (sinatra context) (sinatra request) @@ -22,75 +25,213 @@ (mw-list (app-middleware app))) (compose-middleware mw-list base-handler))) +;; secmon daemon telemetry + +(def (str-value v) + (cond + ((string? v) v) + ((symbol? v) (symbol->string v)) + ((number? v) (number->string v)) + (else ""))) + +(def (limit-field s) + (let ((v (str-value s))) + (if (> (string-length v) 512) + (substring v 0 512) + v))) + +(def (http-string-contains? s needle) + (let ((n (string-length s)) + (m (string-length needle))) + (cond + ((= m 0) #t) + ((> m n) #f) + (else + (let loop ((i 0)) + (cond + ((> (+ i m) n) #f) + ((string=? needle (substring s i (+ i m))) #t) + (else (loop (+ i 1))))))))) + +(def (http-has-any? s needles) + (let ((down (string-downcase s))) + (let loop ((xs needles)) + (cond + ((null? xs) #f) + ((http-string-contains? down (car xs)) #t) + (else (loop (cdr xs))))))) + +(def (http-string-suffix? suffix s) + (let ((sn (string-length s)) + (pn (string-length suffix))) + (and (>= sn pn) + (string=? suffix (substring s (- sn pn) sn))))) + +(def *web-exec-suffixes* + '(".php" ".phtml" ".phar" ".jsp" ".jspx" ".asp" ".aspx" + ".cgi" ".pl" ".py" ".rb" ".sh")) + +(def *shell-needles* + '("/dev/tcp/" "/dev/udp/" "bash -i" " sh -i" "nc -e" "ncat -e" + "socat " "mkfifo" "curl " "wget " "base64 -d" "python -c" + "perl -e" "ruby -rsocket" "php -r" "%2fdev%2ftcp%2f" "bash%20-i")) + +(def (web-exec-path? path) + (let ((p (string-downcase path))) + (or (http-string-contains? p "/cgi-bin/") + (http-string-contains? p "authorized_keys") + (let loop ((xs *web-exec-suffixes*)) + (cond + ((null? xs) #f) + ((http-string-suffix? (car xs) p) #t) + (else (loop (cdr xs)))))))) + +(def (path-traversal? path) + (http-has-any? path '("../" "..\\" "%2e" "%2f" "%5c" "%00"))) + +(def (smuggling-risk? sreq) + (and (sinatra-request-header sreq "Transfer-Encoding") + (sinatra-request-header sreq "Content-Length"))) + +(def (upload-method? method) + (let ((m (string-downcase (str-value method)))) + (or (string=? m "put") + (string=? m "post") + (string=? m "patch")))) + +(def (upload-path? path) + (let ((p (string-downcase path))) + (or (http-string-contains? p "/upload") + (http-string-contains? p "/files") + (web-exec-path? p)))) + +(def (response-status resp) + (if (th:response? resp) + (th:response-status resp) + 200)) + +(def (emit-http-telemetry! telemetry sreq resp) + (let* ((method (sinatra-request-method sreq)) + (method-s (string-downcase (str-value method))) + (path (limit-field (sinatra-request-path sreq))) + (query (limit-field (or (sinatra-request-query-string sreq) ""))) + (status (response-status resp)) + (base-fields + (list "method" method-s + "path" path + "status" status + "remote_ip" (sinatra-request-ip sreq) + "host" (limit-field (sinatra-request-host sreq)) + "user_agent" (limit-field (or (sinatra-request-user-agent sreq) ""))))) + (cond + ((path-traversal? path) + (apply secmon-telemetry-emit! + telemetry "bad_request" "high" + (append base-fields + (list "reason" "path traversal")))) + ((smuggling-risk? sreq) + (apply secmon-telemetry-emit! + telemetry "bad_request" "high" + (append base-fields + (list "reason" "request smuggling risk")))) + ((and (upload-method? method) + (upload-path? path)) + (apply secmon-telemetry-emit! + telemetry "upload" "high" + (append base-fields + (list "reason" "upload to executable or writable path")))) + ((and (web-exec-path? path) + (http-has-any? query *shell-needles*)) + (apply secmon-telemetry-emit! + telemetry "exec" "critical" + (append base-fields + (list "command" query + "reason" "web executable command pattern")))) + ((>= status 500) + (apply secmon-telemetry-emit! + telemetry "server_error" "high" + (append base-fields + (list "reason" "handler returned server error")))) + ((and (>= status 400) + (web-exec-path? path)) + (apply secmon-telemetry-emit! + telemetry "bad_request" "medium" + (append base-fields + (list "reason" "request for executable web path")))) + (else #f)))) + ;; The core handler logic (def (make-base-handler app) - (lambda (req) - (let* ((sreq (wrap-request req)) - (sres (new-sinatra-response)) - (method (sinatra-request-method sreq)) - (path (sinatra-request-path sreq))) - ;; Set up context parameters - (parameterize ((current-app app) - (current-request sreq) - (current-response sres) - (current-params (sinatra-request-query-params sreq)) - (current-raw-response #f)) - ;; Halt continuation: calling (halt) jumps here - (let ((direct-response - (call/cc - (lambda (halt-k) - (parameterize ((current-halt-k halt-k)) - (try - ;; Handle method override if enabled - (let ((effective-method - (cond - ((eq? method 'HEAD) 'GET) - ((and (eq? method 'POST) - (app-setting app "method-override")) - (let ((override (or (hash-get (sinatra-request-query-params sreq) "_method") - #f))) - (if override - (string->symbol (string-upcase override)) - method))) - (else method)))) - - ;; 1. Check static files first - (when (and (eq? effective-method 'GET) - (app-setting app "static")) - (let ((static-path (try-static-file app path))) - (when static-path - (halt-k (serve-static-file static-path))))) - - ;; 2. Load session if enabled - (when (app-setting app "sessions") - (load-session app sreq)) - - ;; 3. Run before filters - (run-before-filters app effective-method path) - - ;; 4. Try routes - (let ((result (try-routes app effective-method path))) - (if result - (interpret-result result sres) - (handle-not-found app sres))) - - ;; 5. Run after filters - (run-after-filters app effective-method path) - - ;; 6. Save session if enabled - (when (app-setting app "sessions") - (save-session app sres)) - #f) - - (catch (e) - (handle-error app sres e) - #f))))))) - - ;; Return final response unless a direct static response was produced. - (apply-forced-headers! app sres) - (without-head-body method - (or direct-response - (sinatra-response-write! sres #f)))))))) + (let ((telemetry (secmon-telemetry-from-env "jhttpd"))) + (lambda (req) + (let* ((sreq (wrap-request req)) + (sres (new-sinatra-response)) + (method (sinatra-request-method sreq)) + (path (sinatra-request-path sreq))) + ;; Set up context parameters + (parameterize ((current-app app) + (current-request sreq) + (current-response sres) + (current-params (sinatra-request-query-params sreq)) + (current-raw-response #f)) + ;; Halt continuation: calling (halt) jumps here + (let ((direct-response + (call/cc + (lambda (halt-k) + (parameterize ((current-halt-k halt-k)) + (try + ;; Handle method override if enabled + (let ((effective-method + (cond + ((eq? method 'HEAD) 'GET) + ((and (eq? method 'POST) + (app-setting app "method-override")) + (let ((override (or (hash-get (sinatra-request-query-params sreq) "_method") + #f))) + (if override + (string->symbol (string-upcase override)) + method))) + (else method)))) + + ;; 1. Check static files first + (when (and (eq? effective-method 'GET) + (app-setting app "static")) + (let ((static-path (try-static-file app path))) + (when static-path + (halt-k (serve-static-file static-path))))) + + ;; 2. Load session if enabled + (when (app-setting app "sessions") + (load-session app sreq)) + + ;; 3. Run before filters + (run-before-filters app effective-method path) + + ;; 4. Try routes + (let ((result (try-routes app effective-method path))) + (if result + (interpret-result result sres) + (handle-not-found app sres))) + + ;; 5. Run after filters + (run-after-filters app effective-method path) + + ;; 6. Save session if enabled + (when (app-setting app "sessions") + (save-session app sres)) + #f) + + (catch (e) + (handle-error app sres e) + #f))))))) + + ;; Return final response unless a direct static response was produced. + (apply-forced-headers! app sres) + (let ((resp (without-head-body method + (or direct-response + (sinatra-response-write! sres #f))))) + (emit-http-telemetry! telemetry sreq resp) + resp))))))) (def (without-head-body method resp) (if (and (eq? method 'HEAD)