433 lines
9.8 KiB
Scheme
433 lines
9.8 KiB
Scheme
;;; Scheme 48 module definitions for TCP/IP protocol suites.
|
|
;;; Copyright (c) 1995 by Olin Shivers.
|
|
|
|
(define-structures
|
|
((smtp (export sendmail %sendmail
|
|
expn vrfy mail-help
|
|
smtp-transactions
|
|
smtp-transactions/no-close
|
|
smtp/open smtp/helo smtp/mail smtp/rcpt smtp/data
|
|
smtp/send smtp/soml smtp/saml smtp/rset smtp/expn
|
|
smtp/help smtp/noop smtp/quit smtp/turn
|
|
handle-smtp-reply
|
|
read-smtp-reply
|
|
parse-smtp-reply
|
|
smtp-stuff))
|
|
(smtp-internals (export read-crlf-line ; These two should be in an
|
|
write-crlf ; auxiliary module.
|
|
|
|
smtp-query
|
|
nullary-smtp-command
|
|
unary-smtp-command)))
|
|
|
|
|
|
(open scsh ; write-string read-string/partial force-output
|
|
; system-name user-login-name and sockets
|
|
crlf-io ; read-crlf-line write-crlf
|
|
receiving ; values receive
|
|
let-opt ; let-optionals
|
|
error-package ; error
|
|
switch-syntax ; switchq
|
|
condhax ; ? for COND
|
|
scheme)
|
|
(files smtp))
|
|
|
|
|
|
(define-structure crlf-io (export read-crlf-line
|
|
read-crlf-line-timeout
|
|
write-crlf)
|
|
(open ascii ; ascii->char
|
|
scsh ; read-line write-string force-output
|
|
receiving ; MV return (RECEIVE and VALUES)
|
|
let-opt ; let-optionals
|
|
threads ; sleep
|
|
scheme)
|
|
(files crlf-io))
|
|
|
|
|
|
(define-structures ((switch-syntax (export (switch :syntax)
|
|
(switchq :syntax)))
|
|
(condhax (export (when :syntax)
|
|
(unless :syntax)
|
|
(? :syntax))))
|
|
(open scheme)
|
|
(files conditionals))
|
|
|
|
|
|
(define-structure rfc822 (export read-rfc822-headers
|
|
read-rfc822-field
|
|
%read-rfc822-headers
|
|
%read-rfc822-field
|
|
rejoin-header-lines
|
|
get-header-all
|
|
get-header-lines
|
|
get-header
|
|
)
|
|
(open receiving ; MV return (RECEIVE and VALUES)
|
|
condhax ; ? for COND
|
|
scsh-utilities ; index
|
|
string-lib
|
|
let-opt ; let-optionals
|
|
strings ; lowercase-string uppercase-string
|
|
crlf-io ; read-crlf-line
|
|
ascii ; ascii->char
|
|
error-package ; error
|
|
scsh ; join-strings
|
|
scheme)
|
|
(files rfc822))
|
|
|
|
|
|
(define-structure strings (export string-map
|
|
downcase-string
|
|
upcase-string
|
|
char-set-index
|
|
char-set-rindex
|
|
string-reduce
|
|
skip-whitespace
|
|
string-prefix?
|
|
string-suffix?
|
|
trim-spaces)
|
|
(open char-set-lib let-opt scheme)
|
|
(files stringhax))
|
|
|
|
(define-structure uri-package (export parse-uri
|
|
uri-escaped-chars
|
|
unescape-uri
|
|
escape-uri
|
|
resolve-uri
|
|
split-uri-path
|
|
uri-path-list->path
|
|
simplify-uri-path)
|
|
(open scsh-utilities
|
|
string-lib
|
|
let-opt
|
|
receiving
|
|
condhax
|
|
ascii
|
|
strings
|
|
char-set-lib
|
|
bitwise
|
|
field-reader-package
|
|
scheme)
|
|
(files uri))
|
|
|
|
(define-structure url-package (export userhost? ; USERHOST
|
|
make-userhost ; record struct
|
|
|
|
userhost:user
|
|
userhost:password
|
|
userhost:host
|
|
userhost:port
|
|
|
|
set-userhost:user
|
|
set-userhost:password
|
|
set-userhost:host
|
|
set-userhost:port
|
|
|
|
parse-userhost ; parse &
|
|
userhost->string ; unparse.
|
|
|
|
http-url? ; HTTP-URL
|
|
make-http-url ; record struct
|
|
|
|
http-url:userhost
|
|
http-url:path
|
|
http-url:search
|
|
http-url:frag-id
|
|
|
|
set-http-url:userhost
|
|
set-http-url:path
|
|
set-http-url:search
|
|
set-http-url:frag-id
|
|
|
|
parse-http-url ; parse &
|
|
http-url->string) ; unparse.
|
|
|
|
(open defrec-package
|
|
receiving
|
|
condhax
|
|
string-lib
|
|
char-set-lib
|
|
uri-package
|
|
scsh-utilities
|
|
httpd-error
|
|
scheme)
|
|
(files url))
|
|
|
|
|
|
(define-structure httpd-error (export http-error?
|
|
http-error
|
|
fatal-syntax-error?
|
|
fatal-syntax-error)
|
|
(open conditions signals handle scheme)
|
|
(files httpd-error))
|
|
|
|
(define-structure handle-fatal-error (export with-fatal-error-handler*
|
|
(with-fatal-error-handler :syntax))
|
|
(open scheme conditions handle)
|
|
(files handle-fatal-error))
|
|
|
|
(define-structure httpd-core (export server/version
|
|
server/protocol
|
|
server/admin
|
|
set-server/admin!
|
|
|
|
http-log
|
|
*http-log?*
|
|
*http-log-port*
|
|
|
|
httpd
|
|
|
|
make-request ; HTTP request
|
|
request? ; record type.
|
|
request:method
|
|
request:uri
|
|
request:url
|
|
request:version
|
|
request:headers
|
|
request:socket
|
|
set-request:method
|
|
set-request:uri
|
|
set-request:url
|
|
set-request:version
|
|
set-request:headers
|
|
set-request:socket
|
|
|
|
version< version<=
|
|
v0.9-request?
|
|
version->string
|
|
|
|
;; Integer reply codes
|
|
reply-code->text
|
|
http-reply/ok
|
|
http-reply/created
|
|
http-reply/accepted
|
|
http-reply/prov-info
|
|
http-reply/no-content
|
|
http-reply/mult-choice
|
|
http-reply/moved-perm
|
|
http-reply/moved-temp
|
|
http-reply/method
|
|
http-reply/not-mod
|
|
http-reply/bad-request
|
|
http-reply/unauthorized
|
|
http-reply/payment-req
|
|
http-reply/forbidden
|
|
http-reply/not-found
|
|
http-reply/method-not-allowed
|
|
http-reply/none-acceptable
|
|
http-reply/proxy-auth-required
|
|
http-reply/timeout
|
|
http-reply/conflict
|
|
http-reply/gone
|
|
http-reply/internal-error
|
|
http-reply/not-implemented
|
|
http-reply/bad-gateway
|
|
http-reply/service-unavailable
|
|
http-reply/gateway-timeout
|
|
|
|
time->http-date-string
|
|
begin-http-header
|
|
send-http-error-reply
|
|
|
|
set-my-fqdn!
|
|
set-my-port!)
|
|
(open threads
|
|
scsh
|
|
receiving
|
|
let-opt
|
|
crlf-io
|
|
rfc822
|
|
switch-syntax
|
|
condhax
|
|
strings
|
|
char-set-lib
|
|
defrec-package
|
|
define-record-types
|
|
handle
|
|
conditions ; condition-stuff
|
|
defenum-package
|
|
httpd-error
|
|
handle-fatal-error
|
|
uri-package
|
|
url-package
|
|
formats
|
|
scheme)
|
|
(files httpd-core))
|
|
|
|
|
|
;;; For parsing submissions from HTML forms.
|
|
(define-structure parse-html-forms (export parse-html-form-query unescape-uri+)
|
|
(open scsh scsh-utilities let-opt string-lib
|
|
receiving uri-package strings condhax scheme)
|
|
(files parse-forms))
|
|
|
|
|
|
;;; For writing CGI scripts in Scheme.
|
|
(define-structure cgi-script-package (export cgi-form-query)
|
|
(open scsh
|
|
switch-syntax
|
|
error-package
|
|
parse-html-forms
|
|
scheme)
|
|
(files cgi-script))
|
|
|
|
;;; Provides the server interface to CGI scripts.
|
|
(define-structure cgi-server-package (export cgi-default-bin-path
|
|
cgi-handler
|
|
initialise-request-invariant-cgi-env)
|
|
(open strings
|
|
string-lib
|
|
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 cgi-server))
|
|
|
|
(define-structure htmlout-package (export emit-tag
|
|
emit-close-tag
|
|
|
|
emit-p
|
|
emit-title
|
|
emit-header ; And so forth...
|
|
|
|
with-tag
|
|
with-tag*
|
|
|
|
escape-html
|
|
emit-text)
|
|
(open scsh scsh-utilities strings formats ascii receiving scheme)
|
|
(files htmlout))
|
|
|
|
(define-structure httpd-basic-handlers (export alist-path-dispatcher
|
|
home-dir-handler
|
|
tilde-home-dir-handler
|
|
rooted-file-handler
|
|
rooted-file-or-directory-handler
|
|
null-path-handler
|
|
serve-rooted-file-path
|
|
file-serve
|
|
file-server-and-dir
|
|
http-homedir
|
|
send-file
|
|
dotdot-check
|
|
file-extension->content-type
|
|
copy-inport->outport)
|
|
(open scsh ; syscalls
|
|
formats ; FORMAT
|
|
condhax ; UNLESS, ? for COND
|
|
switch-syntax ; Conditionals
|
|
httpd-core ; REQUEST record type, HTTP-ERROR & reply codes,
|
|
; v0.9-request, begin-http-header
|
|
httpd-error
|
|
htmlout-package
|
|
conditions ; CONDITION-STUFF
|
|
url-package ; HTTP-URL record type
|
|
scheme)
|
|
(files httpd-handlers))
|
|
|
|
|
|
(define-structure seval-handler-package (export seval-handler)
|
|
(open scsh ; syscalls & INDEX
|
|
condhax ; WHEN, ? for COND
|
|
switch-syntax ; Conditionals
|
|
httpd-error
|
|
httpd-core ; REQUEST record type, HTTP-ERROR & reply codes,
|
|
; v0.9-request, reply formatting stuff.
|
|
uri-package ; UNESCAPE-URI
|
|
htmlout-package ; Formatted HTML output
|
|
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 seval))
|
|
|
|
(define-structure httpd-access-control (export access-denier
|
|
access-allower
|
|
access-controller
|
|
access-controlled-handler)
|
|
(open big-scheme
|
|
strings
|
|
httpd-core
|
|
httpd-error
|
|
scsh
|
|
scheme)
|
|
(files httpd-access-control))
|
|
|
|
(define-structure info-gateway (export info-handler
|
|
find-info-file
|
|
info-gateway-error)
|
|
(open big-scheme
|
|
string-lib
|
|
conditions signals handle
|
|
switch-syntax
|
|
condhax
|
|
strings
|
|
htmlout-package
|
|
httpd-core
|
|
httpd-error
|
|
url-package
|
|
uri-package
|
|
scsh
|
|
scheme)
|
|
(files info-gateway))
|
|
|
|
(define-structure rman-gateway (export rman-handler
|
|
man
|
|
parse-man-entry
|
|
cat-man-page
|
|
find-man-file
|
|
file->man-directory
|
|
cat-n-decode
|
|
nroff-n-decode)
|
|
(open httpd-core
|
|
httpd-error
|
|
conditions
|
|
url-package
|
|
uri-package
|
|
htmlout-package
|
|
httpd-basic-handlers
|
|
switch-syntax
|
|
condhax
|
|
handle-fatal-error
|
|
scsh
|
|
let-opt
|
|
scheme)
|
|
(files rman-gateway))
|
|
|
|
(define-structure ls (export ls
|
|
arguments->ls-flags)
|
|
(open scheme
|
|
big-scheme bitwise
|
|
scsh)
|
|
(files ls))
|
|
|
|
(define-structure ftpd (export ftpd
|
|
ftpd-inetd)
|
|
(open scheme
|
|
conditions handle signals
|
|
structure-refs
|
|
handle-fatal-error
|
|
scsh
|
|
threads
|
|
fluids
|
|
string-lib
|
|
defrec-package
|
|
crlf-io strings ls)
|
|
(access big-scheme)
|
|
(files ftpd))
|