fix(xml): bound element nesting depth to prevent stack overflow

ober

f715c5ecf7e7cc154b93138dd9196da0e3253f95

diff --git a/lib/jerboa-aws/xml.sls b/lib/jerboa-aws/xml.sls
index 11b46ab..1a2b65c 100644
--- a/lib/jerboa-aws/xml.sls
+++ b/lib/jerboa-aws/xml.sls
@@ -4,9 +4,14 @@
 
 (library (jerboa-aws xml)
   (export xml-parse sxml->hash sxml-text sxml-items
-          strip-ns aws-response->hash)
+          strip-ns aws-response->hash xml-max-nesting-depth)
   (import (except (chezscheme) filter hashtable?))
 
+  ;; Maximum element nesting depth accepted by the parser. Real AWS responses
+  ;; are shallow; the bound stops a hostile deeply-nested payload from
+  ;; overflowing the stack, raising a clean error past this depth.
+  (define xml-max-nesting-depth (make-parameter 1024))
+
   ;; ---- Minimal XML parser ----
   ;; Parses XML string into SXML: (tag (@ (attr val) ...) child ...)
 
@@ -43,11 +48,14 @@
                  (xml-skip-until port ">")
                  (xml-read-document port)])]
              ;; Element
-             [else (xml-read-element port)]))]
+             [else (xml-read-element port 0)]))]
         [else (xml-read-document port)])))
 
-  (define (xml-read-element port)
+  (define (xml-read-element port depth)
     ;; Opening < already consumed
+    (when (> depth (xml-max-nesting-depth))
+      (error 'xml-parse "XML nesting exceeds maximum depth"
+        (xml-max-nesting-depth)))
     (let ([tag (xml-read-name port)])
       (xml-skip-ws port)
       (let-values ([(attrs self-closing) (xml-read-attrs port)])
@@ -56,7 +64,7 @@
             (list (string->symbol tag))
             (list (string->symbol tag) (cons '@ attrs)))
           ;; Read children until closing tag
-          (let ([children (xml-read-children port tag)])
+          (let ([children (xml-read-children port tag depth)])
             (if (null? attrs)
               (cons (string->symbol tag) children)
               (cons (string->symbol tag) (cons (cons '@ attrs) children))))))))
@@ -107,7 +115,7 @@
              (get-output-string out)]
             [else (write-char ch out) (loop)])))))
 
-  (define (xml-read-children port parent-tag)
+  (define (xml-read-children port parent-tag depth)
     (let loop ([children '()])
       (let ([text (xml-read-text port)])
         (let ([children (if (> (string-length text) 0)
@@ -135,7 +143,7 @@
                    ;; CDATA
                    ;; Child element
                    [else
-                    (let ([child (xml-read-element port)])
+                    (let ([child (xml-read-element port (+ depth 1))])
                       (loop (cons child children)))]))]))))))
 
   (define (xml-read-text port)