+ longer standard instance lifetime
+ instance lifetime adjusted when new continuation is launched + GET-LOADED-PLUGINS and UNLOAD-PLUGIN + small bug fixes
This commit is contained in:
interp
parent
d6c4304f45
commit
30e66edc61
|
|
@ -2,7 +2,7 @@
|
|||
;; Copyright Andreas Bernauer, 2002
|
||||
|
||||
|
||||
(define *debug* #f)
|
||||
(define *debug* #t)
|
||||
|
||||
;;; instance-table: entry for every new request on a servlet page
|
||||
(define-record-type instance :instance
|
||||
|
|
@ -31,7 +31,7 @@
|
|||
|
||||
(define-record options
|
||||
(cache-plugins? #t)
|
||||
(instance-lifetime 10)) ; in seconds
|
||||
(instance-lifetime 60)) ; in seconds
|
||||
|
||||
(define *options* (make-options))
|
||||
;(define *options-lock* (make-lock)) ; currently unused
|
||||
|
|
@ -53,19 +53,19 @@
|
|||
(let ((request-method (request:method req))
|
||||
(path-string (uri-path-list->path path)))
|
||||
(cond
|
||||
((string=? path-string "profile") ; triggers profiling
|
||||
(http-syslog (syslog-level debug)
|
||||
"profiling: triggered in servlet-handler [~a]"
|
||||
(profile-space)) ; PROFILE
|
||||
(make-http-error-response http-status/accepted req "profiled"))
|
||||
((string=? path-string "reset") ; triggers cache clearing
|
||||
(http-syslog (syslog-level debug)
|
||||
"servlet-handler: clearing plugin cache")
|
||||
(reset-plugin-cache!)
|
||||
(http-syslog (syslog-level debug)
|
||||
"servlet-handler: clearing instance table")
|
||||
(reset-instance-table!)
|
||||
(make-http-error-response http-status/accepted req "plugin cache cleared"))
|
||||
; ((string=? path-string "profile") ; triggers profiling
|
||||
; (http-syslog (syslog-level debug)
|
||||
; "profiling: triggered in servlet-handler [~a]"
|
||||
; (profile-space)) ; PROFILE
|
||||
; (make-http-error-response http-status/accepted req "profiled"))
|
||||
; ((string=? path-string "reset") ; triggers cache clearing
|
||||
; (http-syslog (syslog-level debug)
|
||||
; "servlet-handler: clearing plugin cache")
|
||||
; (reset-plugin-cache!)
|
||||
; (http-syslog (syslog-level debug)
|
||||
; "servlet-handler: clearing instance table")
|
||||
; (reset-instance-table!)
|
||||
; (make-http-error-response http-status/accepted req "plugin cache cleared"))
|
||||
((or (string=? request-method "GET")
|
||||
; (string=? request-method "POST")) ; do this at later time
|
||||
)
|
||||
|
|
@ -117,8 +117,8 @@
|
|||
(lambda ()
|
||||
(let loop ((time-to-die time-to-die)
|
||||
(memo memo))
|
||||
(format #t "instance-surveillance[~s]: going to sleep until ~a~%"
|
||||
instance-id (format-date "~c" (date time-to-die)))
|
||||
(debug "instance-surveillance[~s]: going to sleep until ~a~%"
|
||||
instance-id (format-date "~c" (date time-to-die)))
|
||||
(let ((seconds-to-sleep (- time-to-die (time))))
|
||||
(if (positive? seconds-to-sleep)
|
||||
(sleep (* 1000 seconds-to-sleep))))
|
||||
|
|
@ -150,8 +150,16 @@
|
|||
(lambda (path-string req)
|
||||
(make-http-error-response
|
||||
http-status/bad-request req
|
||||
(format #f "The servlet does not accept any requests any more or your URL is illformed.<BR>
|
||||
You can try starting at the <A HREF=~a>beginning</a>."
|
||||
(format #f
|
||||
"<br>
|
||||
<p>There may be several reasons, why your request was denied:
|
||||
<ul>
|
||||
<li>The servlet does not accept any requests any more.</li>
|
||||
<li>The servlet URL has timed out.</li>
|
||||
<li>You URL is illformed.</li>
|
||||
</ul>
|
||||
</p>
|
||||
<p>In any case, you may try to restart the servlet from the <a href=\"~a\">beginning</a></p>"
|
||||
(resume-url-servlet-name path-string)))))
|
||||
(lookup-continuation-table
|
||||
(lambda (instance continuation-table continuation-id)
|
||||
|
|
@ -184,20 +192,20 @@ You can try starting at the <A HREF=~a>beginning</a>."
|
|||
(define (send/suspend response-maker)
|
||||
(shift return
|
||||
(let* ((instance-id (session-instance-id))
|
||||
(instance (instance-lookup instance-id))
|
||||
(continuations-table (instance-continuation-table instance))
|
||||
(continuation-table-lock (instance-continuation-table-lock instance))
|
||||
(continuation-counter (instance-next-continuation-counter instance)))
|
||||
(obtain-lock continuation-table-lock)
|
||||
(let ((continuation-id (generate-new-table-id continuations-table)))
|
||||
(table-set! continuations-table continuation-id return)
|
||||
(release-lock continuation-table-lock)
|
||||
(let ((new-url (make-resume-url (instance-servlet-name instance)
|
||||
instance-id
|
||||
continuation-counter
|
||||
continuation-id)))
|
||||
(response-maker new-url))))))
|
||||
|
||||
(instance (instance-lookup instance-id)))
|
||||
(instance-adjust-timeout! instance-id)
|
||||
(let ((continuations-table (instance-continuation-table instance))
|
||||
(continuation-table-lock (instance-continuation-table-lock instance))
|
||||
(continuation-counter (instance-next-continuation-counter instance)))
|
||||
(obtain-lock continuation-table-lock)
|
||||
(let ((continuation-id (generate-new-table-id continuations-table)))
|
||||
(table-set! continuations-table continuation-id return)
|
||||
(release-lock continuation-table-lock)
|
||||
(let ((new-url (make-resume-url (instance-servlet-name instance)
|
||||
instance-id
|
||||
continuation-counter
|
||||
continuation-id)))
|
||||
(response-maker new-url)))))))
|
||||
|
||||
(define (send/finish response)
|
||||
(instance-delete! (session-instance-id))
|
||||
|
|
@ -239,8 +247,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
|
|||
(+ (time)
|
||||
(options:instance-lifetime *options*)))
|
||||
(set-memo:new-memo memo new-memo)
|
||||
;; FIXME: We change instance entry's value. Do we need locking
|
||||
;; here?
|
||||
;; I don't think we need locking here. Do you agree?
|
||||
(set-instance-memo! instance new-memo)
|
||||
(set-memo:message memo 'adjust-timeout))
|
||||
(release-lock *instance-table-lock*))
|
||||
|
|
@ -252,6 +259,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
|
|||
(decline))
|
||||
(lambda ()
|
||||
(obtain-lock *instance-table-lock*)
|
||||
;; notify instance killing
|
||||
(table-walk
|
||||
(lambda (instance-id instance)
|
||||
(memo-killed! (instance-memo instance)))
|
||||
|
|
@ -322,6 +330,22 @@ You can try starting at the <A HREF=~a>beginning</a>."
|
|||
(load-plugin #t))))
|
||||
(load-plugin #f))))
|
||||
|
||||
(define (get-loaded-plugins)
|
||||
(obtain-lock *plugin-table-lock*)
|
||||
(let ((loaded-plugins '()))
|
||||
(table-walk
|
||||
(lambda (plugin-path rt-structure)
|
||||
(set! loaded-plugins (cons plugin-path loaded-plugins)))
|
||||
*plugin-table*)
|
||||
(release-lock *plugin-table-lock*)
|
||||
loaded-plugins))
|
||||
|
||||
(define (unload-plugin plugin-name)
|
||||
(obtain-lock *plugin-table-lock*)
|
||||
(if (table-ref *plugin-table* plugin-name)
|
||||
(table-set! *plugin-table* plugin-name #f))
|
||||
(release-lock *plugin-table-lock*))
|
||||
|
||||
(define (reset-plugin-cache!)
|
||||
(with-fatal-error-handler*
|
||||
(lambda (condition decline)
|
||||
|
|
@ -393,7 +417,10 @@ You can try starting at the <A HREF=~a>beginning</a>."
|
|||
;; access to options
|
||||
|
||||
(define (set-instance-lifetime! new-lifetime)
|
||||
(set-options:instance-lifetime new-lifetime))
|
||||
(set-options:instance-lifetime *options* new-lifetime))
|
||||
|
||||
(define (get-instance-lifetime)
|
||||
(options:instance-lifetime *options*))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; thread-safe counter
|
||||
|
|
|
|||
Loading…
Reference in New Issue