fix: ASCII-only pct-encode, path validation, request cleanup
ober
ec81e835c83e06e111d2dfcb8ff54ac4bf42cf38
--- a/lib/jgl/ci.ss +++ b/lib/jgl/ci.ss @@ -27,11 +27,14 @@ (cons "status" status)))))) (def (get-pipeline c project id) - (gl-try-get c (string-append (proj-base project) "/pipelines/" id))) + (gl-try-get c (string-append (proj-base project) "/pipelines/" + (check-path-segment 'get-pipeline id)))) ;; All jobs for a pipeline (paginated). (def (pipeline-jobs c project id) - (gl-get-all c (string-append (proj-base project) "/pipelines/" id "/jobs"))) + (gl-get-all c (string-append (proj-base project) "/pipelines/" + (check-path-segment 'pipeline-jobs id) + "/jobs"))) ;; Recent project-wide jobs (newest first). (def (list-jobs c project (limit 20)) --- a/lib/jgl/client.ss +++ b/lib/jgl/client.ss @@ -8,7 +8,8 @@ (library (jgl client) (export make-client client? client-base-url client-token client-origin gl-get gl-get-all gl-get-text gl-try-get gl-download gl-download-at - pct-encode build-query api-path gitlab-error-response-summary + pct-encode build-query api-path check-path-segment + gitlab-error-response-summary gitlab-normalize-base-url gitlab-canonical-origin gitlab-same-origin? gitlab-loopback-origin?) (import (except (chezscheme) @@ -178,7 +179,7 @@ (let ([out (open-output-string)]) (for-each (lambda (ch) - (if (or (char-alphabetic? ch) (char-numeric? ch) + (if (or (ascii-alpha? ch) (ascii-digit? ch) (memv ch '(#\- #\_ #\. #\~))) (write-char ch out) (for-each @@ -209,6 +210,18 @@ acc))))]))]) (if (null? parts) "" (string-append "?" (string-join parts "&"))))) + ;; Validate a single positional path segment (issue iid, pipeline id) before + ;; it is interpolated into an API path. Reject query/fragment/slash injection + ;; and dot-segment traversal so a positional cannot reshape the request URL. + (def (check-path-segment who seg) + (unless (and (string? seg) (> (string-length seg) 0) + (not (string-contains seg "?")) + (not (string-contains seg "#")) + (not (string-contains seg "/")) + (not (string-contains seg ".."))) + (error who "invalid API path segment" seg)) + seg) + ;; Build an API path: "projects/123/issues" -> ".../api/v4/projects/123/issues" (def (api-path c path) (when (or (not (string? path)) (string-has-forbidden-url-char? path) @@ -254,11 +267,12 @@ ;; Raw authenticated GET. Returns (values status body-text). (def (gl-request c path) (let* ([url (api-path c path)] - [req (http-get url (auth-headers c url) #f)] - [status (request-status req)] - [body (request-text req)]) - (request-close req) - (values status body))) + [req (http-get url (auth-headers c url) #f)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (values (request-status req) (request-text req))) + (lambda () (request-close req))))) ;; GET + JSON decode; raises on non-2xx. (def (gl-get c path) --- a/lib/jgl/issues.ss +++ b/lib/jgl/issues.ss @@ -41,11 +41,13 @@ (cons "search" search)))))) (def (get-issue c project iid) - (gl-try-get c (string-append (proj-base project) "/issues/" iid))) + (gl-try-get c (string-append (proj-base project) "/issues/" + (check-path-segment 'get-issue iid)))) (def (get-notes c project iid) (gl-get-all c - (string-append (proj-base project) "/issues/" iid + (string-append (proj-base project) "/issues/" + (check-path-segment 'get-notes iid) "/notes?sort=asc&order_by=created_at"))) ;; --- Markdown generation --- --- a/test/test-jgl.ss +++ b/test/test-jgl.ss @@ -31,6 +31,8 @@ (check-equal? "Ab9-_.~" (pct-encode "Ab9-_.~"))) (test-case "pct-encode leaves plain word" (check-equal? "opened" (pct-encode "opened"))) + (test-case "pct-encode percent-encodes non-ASCII alphanumerics" + (check-equal? "%C3%A9" (pct-encode (string (integer->char #xE9))))) (test-case "build-query empty -> empty string" (check-equal? "" (build-query '()))) @@ -83,7 +85,15 @@ (check-equal? "https://gitlab.com" (client-base-url c)))) (test-case "API path cannot be converted into a network-path reference" (let ([c (make-client "https://gitlab.com" "")]) - (check-equal? #t (raises? (lambda () (api-path c "//evil.example")))))))) + (check-equal? #t (raises? (lambda () (api-path c "//evil.example")))))) + (test-case "check-path-segment accepts a plain id" + (check-equal? "42" (check-path-segment 'test "42"))) + (test-case "check-path-segment rejects query, fragment, slash, traversal" + (check-equal? #t (raises? (lambda () (check-path-segment 'test "7?x=1")))) + (check-equal? #t (raises? (lambda () (check-path-segment 'test "7#frag")))) + (check-equal? #t (raises? (lambda () (check-path-segment 'test "a/b")))) + (check-equal? #t (raises? (lambda () (check-path-segment 'test "../../x")))) + (check-equal? #t (raises? (lambda () (check-path-segment 'test ""))))))) ;; ============================================================ (def suite-format