rename PLUGIN --> SERVLET
This commit is contained in:
parent
349402b7cc
commit
85e75950a3
|
@ -32,7 +32,7 @@
|
||||||
(body (cddr expr)))
|
(body (cddr expr)))
|
||||||
`(,%lambda ,(interface-value-names interface-name) ,@body))))
|
`(,%lambda ,(interface-value-names interface-name) ,@body))))
|
||||||
|
|
||||||
;(with-names-from-rt-structure plugin plugin-interface (main))
|
;(with-names-from-rt-structure servlet servlet-interface (main))
|
||||||
(define-syntax with-names-from-rt-structure
|
(define-syntax with-names-from-rt-structure
|
||||||
(lambda (expr rename compare)
|
(lambda (expr rename compare)
|
||||||
(let ((%lambda (rename 'lambda))
|
(let ((%lambda (rename 'lambda))
|
||||||
|
@ -68,15 +68,15 @@
|
||||||
(define-interface servlet-handler-interface
|
(define-interface servlet-handler-interface
|
||||||
(export servlet-handler))
|
(export servlet-handler))
|
||||||
|
|
||||||
(define-interface servlet-handler/plugin-interface
|
(define-interface servlet-handler/servlet-interface
|
||||||
(export send/suspend ;send and suspend
|
(export send/suspend ;send and suspend
|
||||||
send/finish ;send and finish
|
send/finish ;send and finish
|
||||||
send ;just send (no finish, no suspend)
|
send ;just send (no finish, no suspend)
|
||||||
))
|
))
|
||||||
|
|
||||||
(define-interface servlet-handler/admin-interface
|
(define-interface servlet-handler/admin-interface
|
||||||
(export get-loaded-plugins
|
(export get-loaded-servlets
|
||||||
unload-plugin
|
unload-servlet
|
||||||
set-instance-lifetime!
|
set-instance-lifetime!
|
||||||
get-instance-lifetime
|
get-instance-lifetime
|
||||||
get-instances
|
get-instances
|
||||||
|
@ -89,7 +89,7 @@
|
||||||
|
|
||||||
(define-structures
|
(define-structures
|
||||||
((servlet-handler servlet-handler-interface)
|
((servlet-handler servlet-handler-interface)
|
||||||
(servlet-handler/plugin servlet-handler/plugin-interface)
|
(servlet-handler/servlet servlet-handler/servlet-interface)
|
||||||
(servlet-handler/admin servlet-handler/admin-interface))
|
(servlet-handler/admin servlet-handler/admin-interface))
|
||||||
(open httpd-responses
|
(open httpd-responses
|
||||||
httpd-request
|
httpd-request
|
||||||
|
@ -152,7 +152,7 @@
|
||||||
make-callback))
|
make-callback))
|
||||||
|
|
||||||
(define-structure servlets servlets-interface
|
(define-structure servlets servlets-interface
|
||||||
(open servlet-handler/plugin
|
(open servlet-handler/servlet
|
||||||
httpd-responses
|
httpd-responses
|
||||||
httpd-request ; HTTP-URL:SEARCH
|
httpd-request ; HTTP-URL:SEARCH
|
||||||
url ; REQUEST:URL
|
url ; REQUEST:URL
|
||||||
|
@ -167,7 +167,7 @@
|
||||||
scheme)
|
scheme)
|
||||||
(files servlets))
|
(files servlets))
|
||||||
|
|
||||||
(define-interface plugin-interface
|
(define-interface servlet-interface
|
||||||
(export main)) ; MAIN gets one parameter, the REQUEST
|
(export main)) ; MAIN gets one parameter, the REQUEST
|
||||||
|
|
||||||
(define-interface shift-reset-interface
|
(define-interface shift-reset-interface
|
||||||
|
|
|
@ -5,14 +5,14 @@
|
||||||
;;(load-config-file "test.scm") --> nothing
|
;;(load-config-file "test.scm") --> nothing
|
||||||
;; load config file containing structure definition
|
;; load config file containing structure definition
|
||||||
;;
|
;;
|
||||||
;; (reify-structure 'plugin) --> #{Rt-stucture plugin}
|
;; (reify-structure 'servlet) --> #{Rt-stucture servlet}
|
||||||
;; gets structure info about a structure
|
;; gets structure info about a structure
|
||||||
;;
|
;;
|
||||||
;; (define plugin ##)
|
;; (define servlet ##)
|
||||||
;; (load-structure plugin)
|
;; (load-structure servlet)
|
||||||
;; loads rt-structure
|
;; loads rt-structure
|
||||||
;;
|
;;
|
||||||
;; (rt-structure-binding plugin 'main) --> value
|
;; (rt-structure-binding servlet 'main) --> value
|
||||||
;; get a binding of a structure
|
;; get a binding of a structure
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -34,7 +34,7 @@
|
||||||
set-session-return-continuation!))
|
set-session-return-continuation!))
|
||||||
|
|
||||||
(define-record options
|
(define-record options
|
||||||
(cache-plugins? #t)
|
(cache-servlets? #t)
|
||||||
(instance-lifetime 600)) ; in seconds
|
(instance-lifetime 600)) ; in seconds
|
||||||
|
|
||||||
(define *options* (make-options))
|
(define *options* (make-options))
|
||||||
|
@ -65,12 +65,12 @@
|
||||||
; (make-http-error-response http-status/accepted req "profiled"))
|
; (make-http-error-response http-status/accepted req "profiled"))
|
||||||
; ((string=? path-string "reset") ; triggers cache clearing
|
; ((string=? path-string "reset") ; triggers cache clearing
|
||||||
; (http-syslog (syslog-level debug)
|
; (http-syslog (syslog-level debug)
|
||||||
; "servlet-handler: clearing plugin cache")
|
; "servlet-handler: clearing servlet cache")
|
||||||
; (reset-plugin-cache!)
|
; (reset-servlet-cache!)
|
||||||
; (http-syslog (syslog-level debug)
|
; (http-syslog (syslog-level debug)
|
||||||
; "servlet-handler: clearing instance table")
|
; "servlet-handler: clearing instance table")
|
||||||
; (reset-instance-table!)
|
; (reset-instance-table!)
|
||||||
; (make-http-error-response http-status/accepted req "plugin cache cleared"))
|
; (make-http-error-response http-status/accepted req "servlet cache cleared"))
|
||||||
((or (string=? request-method "GET")
|
((or (string=? request-method "GET")
|
||||||
; (string=? request-method "POST")) ; do this at later time
|
; (string=? request-method "POST")) ; do this at later time
|
||||||
)
|
)
|
||||||
|
@ -108,12 +108,12 @@
|
||||||
(make-thread-safe-counter))) ; continuation counter
|
(make-thread-safe-counter))) ; continuation counter
|
||||||
(release-lock *instance-table-lock*)
|
(release-lock *instance-table-lock*)
|
||||||
(register-session! instance-id 'no-return)
|
(register-session! instance-id 'no-return)
|
||||||
(let ((plugin (with-fatal-error-handler*
|
(let ((servlet (with-fatal-error-handler*
|
||||||
(lambda (condition decline)
|
(lambda (condition decline)
|
||||||
(instance-delete! instance-id)
|
(instance-delete! instance-id)
|
||||||
(decline))
|
(decline))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(get-plugin-rt-structure path-string servlet-path)))))
|
(get-servlet-rt-structure path-string servlet-path)))))
|
||||||
(fork-thread (instance-surveillance instance-id
|
(fork-thread (instance-surveillance instance-id
|
||||||
(+ (time)
|
(+ (time)
|
||||||
(options:instance-lifetime *options*))
|
(options:instance-lifetime *options*))
|
||||||
|
@ -123,7 +123,7 @@
|
||||||
(with-cwd
|
(with-cwd
|
||||||
servlet-path
|
servlet-path
|
||||||
(with-names-from-rt-structure
|
(with-names-from-rt-structure
|
||||||
plugin plugin-interface
|
servlet servlet-interface
|
||||||
(main req))))))))))
|
(main req))))))))))
|
||||||
|
|
||||||
(define (instance-surveillance instance-id time-to-die memo)
|
(define (instance-surveillance instance-id time-to-die memo)
|
||||||
|
@ -307,77 +307,77 @@
|
||||||
id)))
|
id)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; PLUGINs CACHE
|
;; SERVLETs CACHE
|
||||||
(define *plugin-table* (make-string-table)) ; path-string is index
|
(define *servlet-table* (make-string-table)) ; path-string is index
|
||||||
(define *plugin-table-lock* (make-lock))
|
(define *servlet-table-lock* (make-lock))
|
||||||
|
|
||||||
;; PLUGIN-NAME is like "news-dir/latest-news.scm"
|
;; SERVLET-NAME is like "news-dir/latest-news.scm"
|
||||||
(define (get-plugin-rt-structure plugin-name directory)
|
(define (get-servlet-rt-structure servlet-name directory)
|
||||||
(let* ((full-plugin-name (absolute-file-name plugin-name directory))
|
(let* ((full-servlet-name (absolute-file-name servlet-name directory))
|
||||||
(load-plugin
|
(load-servlet
|
||||||
(lambda (cached?)
|
(lambda (cached?)
|
||||||
(with-fatal-error-handler*
|
(with-fatal-error-handler*
|
||||||
(lambda (condition decline)
|
(lambda (condition decline)
|
||||||
(if cached? (release-lock *plugin-table-lock*))
|
(if cached? (release-lock *servlet-table-lock*))
|
||||||
(decline))
|
(decline))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
;; load-config-file does not care about cwd(?)
|
;; load-config-file does not care about cwd(?)
|
||||||
;; --> absolute file name needed
|
;; --> absolute file name needed
|
||||||
(load-config-file full-plugin-name)
|
(load-config-file full-servlet-name)
|
||||||
;; plugin-structure to load must be named "plugin"
|
;; servlet-structure to load must be named "servlet"
|
||||||
(let ((plugin-structure (reify-structure 'plugin)))
|
(let ((plugin-structure (reify-structure 'servlet)))
|
||||||
(load-structure plugin-structure)
|
(load-structure servlet-structure)
|
||||||
(if cached?
|
(if cached?
|
||||||
(begin
|
(begin
|
||||||
(table-set! *plugin-table* full-plugin-name
|
(table-set! *servlet-table* full-servlet-name
|
||||||
(cons plugin-structure
|
(cons servlet-structure
|
||||||
(file-last-mod full-plugin-name)))
|
(file-last-mod full-servlet-name)))
|
||||||
;; only now the lock may be released
|
;; only now the lock may be released
|
||||||
(release-lock *plugin-table-lock*)))
|
(release-lock *servlet-table-lock*)))
|
||||||
plugin-structure))))))
|
servlet-structure))))))
|
||||||
(if (options:cache-plugins? *options*)
|
(if (options:cache-servlets? *options*)
|
||||||
(begin
|
(begin
|
||||||
;; The lock is only obtained and released, if plugins are
|
;; The lock is only obtained and released, if servlets are
|
||||||
;; cached. LOAD-PLUGIN gets the CACHED? parameter, so
|
;; cached. LOAD-SERVLET gets the CACHED? parameter, so
|
||||||
;; nothing may happen, if in the meanwhile caching is turned
|
;; nothing may happen, if in the meanwhile caching is turned
|
||||||
;; off.
|
;; off.
|
||||||
(obtain-lock *plugin-table-lock*)
|
(obtain-lock *servlet-table-lock*)
|
||||||
(let ((plugin (table-ref *plugin-table* full-plugin-name)))
|
(let ((servlet (table-ref *servlet-table* full-servlet-name)))
|
||||||
(if plugin
|
(if servlet
|
||||||
(if (equal? (file-last-mod full-plugin-name)
|
(if (equal? (file-last-mod full-servlet-name)
|
||||||
(cdr plugin))
|
(cdr servlet))
|
||||||
(begin
|
(begin
|
||||||
(release-lock *plugin-table-lock*)
|
(release-lock *servlet-table-lock*)
|
||||||
(car plugin))
|
(car servlet))
|
||||||
(load-plugin #t))
|
(load-servlet #t))
|
||||||
(load-plugin #t))))
|
(load-servlet #t))))
|
||||||
(load-plugin #f))))
|
(load-servlet #f))))
|
||||||
|
|
||||||
(define (get-loaded-plugins)
|
(define (get-loaded-servlets)
|
||||||
(obtain-lock *plugin-table-lock*)
|
(obtain-lock *servlet-table-lock*)
|
||||||
(let ((loaded-plugins '()))
|
(let ((loaded-servlets '()))
|
||||||
(table-walk
|
(table-walk
|
||||||
(lambda (plugin-path rt-structure)
|
(lambda (servlet-path rt-structure)
|
||||||
(set! loaded-plugins (cons plugin-path loaded-plugins)))
|
(set! loaded-servlets (cons servlet-path loaded-servlets)))
|
||||||
*plugin-table*)
|
*servlet-table*)
|
||||||
(release-lock *plugin-table-lock*)
|
(release-lock *servlet-table-lock*)
|
||||||
loaded-plugins))
|
loaded-servlets))
|
||||||
|
|
||||||
(define (unload-plugin plugin-name)
|
(define (unload-servlet servlet-name)
|
||||||
(obtain-lock *plugin-table-lock*)
|
(obtain-lock *servlet-table-lock*)
|
||||||
(if (table-ref *plugin-table* plugin-name)
|
(if (table-ref *servlet-table* servlet-name)
|
||||||
(table-set! *plugin-table* plugin-name #f))
|
(table-set! *servlet-table* servlet-name #f))
|
||||||
(release-lock *plugin-table-lock*))
|
(release-lock *servlet-table-lock*))
|
||||||
|
|
||||||
(define (reset-plugin-cache!)
|
(define (reset-servlet-cache!)
|
||||||
(with-fatal-error-handler*
|
(with-fatal-error-handler*
|
||||||
(lambda (condition decline)
|
(lambda (condition decline)
|
||||||
(release-lock *plugin-table-lock*)
|
(release-lock *servlet-table-lock*)
|
||||||
(decline))
|
(decline))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(obtain-lock *plugin-table-lock*)
|
(obtain-lock *servlet-table-lock*)
|
||||||
(set! *plugin-table* (make-string-table))
|
(set! *servlet-table* (make-string-table))
|
||||||
(release-lock *plugin-table-lock*))))
|
(release-lock *servlet-table-lock*))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; SESSION
|
;; SESSION
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
;; utilities for plugin (servlets)
|
;; utilities for servlet
|
||||||
;; Copyright 2002, Andreas Bernauer
|
;; Copyright 2002, Andreas Bernauer
|
||||||
|
|
||||||
(define (send-html/suspend html-tree-maker)
|
(define (send-html/suspend html-tree-maker)
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(define-structure plugin plugin-interface
|
(define-structure servlet servlet-interface
|
||||||
(open servlets
|
(open servlets
|
||||||
httpd-request
|
httpd-request
|
||||||
url
|
url
|
||||||
|
@ -14,7 +14,7 @@
|
||||||
`(title ,title) '())
|
`(title ,title) '())
|
||||||
(body
|
(body
|
||||||
,(if title `(h1 ,title) '())
|
,(if title `(h1 ,title) '())
|
||||||
(p (a (@ href "reset") "click here to reset server's plugin cache"))
|
(p (a (@ href "reset") "click here to reset server's servlet cache"))
|
||||||
(p
|
(p
|
||||||
(form (@ (method "get")
|
(form (@ (method "get")
|
||||||
(action ,new-url))
|
(action ,new-url))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(define-structure plugin plugin-interface
|
(define-structure servlet servlet-interface
|
||||||
(open servlets
|
(open servlets
|
||||||
httpd-request
|
httpd-request
|
||||||
url
|
url
|
||||||
|
@ -18,7 +18,7 @@
|
||||||
(body
|
(body
|
||||||
,(if title `(h1 ,title) '())
|
,(if title `(h1 ,title) '())
|
||||||
(p (a (@ href "reset")
|
(p (a (@ href "reset")
|
||||||
"click here to reset server's plugin cache"))
|
"click here to reset server's servlet cache"))
|
||||||
(p
|
(p
|
||||||
(servlet-form ,new-url
|
(servlet-form ,new-url
|
||||||
,input-text
|
,input-text
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(define-structure plugin plugin-interface
|
(define-structure servlet servlet-interface
|
||||||
(open servlets
|
(open servlets
|
||||||
httpd-request
|
httpd-request
|
||||||
handle-fatal-error
|
handle-fatal-error
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(define-structure plugin plugin-interface
|
(define-structure servlet servlet-interface
|
||||||
(open servlets
|
(open servlets
|
||||||
httpd-request
|
httpd-request
|
||||||
scsh
|
scsh
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(define-structure plugin plugin-interface
|
(define-structure servlet servlet-interface
|
||||||
(open scsh
|
(open scsh
|
||||||
scheme
|
scheme
|
||||||
servlets
|
servlets
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(define-structure plugin plugin-interface
|
(define-structure servlet servlet-interface
|
||||||
(open scsh
|
(open scsh
|
||||||
scheme
|
scheme
|
||||||
servlets
|
servlets
|
||||||
|
|
Loading…
Reference in New Issue