<commit_before>#lang scheme
(require net/url
         net/uri-codec
         web-server/private/util
         web-server/private/connection-manager
         web-server/http/request-structs)

(provide/contract
 [rename ext:read-request read-request
         (connection? 
          port-number?
          (input-port? . -> . (values string? string?))
          . -> .
          (values request? boolean?))])

(define (ext:read-request conn host-port port-addresses)
  (with-handlers ([exn:fail? (lambda (exn)
                          (kill-connection! conn)
                          (raise exn))])
    (read-request conn host-port port-addresses)))

;; **************************************************
;; read-request: connection number (input-port -> string string) -> request boolean?
;; read the request line, and the headers, determine if the connection should
;; be closed after servicing the request and build a request structure
(define (read-request conn host-port port-addresses)
  (define ip 
    (connection-i-port conn))
  (define-values (method uri major minor)
    (read-request-line ip))
  (define headers 
    (read-headers ip))
  (define _
    (match (headers-assq* #"Content-Length" headers)
      [(struct header (f v))
       ; Give it one second per byte (with 5 second minimum... a bit arbitrary)          
       (adjust-connection-timeout! conn (max 5 (string->number (bytes->string/utf-8 v))))]
      [#f
       (void)]))
  (define-values (host-ip client-ip)
    (port-addresses ip))
  (define-values (bindings/raw-promise raw-post-data)
    (read-bindings&post-data/raw conn method uri headers))
  (values
   (make-request method uri headers bindings/raw-promise raw-post-data
                 host-ip host-port client-ip)
   (close-connection? headers major minor
                      client-ip host-ip)))

;; **************************************************
;; close-connection?

; close-connection? : (listof (cons symbol bytes)) number number string string -> boolean
; determine if this connection should be closed after serving the response
(define close-connection? 
  (let ([rx (byte-regexp #"[cC][lL][oO][sS][eE]")])
    (lambda (headers major minor client-ip host-ip)
      (or (< major 1)
          (and (= major 1) (= minor 0))
          (match (headers-assq* #"Connection" headers)
            [(struct header (f v))
             (and (regexp-match rx v)
                  #t)]
            [#f
             #f])
          (msie-from-local-machine? headers client-ip host-ip)))))

; msie-from-local-machine? : table str str -> bool
; to work around a bug in MSIE for documents < 265 bytes when connecting from the local
; machine.  The server could pad the response as MSIIS does, but closing the connection works, too.
; We do not check for version numbers since IE 6 under windows is 5.2 under macosX
(define msie-from-local-machine?
  (let ([rx (byte-regexp #"MSIE")])
    (lambda (headers client-ip host-ip)
      (and (string=? host-ip client-ip)
           (match
               (or (headers-assq* #"HTTP_USER_AGENT" headers)
                   (headers-assq* #"User-Agent" headers))
             [(struct header (f v))
              (and (regexp-match rx v)
                   #t)]
             [#f
              #f])))))

;; **************************************************
;; read-request-line  
(define match-method
  (let ([rx (byte-regexp #"^([^ ]+) (.+) HTTP/([0-9]+)\\.([0-9]+)$")])
    (lambda (a) (regexp-match rx a))))

; read-request-line : iport -> bytes url number number
; to read in the first line of an http request, AKA the "request line"
; effect: in case of errors, complain [MF: where] and close the ports
(define (read-request-line ip)
  (define line (read-bytes-line ip 'any))
  (if (eof-object? line)
      (network-error 'read-request "http input closed abruptly")
      (cond
        [(match-method line)
         => (match-lambda
              [(list _ method url major minor)
               (values method
                       (string->url (bytes->string/utf-8 url))
                       (string->number (bytes->string/utf-8 major))
                       (string->number (bytes->string/utf-8 minor)))])]
        [else (network-error 'read-request "malformed request ~a" line)])))

;; **************************************************
;; read-headers  
(define match-colon
  (let ([rx (byte-regexp (bytes-append #"^([^:]*):[ " (bytes 9) #"]*(.*)"))])
    (lambda (a) (regexp-match rx a))))

; read-headers : iport -> (listof header?)
(define (read-headers in)
  (let read-header ()
    (define l (read-bytes-line in 'any))
    (cond
      [(eof-object? l) null]
      [(zero? (bytes-length l)) null]
      [(match-colon l) 
       => (match-lambda
            [(list _ field value)
             (list* (make-header field (read-one-head in value))
                    (read-header))])]
      [else (network-error 'read-headers "malformed header")])))

; read-one-head : iport bytes -> bytes
(define (read-one-head in rhs)
  (match (peek-byte in)
    [(or 32 9) ;(or (eq? c #\space) (eq? c #\tab))
     ; (read-bytes-line in 'any) can't return eof
     ; because we just checked with peek-char
     ; Spidey: FLOW
     (read-one-head in (bytes-append rhs (read-bytes-line in 'any)))]
    [_ rhs]))

;; **************************************************
;; read-bindings
(define INPUT-BUFFER-SIZE 4096)
(define (read-to-eof in)
  (define b (read-bytes INPUT-BUFFER-SIZE in))
  (if (eof-object? b)
      empty
      (list* b (read-to-eof in))))

(define FILE-FORM-REGEXP (byte-regexp #"multipart/form-data; *boundary=(.*)"))

;; read-bindings&post-data/raw: connection symbol url (listof header?) -> (values (or/c (listof binding?) string?) (or/c bytes? false/c?))
(define (read-bindings&post-data/raw conn meth uri headers)
  (cond
    [(bytes-ci=? #"GET" meth)
     (values (delay
              (filter (lambda (x) x)
                     (map (match-lambda
                            [(list-rest k v)
                             (if (and (symbol? k) (string? v))
                                 (make-binding:form (string->bytes/utf-8 (symbol->string k))
                                                    (string->bytes/utf-8 v))
                                 #f)])
                          (url-query uri))))
             #f)]
    [(bytes-ci=? #"POST" meth)
     (local
       [(define content-type (headers-assq* #"Content-Type" headers))
        (define in (connection-i-port conn))]
       (cond
         [(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type)))
          => (match-lambda
               [(list _ content-boundary)
                (values
                 (delay
                  (map (match-lambda
                        [(struct mime-part (headers contents))
                         (define rhs (header-value (headers-assq* #"Content-Disposition" headers)))
                         (match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
                                      (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
                           [(list #f #f)
                            (network-error 'reading-bindings "Couldn't extract form field name for file upload")]
                           [(list #f (list _ _ f0 f1))
                            (make-binding:form (or f0 f1) (apply bytes-append contents))]
                           [(list (list _ _ f00 f01) (list _ _ f10 f11))
                            (make-binding:file (or f10 f11) (or f00 f01) headers (apply bytes-append contents))])])
                      (read-mime-multipart content-boundary in)))
                 #f)])]
         [else        
          (match (headers-assq* #"Content-Length" headers)
            [(struct header (_ value))
             (cond
               [(string->number (bytes->string/utf-8 value))
                => (lambda (len) 
                     (let ([raw-bytes (read-bytes len in)])
                       (values (delay (parse-bindings raw-bytes)) raw-bytes)))]
               [else 
                (network-error 'read-bindings "Post request contained a non-numeric content-length")])]
            [#f
             (let ([raw-bytes (apply bytes-append (read-to-eof in))])
               (values (delay (parse-bindings raw-bytes)) raw-bytes))])]))]
    [(bytes-ci=? #"PUT" meth)<commit_msg>Fixing one use of delay<commit_after>#lang scheme
(require net/url
         net/uri-codec
         web-server/private/util
         web-server/private/connection-manager
         web-server/http/request-structs)

(provide/contract
 [rename ext:read-request read-request
         (connection? 
          port-number?
          (input-port? . -> . (values string? string?))
          . -> .
          (values request? boolean?))])

(define (ext:read-request conn host-port port-addresses)
  (with-handlers ([exn:fail? (lambda (exn)
                          (kill-connection! conn)
                          (raise exn))])
    (read-request conn host-port port-addresses)))

;; **************************************************
;; read-request: connection number (input-port -> string string) -> request boolean?
;; read the request line, and the headers, determine if the connection should
;; be closed after servicing the request and build a request structure
(define (read-request conn host-port port-addresses)
  (define ip 
    (connection-i-port conn))
  (define-values (method uri major minor)
    (read-request-line ip))
  (define headers 
    (read-headers ip))
  (define _
    (match (headers-assq* #"Content-Length" headers)
      [(struct header (f v))
       ; Give it one second per byte (with 5 second minimum... a bit arbitrary)          
       (adjust-connection-timeout! conn (max 5 (string->number (bytes->string/utf-8 v))))]
      [#f
       (void)]))
  (define-values (host-ip client-ip)
    (port-addresses ip))
  (define-values (bindings/raw-promise raw-post-data)
    (read-bindings&post-data/raw conn method uri headers))
  (values
   (make-request method uri headers bindings/raw-promise raw-post-data
                 host-ip host-port client-ip)
   (close-connection? headers major minor
                      client-ip host-ip)))

;; **************************************************
;; close-connection?

; close-connection? : (listof (cons symbol bytes)) number number string string -> boolean
; determine if this connection should be closed after serving the response
(define close-connection? 
  (let ([rx (byte-regexp #"[cC][lL][oO][sS][eE]")])
    (lambda (headers major minor client-ip host-ip)
      (or (< major 1)
          (and (= major 1) (= minor 0))
          (match (headers-assq* #"Connection" headers)
            [(struct header (f v))
             (and (regexp-match rx v)
                  #t)]
            [#f
             #f])
          (msie-from-local-machine? headers client-ip host-ip)))))

; msie-from-local-machine? : table str str -> bool
; to work around a bug in MSIE for documents < 265 bytes when connecting from the local
; machine.  The server could pad the response as MSIIS does, but closing the connection works, too.
; We do not check for version numbers since IE 6 under windows is 5.2 under macosX
(define msie-from-local-machine?
  (let ([rx (byte-regexp #"MSIE")])
    (lambda (headers client-ip host-ip)
      (and (string=? host-ip client-ip)
           (match
               (or (headers-assq* #"HTTP_USER_AGENT" headers)
                   (headers-assq* #"User-Agent" headers))
             [(struct header (f v))
              (and (regexp-match rx v)
                   #t)]
             [#f
              #f])))))

;; **************************************************
;; read-request-line  
(define match-method
  (let ([rx (byte-regexp #"^([^ ]+) (.+) HTTP/([0-9]+)\\.([0-9]+)$")])
    (lambda (a) (regexp-match rx a))))

; read-request-line : iport -> bytes url number number
; to read in the first line of an http request, AKA the "request line"
; effect: in case of errors, complain [MF: where] and close the ports
(define (read-request-line ip)
  (define line (read-bytes-line ip 'any))
  (if (eof-object? line)
      (network-error 'read-request "http input closed abruptly")
      (cond
        [(match-method line)
         => (match-lambda
              [(list _ method url major minor)
               (values method
                       (string->url (bytes->string/utf-8 url))
                       (string->number (bytes->string/utf-8 major))
                       (string->number (bytes->string/utf-8 minor)))])]
        [else (network-error 'read-request "malformed request ~a" line)])))

;; **************************************************
;; read-headers  
(define match-colon
  (let ([rx (byte-regexp (bytes-append #"^([^:]*):[ " (bytes 9) #"]*(.*)"))])
    (lambda (a) (regexp-match rx a))))

; read-headers : iport -> (listof header?)
(define (read-headers in)
  (let read-header ()
    (define l (read-bytes-line in 'any))
    (cond
      [(eof-object? l) null]
      [(zero? (bytes-length l)) null]
      [(match-colon l) 
       => (match-lambda
            [(list _ field value)
             (list* (make-header field (read-one-head in value))
                    (read-header))])]
      [else (network-error 'read-headers "malformed header")])))

; read-one-head : iport bytes -> bytes
(define (read-one-head in rhs)
  (match (peek-byte in)
    [(or 32 9) ;(or (eq? c #\space) (eq? c #\tab))
     ; (read-bytes-line in 'any) can't return eof
     ; because we just checked with peek-char
     ; Spidey: FLOW
     (read-one-head in (bytes-append rhs (read-bytes-line in 'any)))]
    [_ rhs]))

;; **************************************************
;; read-bindings
(define INPUT-BUFFER-SIZE 4096)
(define (read-to-eof in)
  (define b (read-bytes INPUT-BUFFER-SIZE in))
  (if (eof-object? b)
      empty
      (list* b (read-to-eof in))))

(define FILE-FORM-REGEXP (byte-regexp #"multipart/form-data; *boundary=(.*)"))

;; read-bindings&post-data/raw: connection symbol url (listof header?) -> (values (or/c (listof binding?) string?) (or/c bytes? false/c?))
(define (read-bindings&post-data/raw conn meth uri headers)
  (cond
    [(bytes-ci=? #"GET" meth)
     (values (delay
              (filter (lambda (x) x)
                     (map (match-lambda
                            [(list-rest k v)
                             (if (and (symbol? k) (string? v))
                                 (make-binding:form (string->bytes/utf-8 (symbol->string k))
                                                    (string->bytes/utf-8 v))
                                 #f)])
                          (url-query uri))))
             #f)]
    [(bytes-ci=? #"POST" meth)
     (local
       [(define content-type (headers-assq* #"Content-Type" headers))
        (define in (connection-i-port conn))]
       (cond
         [(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type)))
          => (match-lambda
               [(list _ content-boundary)
                ; XXX This can't be delay because it reads from the port, which would otherwise be closed.
                ;     I think this is reasonable because the Content-Type said it would have this format
                (define bs
                  (map (match-lambda
                        [(struct mime-part (headers contents))
                         (define rhs (header-value (headers-assq* #"Content-Disposition" headers)))
                         (match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
                                      (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
                           [(list #f #f)
                            (network-error 'reading-bindings "Couldn't extract form field name for file upload")]
                           [(list #f (list _ _ f0 f1))
                            (make-binding:form (or f0 f1) (apply bytes-append contents))]
                           [(list (list _ _ f00 f01) (list _ _ f10 f11))
                            (make-binding:file (or f10 f11) (or f00 f01) headers (apply bytes-append contents))])])
                      (read-mime-multipart content-boundary in)))
                (values
                 (delay bs)
                 #f)])]
         [else        
          (match (headers-assq* #"Content-Length" headers)
            [(struct header (_ value))
             (cond
               [(string->number (bytes->string/utf-8 value))
                => (lambda (len) 
                     (let ([raw-bytes (read-bytes len in)])
                       (values (delay (parse-bindings raw-bytes)) raw-bytes)))]
               [else 
                (network-error 'read-bindings "Post request contained a non-numeric content-length")])]
            [#f
             (let ([raw-bytes (apply bytes-append (read-to-eof in))])
               (values (delay (parse-bindings raw-bytes)) raw-bytes))])]))]
    [(bytes-ci=? #"PUT" meth)
{'fraction_non_alphanumeric': 0.17185568830557355, 'fraction_numerical': 0.005885468777588135, 'mean_word_length': 2.008498583569405, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6796778', 'n_tokens_mistral': 5125, 'n_tokens_neox': 4863, 'n_words': 1430}