scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove old code from Gbe Engelhart.

This commit is contained in:
sperber 2002-08-26 11:46:27 +00:00
parent 2f5f46cb5f
commit 3b298aadcc
2 changed files with 0 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
program-modules.scm
View File

@ -1,48 +0,0 @@
;;; Scheme 48 module definitions for Scheme program execution.
;;; Gebhard Engelhart.
(define-structure scheme-program-server-package (export scheme-program-handler
runprogram)
(open strings
rfc822
crlf-io ; WRITE-CRLF
uri-package
url-package ; HTTP-URL record type
httpd-core ; REQUEST record type, HTTP-ERROR & reply codes
; version stuff
httpd-basic-handlers ; HTTP-HOMEDIR, SERVE-ROOTED-FILE-PATH
httpd-error ; HTTP-ERROR
scsh-utilities ; INDEX
scsh ; syscalls
formats ; format
condhax ; ? is COND
switch-syntax ; SWITCHQ
scheme)
(files (httpd scheme-program-server)))
;;; package to load scheme programs
;;
;; source files are missing!?
;;
;;; (define-structure scheme-programs-package (export testprog
;;; info2www)
;;; (open scsh ; syscalls & INDEX
;;; condhax ; WHEN, ? for COND
;;; switch-syntax ; Conditionals
;;; defrec-package ; Records
;;; htmlout-package ; Formatted HTML output
;;; httpd-core ; REQUEST record type, HTTP-ERROR & reply codes
;;; ; version stuff
;;; uri-package ; UNESCAPE-URI
;;; error-package ; ERROR
;;; pp ; Pretty-printer
;;; strings rfc822
;;; toothless-eval ; EVAL-SAFELY
;;; handle ; IGNORE-ERROR
;;; strings ; SKIP-WHITESPACE
;;; parse-html-forms ; PARSE-HTML-FORM-QUERY
;;; scheme)
;;; (files testprog
;;; info2www))

57
scheme/httpd/scheme-program-server.scm
View File

@ -1,57 +0,0 @@
(define scheme-program-handler
(lambda (path req)
(if (pair? path) ; Got to have at least one elt.
(let* ((prog (car path))
(search (http-url:search (request:url req))) ; Compute the
(arglist (if (and search (not (index search #\=))) ; argv list.
(split-and-decode-search-spec search)
'()))
(env (exec-env req (cdr path))) ; set global environment vars
(doit (lambda ()
((runprogram prog) arglist))))
(and (http-syslog (syslog-level debug)
"scheme-program-handler:~% Programmname : ~s~% search : ~s~% Argumente : ~s~%" prog search arglist)
(let ((request-method (request:method req)))
(if (or (string=? request-method "GET")
(string=? request-method "POST")) ; Could do others also.
(wait (fork doit))
(http-error http-status/method-not-allowed req))))
(http-error http-status/bad-request req "Error "))))
(define (runprogram progstring)
(let* ( (progsymbol (read (make-string-input-port progstring)))
(progsymbol1 (string->symbol progstring)))
(and (http-syslog (syslog-level debug)
"[]run-program ~s ~s ~s~%" progstring progsymbol progsymbol1)
(eval progsymbol (interaction-environment)))))
(define (split-and-decode-search-spec s)
(let recur ((i 0))
(cond ((index s #\+ i) => (lambda (j) (cons (unescape-uri s i j)
(recur (+ j 1)))))
(else (list (unescape-uri s i (string-length s)))))))
(define url-path)
(define script-path)
(define script-name)
(define (exec-env req path-suffix)
(let* (;; Compute the $SCRIPT_PATH string.
(url-path1 (http-url:path (request:url req)))
(script-path1 (take (- (length url-path1) (length path-suffix))
url-path1))
(script-name1 (uri-path-list->path script-path1)))
(and (set! url-path url-path1)
(set! script-path script-path1)
(set! script-name script-name1))))
(define (take n lis)
(if (zero? n) '()
(cons (car lis) (take (- n 1) (cdr lis)))))
(define (drop n lis)
(if (zero? n) lis
(drop (- n 1) (cdr lis))))