Changeset 33945 in project


Ignore:
Timestamp:
04/08/17 14:05:01 (5 months ago)
Author:
sjamaan
Message:

intarweb: Change error handling to let through http conditions unchanged

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/intarweb.scm

    r33944 r33945  
    689689                             (else default-header-unparser))))
    690690         (handle-exceptions exn
    691              (let* ((none "(no error message provided in original exn)")
    692                     (msg ((condition-property-accessor
    693                            'exn 'message none) exn))
    694                     (loc ((condition-property-accessor
    695                            'exn 'location #f) exn))
    696                     (args ((condition-property-accessor
    697                            'exn 'arguments '()) exn)))
    698                (signal-http-condition
    699                 'unparse-headers
    700                 (sprintf "could not unparse ~S header ~S: ~A~A"
    701                   name-s contents (if loc (sprintf "(~A) " loc) "") msg)
    702                 args
    703                 'unparse-error
    704                 'header-name name
    705                 'header-value contents
    706                 'unparser unparse
    707                 'original-exn exn))
     691             (if ((condition-predicate 'http) exn)
     692                 (signal exn) ;; Do not tamper with our own custom errors
     693                 (let* ((none "(no error message provided in original exn)")
     694                        (msg ((condition-property-accessor
     695                               'exn 'message none) exn))
     696                        (loc ((condition-property-accessor
     697                               'exn 'location #f) exn))
     698                        (args ((condition-property-accessor
     699                                'exn 'arguments '()) exn)))
     700                   (signal-http-condition
     701                    'unparse-headers
     702                    (sprintf "could not unparse ~S header ~S: ~A~A"
     703                      name-s contents (if loc (sprintf "(~A) " loc) "") msg)
     704                    args
     705                    'unparse-error
     706                    'header-name name
     707                    'header-value contents
     708                    'unparser unparse
     709                    'original-exn exn)))
    708710           (for-each (lambda (value)
    709711                       ;; Verify there's no \r\n or \r or \n in value?
Note: See TracChangeset for help on using the changeset viewer.