Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | suspended resource and error handling tweaks |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
e657ff967bba947cd5b23bb8c1308eaa |
| User & Date: | murphy 2011-09-25 01:51:06 |
Context
|
2011-10-02
| ||
| 20:40 | proper static linkage setup check-in: 091ba753c1 user: murphy tags: trunk | |
|
2011-09-25
| ||
| 01:51 | suspended resource and error handling tweaks check-in: e657ff967b user: murphy tags: trunk | |
|
2011-09-23
| ||
| 21:26 | added an example for suspensions check-in: e9f3970674 user: murphy tags: trunk | |
Changes
Changes to webgate.scm.
653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 ... 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 ... 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 |
;;; Central server routine
(define (handle-request getenv input-port output-port)
(write-response
(handle-exceptions
exn (begin
(print-error-message exn)
(print-call-chain)
(make-error-response
500 "The server encountered an internal error handling the request."))
(let ((parameters (make-hash-table))
(method (or (getenv "REQUEST_METHOD") "GET"))
(path (string-split (uri-decode (or (getenv "PATH_INFO") "")) "/")))
(or
................................................................................
404 "The requested resource was not found by the server.")))
(make-response 204 '()))))
output-port))
)
(module webgate-suspend
(max-suspended-resources
suspended-resource-handler
suspended
send/suspend)
(import
scheme chicken
srfi-1 srfi-18 srfi-69
data-structures webgate-utils webgate-core)
;;; Support for suspended computations (and directly related stuff)
(define max-suspended-resources
(make-parameter 1024))
(define suspended-resource-handler
(let ((handler
(let ((mutex (make-mutex 'suspended-resources))
(table (make-hash-table
#:test string-ci=? #:hash string-ci-hash
#:size (max-suspended-resources))))
(lambda (resume/uuid)
(dynamic-wind
(cut mutex-lock! mutex)
(if (procedure? resume/uuid)
(lambda ()
(let ((size (hash-table-size table)))
(when (>= size (max-suspended-resources))
(let ((uuids (sort! (hash-table-keys table)
(lambda (a b)
(< (uuid-time a)
(uuid-time b))))))
(for-each
(cut hash-table-delete! table <>)
(take uuids
(inexact->exact (ceiling (/ size 2))))))))
(let ((uuid (make-uuid 'time)))
(hash-table-set! table uuid resume/uuid)
uuid))
(lambda ()
(hash-table-ref/default table resume/uuid #f)))
(cut mutex-unlock! mutex))))))
(case-lambda
(()
handler)
((proc)
(set! handler proc)))))
................................................................................
request-parameter-handler
resource-context current-resource-context resource-context?
resource-context-getenv resource-context-return
response make-response response?
collect-response make-html-response make-error-response
response-status response-status-message
resource-handler define-resource resource-uri
max-suspended-resources
suspended-resource-handler
suspended
send/suspend
webgate-main)
(import
scheme chicken
webgate-core webgate-suspend webgate-cgi webgate-scgi tcp)
|
> > | > > | > > > | | | < < | > > | | | | | < | | | > > > | | | | < | | |
653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 ... 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 ... 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 |
;;; Central server routine
(define (handle-request getenv input-port output-port)
(write-response
(handle-exceptions
exn (begin
(when (uncaught-exception? exn)
(set! exn (uncaught-exception-reason exn)))
(print-error-message
exn (current-error-port)
(sprintf "[~a] Request Handling Error" (current-seconds)))
(print-call-chain)
(make-error-response
500 "The server encountered an internal error handling the request."))
(let ((parameters (make-hash-table))
(method (or (getenv "REQUEST_METHOD") "GET"))
(path (string-split (uri-decode (or (getenv "PATH_INFO") "")) "/")))
(or
................................................................................
404 "The requested resource was not found by the server.")))
(make-response 204 '()))))
output-port))
)
(module webgate-suspend
(max-suspended-resources max-suspended-resources-load
suspended-resource-handler
suspended
send/suspend)
(import
scheme chicken
srfi-1 srfi-18 srfi-69
data-structures webgate-utils webgate-core)
;;; Support for suspended computations (and directly related stuff)
(define max-suspended-resources
(make-parameter 1024))
(define max-suspended-resources-load
(make-parameter 0.75))
(define suspended-resource-handler
(let ((handler
(let ((mutex (make-mutex 'suspended-resources)))
(mutex-specific-set!
mutex (make-hash-table #:test string-ci=? #:hash string-ci-hash))
(lambda (resume/uuid)
(dynamic-wind
(cut mutex-lock! mutex)
(lambda ()
(let ((table (mutex-specific mutex)))
(if (procedure? resume/uuid)
(let ((size (hash-table-size table))
(max-size (max-suspended-resources)))
(when (>= size max-size)
(let* ((max-load (max-suspended-resources-load))
(num-drop (- size (* max-size max-load))))
(for-each
(cut hash-table-delete! table <>)
(take
(sort! (hash-table-keys table)
(lambda (a b)
(< (uuid-time a) (uuid-time b))))
(inexact->exact (ceiling num-drop))))))
(let ((uuid (make-uuid 'time)))
(hash-table-set! table uuid resume/uuid)
uuid))
(hash-table-ref/default table resume/uuid #f))))
(cut mutex-unlock! mutex))))))
(case-lambda
(()
handler)
((proc)
(set! handler proc)))))
................................................................................
request-parameter-handler
resource-context current-resource-context resource-context?
resource-context-getenv resource-context-return
response make-response response?
collect-response make-html-response make-error-response
response-status response-status-message
resource-handler define-resource resource-uri
max-suspended-resources max-suspended-resources-load
suspended-resource-handler
suspended
send/suspend
webgate-main)
(import
scheme chicken
webgate-core webgate-suspend webgate-cgi webgate-scgi tcp)
|