Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 05:27:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Moving internal server error handler up a level and logging the error.

Browse source
This commit is contained in:
Alex Shinn 2014-04-06 22:02:00 +09:00
parent 1572132374
commit 0c33f4fa1a
1 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
lib/chibi/net/http-server.scm
View file

@ -23,8 +23,12 @@
(make-request command (car ls) (cadr ls) in out sock addr))) (make-request command (car ls) (cadr ls) in out sock addr)))
(log-info `(request: ,command ,(car ls) ,(cadr ls) (log-info `(request: ,command ,(car ls) ,(cadr ls)
,(request-headers request))) ,(request-headers request)))
(let restart ((request request)) (protect (exn
(servlet cfg request servlet-bad-request restart)))) (else
(log-error "internal error: " exn)
(servlet-respond request 500 "Internal server error")))
(let restart ((request request))
(servlet cfg request servlet-bad-request restart)))))
(else (else
(let ((request (make-request command #f #f in out sock addr))) (let ((request (make-request command #f #f in out sock addr)))
(servlet-respond request 400 "bad request"))))))))) (servlet-respond request 400 "bad request")))))))))
@ -230,7 +234,7 @@
((negative? (car status)) ((negative? (car status))
(servlet-respond request 500 "Internal server error")) (servlet-respond request 500 "Internal server error"))
(else (else
(display "HTTP/1.1 200 OK\r\n" (request-out request)) (display "HTTP/1.0 200 OK\r\n" (request-out request))
(flush-output (request-out request)) (flush-output (request-out request))
(send-file temp-file (request-out request)) (send-file temp-file (request-out request))
(close-output-port out)))))))))) (close-output-port out))))))))))
@ -288,10 +292,7 @@
virtual-dir local-dir index-rx virtual-dir local-dir index-rx
(lambda (cfg request script-path next restart) (lambda (cfg request script-path next restart)
(let ((servlet (load-scheme-script/memoized script-path local-dir))) (let ((servlet (load-scheme-script/memoized script-path local-dir)))
(protect (exn (servlet cfg request next restart))))))
(else
(servlet-respond request 500 "Internal server error")))
(servlet cfg request next restart)))))))
(define (http-scheme-script-ext-servlet cfg request local-path next restart) (define (http-scheme-script-ext-servlet cfg request local-path next restart)
((load-scheme-script/memoized local-path) cfg request next restart)) ((load-scheme-script/memoized local-path) cfg request next restart))