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))) (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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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))

View File

@ -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

View File

@ -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

View File

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

View File

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

View File

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