Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | suspended resource and error handling tweaks |
|---|---|
| Downloads: | Tarball | ZIP archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
e657ff967bba947cd5b23bb8c1308eaa |
| User & Date: | murphy 2011-09-25 01:51:06.963 |
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 |
;;; Central server routine
(define (handle-request getenv input-port output-port)
(write-response
(handle-exceptions
exn (begin
| > > | > > | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 |
;;; 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
|
| ︙ | ︙ | |||
694 695 696 697 698 699 700 |
404 "The requested resource was not found by the server.")))
(make-response 204 '()))))
output-port))
)
(module webgate-suspend
| | > > > | | | < < | > > | | | | < | | | | > > > | | | | < | | 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 |
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)))))
|
| ︙ | ︙ | |||
821 822 823 824 825 826 827 | 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 | | | 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 | 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) |
| ︙ | ︙ |