security(org-babel): fix P0 shell breakout, temp race, var injection, tangle traversal
ober
295d81e658e8006f2de00e67bace43464a7cce76
--- a/src/jerboa-emacs/org-babel.ss +++ b/src/jerboa-emacs/org-babel.ss @@ -14,11 +14,28 @@ :std/misc/process :jerboa-scintilla/scintilla :jerboa-scintilla/constants - :jerboa-emacs/core + (only-in :jerboa-emacs/core check-untainted-file-path) :jerboa-emacs/echo :jerboa-emacs/org-parse) ;;;============================================================================ +;;; Security Helpers +;;;============================================================================ + +(def (org-babel-shell-quote s) + (string-append "'" (string-join (string-split s #\') "'\\''") "'")) + +(def (org-babel-make-temp-file lang ext) + (let loop ((attempts 0)) + (if (> attempts 10) + (error 'org-babel-make-temp-file "failed to create temp file") + (let* ((rand (number->string (random-integer 2147483647) 36)) + (path (string-append "/tmp/org-babel-" lang "-" rand "." ext))) + (if (or (file-exists? path) (file-symbolic-link? path)) + (loop (+ attempts 1)) + path))))) + +;;;============================================================================ ;;; Language Executor Registry ;;;============================================================================ @@ -256,25 +273,32 @@ (string-trim (org-babel-session-execute lang full-code session-name)) ;; One-shot execution via temp file (let* ((ext (org-babel-file-extension lang)) - (tmp (string-append "/tmp/org-babel-" lang "." ext))) - (call-with-output-file tmp - (lambda (port) (display full-code port))) + (tmp (org-babel-make-temp-file lang ext))) + (let ((wport (open-file-output-port tmp + (file-options no-fail) + (buffer-mode block) + (native-transcoder)))) + (put-string wport full-code) + (close-port wport) + (chmod tmp #o600)) (with-catch (lambda (e) + (delete-file tmp) (string-append "Error: " (with-output-to-string (lambda () (display-exception e))))) (lambda () (let* ((full-cmd (string-append - (if dir (string-append "cd '" dir "' && ") "") - cmd " '" tmp "' 2>&1")) + (if dir (string-append "cd " (org-babel-shell-quote dir) " && ") "") + cmd " " (org-babel-shell-quote tmp) " 2>&1")) (result - (let-values (((in-port out-port err-port pid) + (let-values (((p-stdin p-stdout p-stderr pid) (open-process-ports full-cmd (buffer-mode block) (native-transcoder)))) - (close-port out-port) - (close-port err-port) - (let ((s (get-string-all in-port))) - (close-port in-port) + (close-port p-stdin) + (close-port p-stderr) + (let ((s (get-string-all p-stdout))) + (close-port p-stdout) (if (eof-object? s) "" s))))) + (delete-file tmp) (string-trim result)))))))))) (def (org-babel-file-extension lang) @@ -415,31 +439,56 @@ (let ((name (car pair)) (val (cdr pair))) (cond ((or (string=? lang "bash") (string=? lang "sh")) - (string-append name "='" val "'")) + (string-append name "=" (org-babel-shell-quote val))) ((string=? lang "python") (string-append name " = " (org-babel-python-value val))) ((string=? lang "ruby") (string-append name " = " (org-babel-ruby-value val))) ((or (string=? lang "chez") (string=? lang "scheme")) - (string-append "(def " name " " val ")")) + (string-append "(def " name " " (org-babel-scheme-value val) ")")) ((string=? lang "node") - (string-append "const " name " = " val ";")) + (string-append "const " name " = " (org-babel-node-value val) ";")) (else (string-append "# " name " = " val))))) - vars) + vars) "\n")) +(def (org-babel-escape-string val) + (let loop ((i 0) (out "")) + (if (>= i (string-length val)) + out + (let ((c (string-ref val i))) + (loop (+ i 1) + (string-append out + (cond + ((char=? c #\\) "\\\\") + ((char=? c #\") "\\\"") + ((char=? c #\newline) "\\n") + ((char=? c #\return) "\\r") + ((char=? c #\tab) "\\t") + (else (string c))))))))) + (def (org-babel-python-value val) "Format value for Python." (if (pregexp-match "^-?\\d+\\.?\\d*$" val) - val ; number - (string-append "\"" val "\""))) + val + (string-append "\"" (org-babel-escape-string val) "\""))) (def (org-babel-ruby-value val) "Format value for Ruby." (if (pregexp-match "^-?\\d+\\.?\\d*$" val) val - (string-append "\"" val "\""))) + (string-append "\"" (org-babel-escape-string val) "\""))) + +(def (org-babel-node-value val) + "Format value for Node.js." + (if (pregexp-match "^-?\\d+\\.?\\d*$" val) + val + (string-append "\"" (org-babel-escape-string val) "\""))) + +(def (org-babel-scheme-value val) + "Format value for Scheme as a string literal." + (string-append "\"" (org-babel-escape-string val) "\"")) ;;;============================================================================ ;;; Result Handling @@ -626,9 +675,15 @@ merged) files)))) +(def (org-babel-tangle-path-safe? tangle-target) + (and (not (string-prefix? "/" tangle-target)) + (not (string-prefix? "~" tangle-target)) + (not (string-contains tangle-target "..")))) + (def (expand-tangle-path tangle-target) - "Expand ~ in tangle path." - (if (string-prefix? "~/" tangle-target) - (string-append (or (getenv "HOME" #f) "/tmp") - (substring tangle-target 1 (string-length tangle-target))) - tangle-target)) + "Expand tangle path, rejecting absolute and traversal targets." + (check-untainted-file-path tangle-target) + (unless (org-babel-tangle-path-safe? tangle-target) + (error 'expand-tangle-path + "unsafe tangle target (absolute or traversal)" tangle-target)) + tangle-target) --- a/tests/test-org-babel.ss +++ b/tests/test-org-babel.ss @@ -6,6 +6,7 @@ make-hash-table hash-table? iota 1+ 1-) (jerboa core) (jerboa runtime) + (only (std sugar) with-catch) (jerboa-emacs org-babel) (jerboa-emacs org-parse) (std srfi srfi-13)) @@ -307,6 +308,96 @@ (check (org-babel-inside-src-block?-text text 5) => #f)) ;;; ======================================================================== +;;; Security: (a) :dir shell breakout +;;; ======================================================================== + +(display "--- security-dir-shell-breakout ---\n") + +(let* ((marker "/tmp/org-babel-pwned-dir-test") + (evil-dir (string-append "x'; touch " marker "; echo '")) + (hargs (org-babel-parse-header-args + (string-append ":dir " evil-dir)))) + (when (file-exists? marker) (delete-file marker)) + (let ((result (org-babel-execute "bash" "echo safe" hargs))) + (check-true (not (file-exists? marker)))) + (when (file-exists? marker) (delete-file marker))) + +;;; ======================================================================== +;;; Security: (b) predictable temp file +;;; ======================================================================== + +(display "--- security-predictable-temp ---\n") + +(let* ((old-predictable "/tmp/org-babel-bash.sh") + (hargs (org-babel-parse-header-args ""))) + (when (file-exists? old-predictable) (delete-file old-predictable)) + (let ((result (org-babel-execute "bash" "echo temp-test" hargs))) + (check-true (string-contains result "temp-test")) + (check-true (not (file-exists? old-predictable))))) + +;;; ======================================================================== +;;; Security: (c) :var preamble injection +;;; ======================================================================== + +(display "--- security-var-injection ---\n") + +(let* ((marker "/tmp/org-babel-pwned-var-test") + (evil-val (string-append "x'; touch " marker "; echo '")) + (hargs (org-babel-parse-header-args + (string-append ":var msg=" evil-val)))) + (when (file-exists? marker) (delete-file marker)) + (let ((result (org-babel-execute "bash" "echo \"$msg\"" hargs))) + (check-true (not (file-exists? marker)))) + (when (file-exists? marker) (delete-file marker))) + +(let ((preamble (org-babel-inject-variables "python" + '(("x" . "hello\"; import os; os.system('id'); #"))))) + (check-true (string-contains preamble "\\\""))) + +(let ((preamble (org-babel-inject-variables "node" + '(("x" . "a\"; process.exit(1); //"))))) + (check-true (string-contains preamble "\\\""))) + +(let ((preamble (org-babel-inject-variables "scheme" + '(("x" . "a\") (system \"id\") (display \""))))) + (check-true (string-contains preamble "\\\""))) + +;;; ======================================================================== +;;; Security: (d) :tangle arbitrary file write +;;; ======================================================================== + +(display "--- security-tangle-path-traversal ---\n") + +(let* ((evil-file "/tmp/org-babel-tangle-evil-test") + (text (string-append + "#+BEGIN_SRC bash :tangle ../../etc/evil\n" + "malicious\n" + "#+END_SRC\n"))) + (when (file-exists? evil-file) (delete-file evil-file)) + (let ((result (with-catch (lambda (e) 'rejected) + (lambda () (org-babel-tangle-to-files text))))) + (check result => 'rejected))) + +(let* ((evil-file "/tmp/org-babel-tangle-abs-test") + (text (string-append + "#+BEGIN_SRC bash :tangle " evil-file "\n" + "malicious\n" + "#+END_SRC\n"))) + (when (file-exists? evil-file) (delete-file evil-file)) + (let ((result (with-catch (lambda (e) 'rejected) + (lambda () (org-babel-tangle-to-files text))))) + (check result => 'rejected) + (check-true (not (file-exists? evil-file))))) + +(let* ((text (string-append + "#+BEGIN_SRC bash :tangle ~/.ssh/authorized_keys\n" + "ssh-rsa EVIL\n" + "#+END_SRC\n"))) + (let ((result (with-catch (lambda (e) 'rejected) + (lambda () (org-babel-tangle-to-files text))))) + (check result => 'rejected))) + +;;; ======================================================================== ;;; Summary ;;; ========================================================================