diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index 3185855..89a3d97 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -93,6 +93,7 @@ httpd-logging ;HTTP-SYSLOG shift-reset ;SHIFT and RESET conditions ;exception + defrec-package ;define-record scsh ;regexp et al. scheme ) @@ -106,6 +107,7 @@ send-html/finish send-html form-query + get-bindings extract-bindings extract-single-binding generate-input-field-name @@ -125,9 +127,11 @@ (define-structure servlets servlets-interface (open servlet-handler/plugin httpd-responses + httpd-request ; HTTP-URL:SEARCH + url ; REQUEST:URL parse-html-forms - sxml-to-html ;SXML->HTML - srfi-1 ;FILTER + sxml-to-html ; SXML->HTML + srfi-1 ; FILTER sxml-tree-trans url httpd-request diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index 17b3cf5..52e2cc1 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -20,8 +20,15 @@ (return-continuation really-session-return-continuation set-session-return-continuation!)) +(define-record options + (cache-plugins? #t)) + +(define *options* (make-options)) +;(define *options-lock* (make-lock)) ; currently unused + (define *instance-table* (make-integer-table)) ; instance-id is index (define *instance-table-lock* (make-lock)) + (define random (let* ((source (make-random-source)) (random-integer (begin @@ -190,10 +197,10 @@ You can try starting at the beginning." (define (get-plugin-rt-structure plugin-name directory) (let* ((full-plugin-name (absolute-file-name plugin-name directory)) (load-plugin - (lambda () + (lambda (cached?) (with-fatal-error-handler* (lambda (condition decline) - (release-lock *plugin-table-lock*) + (if cached? (release-lock *plugin-table-lock*)) (decline)) (lambda () ;; load-config-file does not care about cwd(?) @@ -202,23 +209,32 @@ You can try starting at the beginning." ;; plugin-structure to load must be named "plugin" (let ((plugin-structure (reify-structure 'plugin))) (load-structure plugin-structure) - (table-set! *plugin-table* full-plugin-name - (cons plugin-structure - (file-last-mod full-plugin-name))) - ;; only now the lock may be released - (release-lock *plugin-table-lock*) + (if cached? + (begin + (table-set! *plugin-table* full-plugin-name + (cons plugin-structure + (file-last-mod full-plugin-name))) + ;; only now the lock may be released + (release-lock *plugin-table-lock*))) plugin-structure)))))) - (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)) - (begin - (release-lock *plugin-table-lock*) - (car plugin)) - (load-plugin)) - (load-plugin))))) + (if (options:cache-plugins? *options*) + (begin + ;; The lock is only obtained and released, if plugins are + ;; cached. LOAD-PLUGIN 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)) + (begin + (release-lock *plugin-table-lock*) + (car plugin)) + (load-plugin #t)) + (load-plugin #t)))) + (load-plugin #f)))) (define (reset-plugin-cache!) (with-fatal-error-handler*