rename PLUGIN --> SERVLET

This commit is contained in:
interp 2002-10-01 12:33:39 +00:00
parent 349402b7cc
commit 85e75950a3
10 changed files with 75 additions and 75 deletions

View File

@ -32,7 +32,7 @@
(body (cddr expr)))
`(,%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
(lambda (expr rename compare)
(let ((%lambda (rename 'lambda))
@ -68,15 +68,15 @@
(define-interface servlet-handler-interface
(export servlet-handler))
(define-interface servlet-handler/plugin-interface
(define-interface servlet-handler/servlet-interface
(export send/suspend ;send and suspend
send/finish ;send and finish
send ;just send (no finish, no suspend)
))
(define-interface servlet-handler/admin-interface
(export get-loaded-plugins
unload-plugin
(export get-loaded-servlets
unload-servlet
set-instance-lifetime!
get-instance-lifetime
get-instances
@ -89,7 +89,7 @@
(define-structures
((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))
(open httpd-responses
httpd-request
@ -152,7 +152,7 @@
make-callback))
(define-structure servlets servlets-interface
(open servlet-handler/plugin
(open servlet-handler/servlet
httpd-responses
httpd-request ; HTTP-URL:SEARCH
url ; REQUEST:URL
@ -167,7 +167,7 @@
scheme)
(files servlets))
(define-interface plugin-interface
(define-interface servlet-interface
(export main)) ; MAIN gets one parameter, the REQUEST
(define-interface shift-reset-interface

View File

@ -5,14 +5,14 @@
;;(load-config-file "test.scm") --> nothing
;; load config file containing structure definition
;;
;; (reify-structure 'plugin) --> #{Rt-stucture plugin}
;; (reify-structure 'servlet) --> #{Rt-stucture servlet}
;; gets structure info about a structure
;;
;; (define plugin ##)
;; (load-structure plugin)
;; (define servlet ##)
;; (load-structure servlet)
;; loads rt-structure
;;
;; (rt-structure-binding plugin 'main) --> value
;; (rt-structure-binding servlet 'main) --> value
;; get a binding of a structure

View File

@ -34,7 +34,7 @@
set-session-return-continuation!))
(define-record options
(cache-plugins? #t)
(cache-servlets? #t)
(instance-lifetime 600)) ; in seconds
(define *options* (make-options))
@ -65,12 +65,12 @@
; (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!)
; "servlet-handler: clearing servlet cache")
; (reset-servlet-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"))
; (make-http-error-response http-status/accepted req "servlet cache cleared"))
((or (string=? request-method "GET")
; (string=? request-method "POST")) ; do this at later time
)
@ -108,12 +108,12 @@
(make-thread-safe-counter))) ; continuation counter
(release-lock *instance-table-lock*)
(register-session! instance-id 'no-return)
(let ((plugin (with-fatal-error-handler*
(let ((servlet (with-fatal-error-handler*
(lambda (condition decline)
(instance-delete! instance-id)
(decline))
(lambda ()
(get-plugin-rt-structure path-string servlet-path)))))
(get-servlet-rt-structure path-string servlet-path)))))
(fork-thread (instance-surveillance instance-id
(+ (time)
(options:instance-lifetime *options*))
@ -123,7 +123,7 @@
(with-cwd
servlet-path
(with-names-from-rt-structure
plugin plugin-interface
servlet servlet-interface
(main req))))))))))
(define (instance-surveillance instance-id time-to-die memo)
@ -307,77 +307,77 @@
id)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLUGINs CACHE
(define *plugin-table* (make-string-table)) ; path-string is index
(define *plugin-table-lock* (make-lock))
;; SERVLETs CACHE
(define *servlet-table* (make-string-table)) ; path-string is index
(define *servlet-table-lock* (make-lock))
;; PLUGIN-NAME is like "news-dir/latest-news.scm"
(define (get-plugin-rt-structure plugin-name directory)
(let* ((full-plugin-name (absolute-file-name plugin-name directory))
(load-plugin
;; SERVLET-NAME is like "news-dir/latest-news.scm"
(define (get-servlet-rt-structure servlet-name directory)
(let* ((full-servlet-name (absolute-file-name servlet-name directory))
(load-servlet
(lambda (cached?)
(with-fatal-error-handler*
(lambda (condition decline)
(if cached? (release-lock *plugin-table-lock*))
(if cached? (release-lock *servlet-table-lock*))
(decline))
(lambda ()
;; load-config-file does not care about cwd(?)
;; --> absolute file name needed
(load-config-file full-plugin-name)
;; plugin-structure to load must be named "plugin"
(let ((plugin-structure (reify-structure 'plugin)))
(load-structure plugin-structure)
(load-config-file full-servlet-name)
;; servlet-structure to load must be named "servlet"
(let ((plugin-structure (reify-structure 'servlet)))
(load-structure servlet-structure)
(if cached?
(begin
(table-set! *plugin-table* full-plugin-name
(cons plugin-structure
(file-last-mod full-plugin-name)))
(table-set! *servlet-table* full-servlet-name
(cons servlet-structure
(file-last-mod full-servlet-name)))
;; only now the lock may be released
(release-lock *plugin-table-lock*)))
plugin-structure))))))
(if (options:cache-plugins? *options*)
(release-lock *servlet-table-lock*)))
servlet-structure))))))
(if (options:cache-servlets? *options*)
(begin
;; The lock is only obtained and released, if plugins are
;; cached. LOAD-PLUGIN gets the CACHED? parameter, so
;; The lock is only obtained and released, if servlets are
;; cached. LOAD-SERVLET gets the CACHED? parameter, so
;; nothing may happen, if in the meanwhile caching is turned
;; off.
(obtain-lock *plugin-table-lock*)
(let ((plugin (table-ref *plugin-table* full-plugin-name)))
(if plugin
(if (equal? (file-last-mod full-plugin-name)
(cdr plugin))
(obtain-lock *servlet-table-lock*)
(let ((servlet (table-ref *servlet-table* full-servlet-name)))
(if servlet
(if (equal? (file-last-mod full-servlet-name)
(cdr servlet))
(begin
(release-lock *plugin-table-lock*)
(car plugin))
(load-plugin #t))
(load-plugin #t))))
(load-plugin #f))))
(release-lock *servlet-table-lock*)
(car servlet))
(load-servlet #t))
(load-servlet #t))))
(load-servlet #f))))
(define (get-loaded-plugins)
(obtain-lock *plugin-table-lock*)
(let ((loaded-plugins '()))
(define (get-loaded-servlets)
(obtain-lock *servlet-table-lock*)
(let ((loaded-servlets '()))
(table-walk
(lambda (plugin-path rt-structure)
(set! loaded-plugins (cons plugin-path loaded-plugins)))
*plugin-table*)
(release-lock *plugin-table-lock*)
loaded-plugins))
(lambda (servlet-path rt-structure)
(set! loaded-servlets (cons servlet-path loaded-servlets)))
*servlet-table*)
(release-lock *servlet-table-lock*)
loaded-servlets))
(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 (unload-servlet servlet-name)
(obtain-lock *servlet-table-lock*)
(if (table-ref *servlet-table* servlet-name)
(table-set! *servlet-table* servlet-name #f))
(release-lock *servlet-table-lock*))
(define (reset-plugin-cache!)
(define (reset-servlet-cache!)
(with-fatal-error-handler*
(lambda (condition decline)
(release-lock *plugin-table-lock*)
(release-lock *servlet-table-lock*)
(decline))
(lambda ()
(obtain-lock *plugin-table-lock*)
(set! *plugin-table* (make-string-table))
(release-lock *plugin-table-lock*))))
(obtain-lock *servlet-table-lock*)
(set! *servlet-table* (make-string-table))
(release-lock *servlet-table-lock*))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SESSION

View File

@ -1,4 +1,4 @@
;; utilities for plugin (servlets)
;; utilities for servlet
;; Copyright 2002, Andreas Bernauer
(define (send-html/suspend html-tree-maker)

View File

@ -1,4 +1,4 @@
(define-structure plugin plugin-interface
(define-structure servlet servlet-interface
(open servlets
httpd-request
url
@ -14,7 +14,7 @@
`(title ,title) '())
(body
,(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
(form (@ (method "get")
(action ,new-url))

View File

@ -1,4 +1,4 @@
(define-structure plugin plugin-interface
(define-structure servlet servlet-interface
(open servlets
httpd-request
url
@ -18,7 +18,7 @@
(body
,(if title `(h1 ,title) '())
(p (a (@ href "reset")
"click here to reset server's plugin cache"))
"click here to reset server's servlet cache"))
(p
(servlet-form ,new-url
,input-text

View File

@ -1,4 +1,4 @@
(define-structure plugin plugin-interface
(define-structure servlet servlet-interface
(open servlets
httpd-request
handle-fatal-error

View File

@ -1,4 +1,4 @@
(define-structure plugin plugin-interface
(define-structure servlet servlet-interface
(open servlets
httpd-request
scsh

View File

@ -1,4 +1,4 @@
(define-structure plugin plugin-interface
(define-structure servlet servlet-interface
(open scsh
scheme
servlets

View File

@ -1,4 +1,4 @@
(define-structure plugin plugin-interface
(define-structure servlet servlet-interface
(open scsh
scheme
servlets