;; Structures and interfaces for surflets. ;; NOTE: SSAX/lib/packages.scm must be loaded before you can use this ;; downloadable from http://sourceforge.net/project/showfiles.php?group_id=30687 ;; (take the r5rs compliant version (ssax-sr5rs-plt200-4.9.tar.gz)) (define-interface rt-module-language-interface (export ((lambda-interface with-names-from-rt-structure) :syntax) reify-structure load-structure load-config-file rt-structure-binding)) (define-interface rt-modules-interface (export interface-value-names reify-structure load-config-file rt-structure-binding load-structure)) (define-structure rt-module-language rt-module-language-interface (open scheme rt-modules) (for-syntax (open scheme rt-modules)) (begin (define-syntax lambda-interface (lambda (expr rename compare) (let ((%lambda (rename 'lambda)) (interface-name (cadr expr)) (body (cddr expr))) `(,%lambda ,(interface-value-names interface-name) ,@body)))) ;(with-names-from-rt-structure surflet surflet-interface (main)) (define-syntax with-names-from-rt-structure (lambda (expr rename compare) (let ((%lambda (rename 'lambda)) (%let (rename 'let)) (%rt-structure-value (rename 'rt-structure-value)) (%rt-structure-binding (rename 'rt-structure-binding)) (rt-structure (cadr expr)) (interface-name (caddr expr)) (body (cdddr expr))) (let ((ivn (interface-value-names interface-name))) `(,%let ((,%rt-structure-value ,rt-structure)) ((,%lambda ,ivn ,@body) ,@(map (lambda (name) `(,%rt-structure-binding ,%rt-structure-value ',name)) ivn))))))))) (define-structure rt-modules rt-modules-interface (open scheme meta-types ; syntax-type interfaces ; for-each-declaration define-record-types records signals bindings packages packages-internal locations environments ensures-loaded package-commands-internal) (files rt-module)) (define-interface surflet-handler-interface (export surflet-handler)) (define-interface surflet-handler/surflets-interface (export send/suspend ;send and suspend send/finish ;send and finish send ;just send (no finish, no suspend) send-error ;send error response set-surflet-data! get-surflet-data adjust-timeout ;adjusts timeout of current session ;Without `!' because PLT ;doesn't have it. )) (define-interface surflet-handler/admin-interface (export get-loaded-surflets unload-surflet set-options-session-lifetime options-session-lifetime set-options-cache-surflets? options-cache-surflets? options-surflet-path options-surflet-prefix get-sessions session-surflet-name session-memo session-continuation-table session-continuation-table-lock session-continuation-counter delete-session! session-adjust-timeout! adjust-timeout get-continuations delete-continuation! instance-session-id resume-url? resume-url-ids resume-url-session-id resume-url-continuation-id)) (define-interface surflet-handler/responses-interface (export make-surflet-response surflet-response? surflet-response-status surflet-response-content-type surflet-response-headers surflet-response-data)) (define-structures ((surflet-handler surflet-handler-interface) (surflet-handler/surflets surflet-handler/surflets-interface) (surflet-handler/admin surflet-handler/admin-interface) (surflet-handler/responses surflet-handler/responses-interface)) (open httpd-responses httpd-requests httpd-errors uri ;URI-PATH-LIST->PATH tables ;HASH-TABLES define-record-types ;DEFINE-RECORD-TYPE rt-module-language ;get structures dynamically ; srfi-13 ;string srfi-14 ;CHAR-SET:DIGIT handle-fatal ;WITH-FATAL-ERROR-HANDLER* et al. srfi-27 ;random numbers locks ;MAKE-LOCK et al. thread-cells ;THREAD-CELL et al. profiling ;PROFILE-SPACE httpd-logging ;HTTP-SYSLOG shift-reset ;SHIFT and RESET threads ;SLEEP thread-fluids ;FORK-THREAD sxml-to-html ;SXML->HTML scheme-with-scsh ;regexp et al. srfi-6 ;string-ports thread-safe-counter ) (files surflet-handler)) (define-interface surflets-interface (export send/suspend send/finish send send-error send-html/suspend send-html/finish send-html form-query get-bindings extract-bindings extract-single-binding adjust-timeout make-outdater (if-outdated :syntax) show-outdated generate-input-field-name make-input-field make-higher-input-field make-text-input-field make-hidden-input-field make-password-input-field make-number-input-field make-textarea-input-field make-select-input-field make-checkbox-input-field make-radio-input-fields make-submit-button make-reset-button make-image-button input-field-value raw-input-field-value input-field-binding make-address returned-via? make-callback set-surflet-data! get-surflet-data)) (define-structure surflets surflets-interface (open surflet-handler/surflets surflet-handler/responses httpd-responses ; STATUS-CODE httpd-requests ; HTTP-URL:SEARCH url ; REQUEST:URL parse-html-forms sxml-to-html ; SXML->HTML srfi-1 ; FILTER (subset srfi-13 (string-index)) sxml-tree-trans define-record-types weak ;MAKE-WEAK-POINTER locks let-opt ;:OPTIONAL handle-fatal-error scsh scheme) (files surflets)) (define-interface surflet-interface (export main)) ; MAIN gets one parameter, the REQUEST (define-interface shift-reset-interface (export (reset :syntax) (shift :syntax))) (define-structure shift-reset shift-reset-interface (open scheme signals escapes thread-cells) (files shift-reset)) (define-interface profiling-interface (export profile-space profile-result profile-results write-gnuplot-data-file space-info-pair space-info-symbol space-info-vector space-info-closure space-info-location space-info-cell space-info-channel space-info-port space-info-ratnum space-info-record space-info-continuation space-info-extended-number space-info-template space-info-weak-pointer space-info-shared-binding space-info-unused-d-header1 space-info-unused-d-header2 space-info-string space-info-byte-vector space-info-double space-info-bignum space-info-total set-space-info-pair! set-space-info-symbol! set-space-info-vector! set-space-info-closure! set-space-info-location! set-space-info-cell! set-space-info-channel! set-space-info-port! set-space-info-ratnum! set-space-info-record! set-space-info-continuation! set-space-info-extended-number! set-space-info-template! set-space-info-weak-pointer! set-space-info-shared-binding! set-space-info-unused-d-header1! set-space-info-unused-d-header2! set-space-info-string! set-space-info-byte-vector! set-space-info-double! set-space-info-bignum! set-space-info-total! pure-count pure-bytes impure-count impure-bytes total-count total-bytes )) (define-structure profiling profiling-interface (open let-opt define-record-types spatial srfi-13 srfi-1 locks scsh scheme) (files profile)) (define-interface simple-surflet-api-interface (export single-query queries form-query inform final-page make-password make-number make-boolean make-radio make-yes-no extract/single extract)) (define-structure simple-surflet-api simple-surflet-api-interface (open scsh scheme define-record-types let-opt surflets (subset srfi-1 (zip filter find make-list)) handle-fatal-error ) (files simple-surflet-api)) (define-interface handle-fatal-interface (export with-fatal-handler* (with-fatal-handler :syntax))) (define-structure handle-fatal handle-fatal-interface (open scheme conditions handle) (files handle-fatal)) (define-interface thread-safe-counter-interface (export make-thread-safe-counter thread-safe-counter-value thread-safe-counter-next! thread-safe-counter?)) (define-structure thread-safe-counter thread-safe-counter-interface (open scheme locks define-record-types) (files thread-safe-counter))