Contents are now in packages.scm.
This commit is contained in:
sperber
parent
1171926f1e
commit
f9ae24b133
975
modules.scm
975
modules.scm
|
|
@ -1,975 +0,0 @@
|
||||||
;;; Scheme 48 module definitions for TCP/IP protocol suites.
|
|
||||||
;;; Copyright (c) 1995 by Olin Shivers.
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Utilities / nice things
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;;; format-net
|
|
||||||
|
|
||||||
(define-interface format-net-interface
|
|
||||||
(export format-internet-host-address
|
|
||||||
format-port))
|
|
||||||
|
|
||||||
(define-structure format-net format-net-interface
|
|
||||||
(open scsh
|
|
||||||
scheme
|
|
||||||
let-opt) ; :optional
|
|
||||||
(files format-net))
|
|
||||||
|
|
||||||
;;; sunet utilities
|
|
||||||
|
|
||||||
(define-interface sunet-utilities-interface
|
|
||||||
(export host-name-or-ip
|
|
||||||
on-interrupt))
|
|
||||||
|
|
||||||
(define-structure sunet-utilities sunet-utilities-interface
|
|
||||||
(open scsh
|
|
||||||
scheme
|
|
||||||
format-net
|
|
||||||
sigevents
|
|
||||||
handle-fatal-error)
|
|
||||||
(files sunet-utilities))
|
|
||||||
|
|
||||||
|
|
||||||
;;; rate limit
|
|
||||||
|
|
||||||
(define-interface rate-limit-interface
|
|
||||||
(export make-rate-limiter
|
|
||||||
rate-limit-block
|
|
||||||
rate-limit-open
|
|
||||||
rate-limit-close
|
|
||||||
rate-limiter-current-requests))
|
|
||||||
|
|
||||||
(define-structure rate-limit rate-limit-interface
|
|
||||||
(open scheme
|
|
||||||
define-record-types
|
|
||||||
locks
|
|
||||||
signals)
|
|
||||||
(files rate-limit))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; CRLF-IO
|
|
||||||
|
|
||||||
(define-interface crlf-io-interface
|
|
||||||
(export read-crlf-line
|
|
||||||
read-crlf-line-timeout
|
|
||||||
write-crlf))
|
|
||||||
|
|
||||||
(define-structure crlf-io crlf-io-interface
|
|
||||||
(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))
|
|
||||||
|
|
||||||
|
|
||||||
;;; ecm utilities
|
|
||||||
|
|
||||||
;; some utilities for the ecm-stuff (ftp, pop3, smtp, nettime)
|
|
||||||
;; hope we can vanish this soon
|
|
||||||
|
|
||||||
(define-interface ecm-utilities-interface
|
|
||||||
(export system-fqdn
|
|
||||||
safe-first
|
|
||||||
safe-second
|
|
||||||
write-crlf
|
|
||||||
dump))
|
|
||||||
|
|
||||||
(define-structure ecm-utilities ecm-utilities-interface
|
|
||||||
(open scsh
|
|
||||||
string-lib
|
|
||||||
scheme)
|
|
||||||
(files ecm-utilities))
|
|
||||||
|
|
||||||
|
|
||||||
;;; parse-html-forms
|
|
||||||
;;; For parsing submissions from HTML forms.
|
|
||||||
|
|
||||||
(define-interface parse-html-forms-interface
|
|
||||||
(export parse-html-form-query unescape-uri+))
|
|
||||||
|
|
||||||
(define-structure parse-html-forms parse-html-forms-interface
|
|
||||||
(open scsh
|
|
||||||
scsh-utilities
|
|
||||||
let-opt
|
|
||||||
string-lib
|
|
||||||
receiving
|
|
||||||
uri
|
|
||||||
scheme)
|
|
||||||
(files parse-forms))
|
|
||||||
|
|
||||||
|
|
||||||
;;; htmlout
|
|
||||||
|
|
||||||
(define-interface htmlout-interface
|
|
||||||
(export emit-tag
|
|
||||||
emit-close-tag
|
|
||||||
|
|
||||||
emit-p
|
|
||||||
emit-title
|
|
||||||
emit-header ; And so forth...
|
|
||||||
|
|
||||||
with-tag
|
|
||||||
with-tag*
|
|
||||||
|
|
||||||
escape-html
|
|
||||||
emit-text))
|
|
||||||
|
|
||||||
(define-structure htmlout htmlout-interface
|
|
||||||
(open scsh scsh-utilities string-lib formats ascii receiving scheme)
|
|
||||||
(files htmlout))
|
|
||||||
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Clients / RFC
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
|
|
||||||
;; SMTP
|
|
||||||
|
|
||||||
(define-interface smtp-interface
|
|
||||||
(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))
|
|
||||||
|
|
||||||
(define-interface smtp-internals-interface
|
|
||||||
(export read-crlf-line ; These two should be in an
|
|
||||||
write-crlf ; auxiliary module.
|
|
||||||
|
|
||||||
smtp-query
|
|
||||||
nullary-smtp-command
|
|
||||||
unary-smtp-command))
|
|
||||||
|
|
||||||
(define-structures
|
|
||||||
((smtp smtp-interface)
|
|
||||||
(smtp-internals smtp-internals-interface))
|
|
||||||
|
|
||||||
(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
|
|
||||||
scheme)
|
|
||||||
(files smtp))
|
|
||||||
|
|
||||||
|
|
||||||
;;; RFC 822
|
|
||||||
|
|
||||||
(define-interface rfc822-interface
|
|
||||||
(export read-rfc822-headers
|
|
||||||
read-rfc822-field
|
|
||||||
%read-rfc822-headers
|
|
||||||
%read-rfc822-field
|
|
||||||
rejoin-header-lines
|
|
||||||
get-header-all
|
|
||||||
get-header-lines
|
|
||||||
get-header
|
|
||||||
))
|
|
||||||
|
|
||||||
(define-structure rfc822 rfc822-interface
|
|
||||||
(open receiving ; MV return (RECEIVE and VALUES)
|
|
||||||
scsh-utilities ; index
|
|
||||||
string-lib
|
|
||||||
let-opt ; let-optionals
|
|
||||||
crlf-io ; read-crlf-line
|
|
||||||
ascii ; ascii->char
|
|
||||||
error-package ; error
|
|
||||||
scsh ; string-join
|
|
||||||
scheme)
|
|
||||||
(files rfc822))
|
|
||||||
|
|
||||||
|
|
||||||
;;; URI
|
|
||||||
|
|
||||||
(define-interface uri-interface
|
|
||||||
(export parse-uri
|
|
||||||
uri-escaped-chars
|
|
||||||
unescape-uri
|
|
||||||
escape-uri
|
|
||||||
resolve-uri
|
|
||||||
split-uri-path
|
|
||||||
uri-path-list->path
|
|
||||||
simplify-uri-path))
|
|
||||||
|
|
||||||
(define-structure uri uri-interface
|
|
||||||
(open scsh-utilities
|
|
||||||
string-lib
|
|
||||||
let-opt
|
|
||||||
receiving
|
|
||||||
|
|
||||||
ascii
|
|
||||||
char-set-lib
|
|
||||||
bitwise
|
|
||||||
field-reader-package
|
|
||||||
scheme)
|
|
||||||
(files uri))
|
|
||||||
|
|
||||||
;;; URL
|
|
||||||
|
|
||||||
(define-interface url-interface
|
|
||||||
(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.
|
|
||||||
|
|
||||||
(define-structure url url-interface
|
|
||||||
(open defrec-package
|
|
||||||
receiving
|
|
||||||
|
|
||||||
string-lib
|
|
||||||
char-set-lib
|
|
||||||
uri
|
|
||||||
scsh-utilities
|
|
||||||
httpd-error
|
|
||||||
scheme)
|
|
||||||
(files url))
|
|
||||||
|
|
||||||
|
|
||||||
;;; ftp client
|
|
||||||
|
|
||||||
;; ftp.scm is a module for transfering files between networked
|
|
||||||
;; machines using the File Transfer Protocol
|
|
||||||
|
|
||||||
(define-interface ftp-interface
|
|
||||||
(export ftp-connect
|
|
||||||
ftp-login
|
|
||||||
ftp-type
|
|
||||||
ftp-rename
|
|
||||||
ftp-delete
|
|
||||||
ftp-cd
|
|
||||||
ftp-cdup
|
|
||||||
ftp-pwd
|
|
||||||
ftp-rmdir
|
|
||||||
ftp-mkdir
|
|
||||||
ftp-modification-time
|
|
||||||
ftp-size
|
|
||||||
ftp-abort
|
|
||||||
ftp-quit
|
|
||||||
ftp-ls
|
|
||||||
ftp-dir
|
|
||||||
ftp-get
|
|
||||||
ftp-put
|
|
||||||
ftp-append
|
|
||||||
ftp-quot
|
|
||||||
ftp-error?))
|
|
||||||
|
|
||||||
(define-structure ftp ftp-interface
|
|
||||||
(open netrc
|
|
||||||
scsh
|
|
||||||
defrec-package
|
|
||||||
receiving
|
|
||||||
handle
|
|
||||||
conditions
|
|
||||||
signals
|
|
||||||
error-package
|
|
||||||
ecm-utilities
|
|
||||||
string-lib
|
|
||||||
let-opt
|
|
||||||
scheme)
|
|
||||||
(files ftp))
|
|
||||||
|
|
||||||
;; obsolete ftp client
|
|
||||||
|
|
||||||
(define-interface ftp-obsolete-interface
|
|
||||||
(export ftp:connect
|
|
||||||
ftp:login
|
|
||||||
ftp:type
|
|
||||||
ftp:rename
|
|
||||||
ftp:delete
|
|
||||||
ftp:cd
|
|
||||||
ftp:cdup
|
|
||||||
ftp:pwd
|
|
||||||
ftp:rmdir
|
|
||||||
ftp:mkdir
|
|
||||||
ftp:modification-time
|
|
||||||
ftp:size
|
|
||||||
ftp:abort
|
|
||||||
ftp:quit
|
|
||||||
ftp:ls
|
|
||||||
ftp:dir
|
|
||||||
ftp:get
|
|
||||||
ftp:put
|
|
||||||
ftp:append
|
|
||||||
ftp:quot))
|
|
||||||
|
|
||||||
(define-structure ftp-obsolete ftp-obsolete-interface
|
|
||||||
(open scsh
|
|
||||||
scheme
|
|
||||||
ftp)
|
|
||||||
(files ftp-obsolete))
|
|
||||||
|
|
||||||
|
|
||||||
;;; netrc parsing
|
|
||||||
|
|
||||||
;; netrc.scm is a module for parsing ~/.netrc files, to obtain login
|
|
||||||
;; and password information for different network hosts.
|
|
||||||
|
|
||||||
(define-interface netrc-interface
|
|
||||||
(export user-mail-address
|
|
||||||
netrc:lookup
|
|
||||||
netrc:lookup-password
|
|
||||||
netrc:lookup-login
|
|
||||||
netrc:parse
|
|
||||||
netrc:try-parse
|
|
||||||
netrc-refuse?))
|
|
||||||
|
|
||||||
(define-structure netrc netrc-interface
|
|
||||||
(open defrec-package
|
|
||||||
records
|
|
||||||
scsh
|
|
||||||
error-package
|
|
||||||
ecm-utilities
|
|
||||||
string-lib
|
|
||||||
conditions signals handle
|
|
||||||
let-opt
|
|
||||||
scheme)
|
|
||||||
(files netrc))
|
|
||||||
|
|
||||||
|
|
||||||
;;; POP3 client
|
|
||||||
|
|
||||||
;; pop3.scm is a module for accessing email on a maildrop server,
|
|
||||||
;; using the POP3 protocol.
|
|
||||||
(define-interface pop3-interface
|
|
||||||
(export pop3-connect
|
|
||||||
pop3-login
|
|
||||||
pop3-stat
|
|
||||||
pop3-get
|
|
||||||
pop3-headers
|
|
||||||
pop3-last
|
|
||||||
pop3-delete
|
|
||||||
pop3-reset
|
|
||||||
pop3-quit))
|
|
||||||
|
|
||||||
(define-structure pop3 pop3-interface
|
|
||||||
(open netrc
|
|
||||||
scsh
|
|
||||||
defrec-package
|
|
||||||
handle
|
|
||||||
conditions
|
|
||||||
signals
|
|
||||||
ecm-utilities
|
|
||||||
string-lib
|
|
||||||
scheme)
|
|
||||||
(files pop3))
|
|
||||||
|
|
||||||
;; obsolete pop3
|
|
||||||
|
|
||||||
(define-interface pop3-obsolete-interface
|
|
||||||
(export pop3:connect
|
|
||||||
pop3:login
|
|
||||||
pop3:stat
|
|
||||||
pop3:get
|
|
||||||
pop3:headers
|
|
||||||
pop3:last
|
|
||||||
pop3:delete
|
|
||||||
pop3:reset
|
|
||||||
pop3:quit))
|
|
||||||
|
|
||||||
(define-structure pop3-obsolete pop3-obsolete-interface
|
|
||||||
(open scsh
|
|
||||||
scheme
|
|
||||||
pop3)
|
|
||||||
(files pop3-obsolete))
|
|
||||||
|
|
||||||
;;; nettime
|
|
||||||
|
|
||||||
;; nettime.scm is a module for requesting the time on remote machines,
|
|
||||||
;; using the time or the daytime protocol
|
|
||||||
(define-interface nettime-interface
|
|
||||||
(export net-time
|
|
||||||
net-daytime))
|
|
||||||
|
|
||||||
(define-structure nettime nettime-interface
|
|
||||||
(open scsh
|
|
||||||
scheme)
|
|
||||||
(files nettime))
|
|
||||||
|
|
||||||
;; obsolete nettime
|
|
||||||
|
|
||||||
(define-structure nettime-obsolete nettime-obsolete-interface
|
|
||||||
(open scsh
|
|
||||||
scheme
|
|
||||||
nettime)
|
|
||||||
(files nettime-obsolete))
|
|
||||||
|
|
||||||
(define-interface nettime-obsolete-interface
|
|
||||||
(export net:time
|
|
||||||
net:daytime))
|
|
||||||
|
|
||||||
|
|
||||||
;;; ls
|
|
||||||
;; clone of unix' ls
|
|
||||||
|
|
||||||
(define-interface ls-interface
|
|
||||||
(export ls-crlf?
|
|
||||||
ls
|
|
||||||
arguments->ls-flags))
|
|
||||||
|
|
||||||
(define-structure ls ls-interface
|
|
||||||
(open scheme handle
|
|
||||||
big-scheme bitwise
|
|
||||||
fluids
|
|
||||||
crlf-io
|
|
||||||
scsh)
|
|
||||||
(files ls))
|
|
||||||
|
|
||||||
|
|
||||||
;;; DNS
|
|
||||||
|
|
||||||
;; dns.scm is a module to resolve hostnames and ip-addresses.
|
|
||||||
;; it implements the rfc1035.
|
|
||||||
(define-interface dns-interface
|
|
||||||
(export dns-clear-cache
|
|
||||||
dns-lookup
|
|
||||||
dns-lookup-name
|
|
||||||
dns-inverse-lookup
|
|
||||||
dns-lookup-ip
|
|
||||||
dns-lookup-nameserver
|
|
||||||
dns-lookup-mail-exchanger
|
|
||||||
concurrent-lookup
|
|
||||||
show-dns-message
|
|
||||||
force-ip
|
|
||||||
force-ip-list
|
|
||||||
dns-find-nameserver
|
|
||||||
dns-find-nameserver-list))
|
|
||||||
|
|
||||||
(define-structure dns dns-interface
|
|
||||||
(open scheme
|
|
||||||
scsh
|
|
||||||
big-util
|
|
||||||
tables
|
|
||||||
ascii
|
|
||||||
formats
|
|
||||||
signals
|
|
||||||
defrec-package
|
|
||||||
random
|
|
||||||
queues
|
|
||||||
conditions
|
|
||||||
handle
|
|
||||||
sort
|
|
||||||
threads
|
|
||||||
locks)
|
|
||||||
(files dns))
|
|
||||||
|
|
||||||
;;; CGI script
|
|
||||||
|
|
||||||
;;; For writing CGI scripts in Scheme.
|
|
||||||
(define-interface cgi-script-interface (export cgi-form-query))
|
|
||||||
|
|
||||||
(define-structure cgi-script cgi-script-interface
|
|
||||||
(open scsh
|
|
||||||
error-package
|
|
||||||
parse-html-forms
|
|
||||||
scheme)
|
|
||||||
(files cgi-script))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Servers
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;;; HTTPD Web-Server
|
|
||||||
|
|
||||||
;;; httpd-core
|
|
||||||
|
|
||||||
(define-interface httpd-core-interface
|
|
||||||
(export httpd
|
|
||||||
send-http-error-reply))
|
|
||||||
|
|
||||||
(define-structure httpd-core httpd-core-interface
|
|
||||||
(open thread-fluids ; fork-thread
|
|
||||||
scsh
|
|
||||||
receiving ; receive
|
|
||||||
crlf-io ; write-crlf, read-crlf-line
|
|
||||||
rfc822 ; read-rfc822-headers
|
|
||||||
char-set-lib ; char-set-complement, char-set:whitespace
|
|
||||||
handle ; ignore-errors
|
|
||||||
conditions ; condition-stuff
|
|
||||||
uri
|
|
||||||
url
|
|
||||||
formats ; format
|
|
||||||
format-net ; format-internet-host-address
|
|
||||||
rate-limit ; rate-limiting stuff
|
|
||||||
string-lib ; STRING-INDEX
|
|
||||||
|
|
||||||
handle-fatal-error
|
|
||||||
httpd-read-options
|
|
||||||
httpd-error
|
|
||||||
httpd-logging
|
|
||||||
httpd-request
|
|
||||||
httpd-reply-codes
|
|
||||||
httpd-text-generation
|
|
||||||
scheme)
|
|
||||||
(files (httpd core)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; httpd-make-options
|
|
||||||
;;; httpd-read-options
|
|
||||||
|
|
||||||
(define-interface httpd-make-options-interface
|
|
||||||
(export with-port
|
|
||||||
with-root-directory
|
|
||||||
with-fqdn
|
|
||||||
with-reported-port
|
|
||||||
with-path-handler
|
|
||||||
with-server-admin
|
|
||||||
with-simultaneous-requests
|
|
||||||
with-logfile
|
|
||||||
with-syslog?))
|
|
||||||
|
|
||||||
(define-interface httpd-read-options-interface
|
|
||||||
(export httpd-options-port
|
|
||||||
httpd-options-root-directory
|
|
||||||
httpd-options-fqdn
|
|
||||||
httpd-options-reported-port
|
|
||||||
httpd-options-path-handler
|
|
||||||
httpd-options-server-admin
|
|
||||||
httpd-options-simultaneous-requests
|
|
||||||
httpd-options-logfile
|
|
||||||
httpd-options-syslog?))
|
|
||||||
|
|
||||||
(define-structures ((httpd-make-options httpd-make-options-interface)
|
|
||||||
(httpd-read-options httpd-read-options-interface))
|
|
||||||
(open scheme
|
|
||||||
define-record-types)
|
|
||||||
(files (httpd options)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; httpd-access-control
|
|
||||||
|
|
||||||
(define-interface httpd-access-control-interface
|
|
||||||
(export access-denier
|
|
||||||
access-allower
|
|
||||||
access-controller
|
|
||||||
access-controlled-handler))
|
|
||||||
|
|
||||||
(define-structure httpd-access-control httpd-access-control-interface
|
|
||||||
(open big-scheme
|
|
||||||
httpd-reply-codes
|
|
||||||
httpd-request
|
|
||||||
httpd-error
|
|
||||||
string-lib ; STRING-MAP
|
|
||||||
scsh
|
|
||||||
scheme)
|
|
||||||
(files (httpd access-control)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; httpd-error
|
|
||||||
|
|
||||||
(define-interface httpd-error-interface
|
|
||||||
(export http-error?
|
|
||||||
http-error
|
|
||||||
fatal-syntax-error?
|
|
||||||
fatal-syntax-error))
|
|
||||||
|
|
||||||
(define-structure httpd-error httpd-error-interface
|
|
||||||
(open conditions signals handle scheme)
|
|
||||||
(files (httpd error)))
|
|
||||||
|
|
||||||
;;; httpd-fatal-error
|
|
||||||
|
|
||||||
(define-interface handle-fatal-error-interface
|
|
||||||
(export with-fatal-error-handler*
|
|
||||||
(with-fatal-error-handler :syntax)))
|
|
||||||
|
|
||||||
(define-structure handle-fatal-error handle-fatal-error-interface
|
|
||||||
(open scheme conditions handle)
|
|
||||||
(files (httpd handle-fatal-error)))
|
|
||||||
|
|
||||||
;;; httpd-logging
|
|
||||||
|
|
||||||
(define-interface httpd-logging-interface
|
|
||||||
(export init-http-log!
|
|
||||||
*http-syslog?*
|
|
||||||
http-syslog
|
|
||||||
http-log))
|
|
||||||
|
|
||||||
(define-structure httpd-logging httpd-logging-interface
|
|
||||||
(open httpd-read-options
|
|
||||||
i/o ; make-null-output-port
|
|
||||||
locks ; make-lock obtain-lock release-lock
|
|
||||||
receiving ; receive
|
|
||||||
uri ; uri-path-list->path
|
|
||||||
url ; http-url:path
|
|
||||||
httpd-request ; request record
|
|
||||||
formats ; format
|
|
||||||
format-net ; format-internet-host-address
|
|
||||||
string-lib ; string-join, string-trim
|
|
||||||
rfc822 ; get-header
|
|
||||||
sunet-utilities ; on-interrupt
|
|
||||||
threads ; spawn
|
|
||||||
scsh
|
|
||||||
scheme)
|
|
||||||
(files (httpd logging)))
|
|
||||||
|
|
||||||
;; httpd-reply-codes
|
|
||||||
|
|
||||||
(define-interface httpd-reply-codes-interface
|
|
||||||
(export ;; 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))
|
|
||||||
|
|
||||||
(define-structure httpd-reply-codes httpd-reply-codes-interface
|
|
||||||
(open defenum-package
|
|
||||||
scheme)
|
|
||||||
(files (httpd reply-codes)))
|
|
||||||
|
|
||||||
;; httpd-request
|
|
||||||
|
|
||||||
(define-interface httpd-request-interface
|
|
||||||
(export 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))
|
|
||||||
|
|
||||||
(define-structure httpd-request httpd-request-interface
|
|
||||||
(open define-record-types ;; define-record-discloser
|
|
||||||
defrec-package ;; define-record
|
|
||||||
scheme)
|
|
||||||
(files (httpd request)))
|
|
||||||
|
|
||||||
(define-interface httpd-constants-interface
|
|
||||||
(export server/version
|
|
||||||
server/protocol))
|
|
||||||
|
|
||||||
(define-structure httpd-constants httpd-constants-interface
|
|
||||||
(open scheme)
|
|
||||||
(files (httpd constants)))
|
|
||||||
|
|
||||||
(define-interface httpd-text-generation-interface
|
|
||||||
(export time->http-date-string
|
|
||||||
begin-http-header
|
|
||||||
title-html))
|
|
||||||
|
|
||||||
(define-structure httpd-text-generation httpd-text-generation-interface
|
|
||||||
(open formats
|
|
||||||
httpd-reply-codes ; reply-code->text
|
|
||||||
crlf-io
|
|
||||||
httpd-constants
|
|
||||||
scheme
|
|
||||||
scsh) ; format-date
|
|
||||||
(files (httpd text-generation)))
|
|
||||||
|
|
||||||
|
|
||||||
;; path-handlers
|
|
||||||
|
|
||||||
;;; httpd-basic-handlers
|
|
||||||
|
|
||||||
(define-interface httpd-basic-handlers-interface
|
|
||||||
(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))
|
|
||||||
|
|
||||||
(define-structure httpd-basic-handlers httpd-basic-handlers-interface
|
|
||||||
(open scsh ; syscalls
|
|
||||||
formats ; FORMAT
|
|
||||||
httpd-request ; REQUEST record type, v0.9-request
|
|
||||||
httpd-reply-codes ; reply codes
|
|
||||||
httpd-text-generation ; begin-http-header
|
|
||||||
httpd-error ; HTTP-ERROR
|
|
||||||
htmlout
|
|
||||||
conditions ; CONDITION-STUFF
|
|
||||||
url ; HTTP-URL record type
|
|
||||||
handle-fatal-error ; WITH-FATAL-ERROR-HANDLER
|
|
||||||
string-lib ; STRING-JOIN
|
|
||||||
scheme)
|
|
||||||
(files (httpd handlers)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; seval-handler
|
|
||||||
|
|
||||||
(define-interface seval-handler-interface
|
|
||||||
(export seval-handler))
|
|
||||||
|
|
||||||
(define-structure seval-handler seval-handler-interface
|
|
||||||
(open scsh ; syscalls & INDEX
|
|
||||||
httpd-error
|
|
||||||
httpd-request ; v0.9-request
|
|
||||||
httpd-reply-codes
|
|
||||||
httpd-text-generation ; begin-http-header
|
|
||||||
httpd-logging ; http-log
|
|
||||||
uri ; UNESCAPE-URI
|
|
||||||
htmlout ; Formatted HTML output
|
|
||||||
error-package ; ERROR
|
|
||||||
pp ; Pretty-printer
|
|
||||||
string-lib ; STRING-SKIP
|
|
||||||
rfc822
|
|
||||||
toothless-eval ; EVAL-SAFELY
|
|
||||||
handle ; IGNORE-ERROR
|
|
||||||
parse-html-forms ; PARSE-HTML-FORM-QUERY
|
|
||||||
threads ; SLEEP
|
|
||||||
scheme)
|
|
||||||
(files (httpd seval)))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; info-gateway
|
|
||||||
|
|
||||||
(define-interface info-gateway-interface
|
|
||||||
(export info-handler
|
|
||||||
find-info-file
|
|
||||||
info-gateway-error))
|
|
||||||
|
|
||||||
(define-structure info-gateway info-gateway-interface
|
|
||||||
(open big-scheme
|
|
||||||
string-lib
|
|
||||||
conditions signals handle
|
|
||||||
htmlout
|
|
||||||
httpd-request
|
|
||||||
httpd-text-generation
|
|
||||||
httpd-reply-codes
|
|
||||||
httpd-error
|
|
||||||
url
|
|
||||||
uri
|
|
||||||
scsh
|
|
||||||
handle-fatal-error
|
|
||||||
scheme)
|
|
||||||
(files (httpd info-gateway)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; rman-gateway
|
|
||||||
|
|
||||||
(define-interface rman-gateway-interface
|
|
||||||
(export rman-handler
|
|
||||||
man
|
|
||||||
parse-man-entry
|
|
||||||
cat-man-page
|
|
||||||
find-man-file
|
|
||||||
file->man-directory
|
|
||||||
cat-n-decode
|
|
||||||
nroff-n-decode))
|
|
||||||
|
|
||||||
(define-structure rman-gateway rman-gateway-interface
|
|
||||||
(open httpd-reply-codes
|
|
||||||
httpd-request
|
|
||||||
httpd-text-generation
|
|
||||||
httpd-error
|
|
||||||
conditions
|
|
||||||
url
|
|
||||||
uri
|
|
||||||
htmlout
|
|
||||||
httpd-basic-handlers
|
|
||||||
handle-fatal-error
|
|
||||||
scsh
|
|
||||||
let-opt
|
|
||||||
string-lib
|
|
||||||
scheme)
|
|
||||||
(files (httpd rman-gateway)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; CGI Server
|
|
||||||
|
|
||||||
;;; Provides the server interface to CGI scripts.
|
|
||||||
(define-interface cgi-server-interface
|
|
||||||
(export cgi-default-bin-path
|
|
||||||
cgi-handler))
|
|
||||||
|
|
||||||
(define-structure cgi-server cgi-server-interface
|
|
||||||
(open string-lib
|
|
||||||
rfc822
|
|
||||||
crlf-io ; WRITE-CRLF
|
|
||||||
uri
|
|
||||||
url ; HTTP-URL record type
|
|
||||||
httpd-constants
|
|
||||||
httpd-logging
|
|
||||||
httpd-request
|
|
||||||
httpd-reply-codes
|
|
||||||
httpd-basic-handlers ; HTTP-HOMEDIR, SERVE-ROOTED-FILE-PATH
|
|
||||||
httpd-error ; HTTP-ERROR
|
|
||||||
scsh-utilities ; INDEX
|
|
||||||
scsh ; syscalls
|
|
||||||
formats ; format
|
|
||||||
format-net ; FORMAT-INTERNET-HOST-ADDRESS
|
|
||||||
sunet-utilities ; host-name-or-empty
|
|
||||||
let-opt ; let-optionals
|
|
||||||
scheme)
|
|
||||||
(files (httpd cgi-server)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; FTP server: ftpd
|
|
||||||
|
|
||||||
(define-interface ftpd-interface
|
|
||||||
(export ftpd
|
|
||||||
ftpd-inetd))
|
|
||||||
|
|
||||||
(define-structure ftpd ftpd-interface
|
|
||||||
(open scsh
|
|
||||||
conditions handle signals
|
|
||||||
structure-refs
|
|
||||||
handle-fatal-error
|
|
||||||
scheme
|
|
||||||
threads threads-internal ; last one to get CURRENT-THREAD
|
|
||||||
locks
|
|
||||||
thread-fluids ; fork-thread
|
|
||||||
fluids
|
|
||||||
string-lib
|
|
||||||
big-util
|
|
||||||
defrec-package
|
|
||||||
crlf-io
|
|
||||||
ls
|
|
||||||
let-opt
|
|
||||||
receiving ; RECEIVE
|
|
||||||
format-net) ; pretty print of internet-addresses
|
|
||||||
(access big-scheme)
|
|
||||||
(files ftpd))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; else: TOOTHLESS
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;;; -*- Scheme -*-
|
|
||||||
;;; This file defines a Scheme 48 module that is R4RS without features
|
|
||||||
;;; that could examine or effect the file system. You can also use it
|
|
||||||
;;; as a model of how to execute code in other protected environments
|
|
||||||
;;; in S48.
|
|
||||||
;;;
|
|
||||||
;;; Copyright (c) 1995 by Olin Shivers.
|
|
||||||
|
|
||||||
(define-interface loser-interface (export loser))
|
|
||||||
|
|
||||||
(define-structure loser (export loser)
|
|
||||||
(open scheme error-package)
|
|
||||||
(begin (define (loser name)
|
|
||||||
(lambda x (error "Illegal call" name)))))
|
|
||||||
|
|
||||||
;;; The toothless structure is R4RS without the dangerous procedures.
|
|
||||||
|
|
||||||
(define-interface toothless-interface (interface-of scheme))
|
|
||||||
|
|
||||||
(define-structure toothless toothless-interface
|
|
||||||
(open scheme loser)
|
|
||||||
(begin
|
|
||||||
(define call-with-input-file (loser "call-with-input-file"))
|
|
||||||
(define call-with-output-file (loser "call-with-output-file"))
|
|
||||||
(define load (loser "load"))
|
|
||||||
(define open-input-file (loser "open-input-file"))
|
|
||||||
(define open-output-file (loser "open-output-file"))
|
|
||||||
(define transcript-on (loser "transcript-on"))
|
|
||||||
(define with-input-from-file (loser "with-input-from-file"))
|
|
||||||
(define with-input-to-file (loser "with-input-to-file"))
|
|
||||||
(define eval (loser "eval"))
|
|
||||||
(define interaction-environment (loser "interaction-environment"))
|
|
||||||
(define scheme-report-environment (loser "scheme-report-environment"))))
|
|
||||||
|
|
||||||
;;; (EVAL-SAFELEY exp)
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Create a brand new package, import the TOOTHLESS structure, and
|
|
||||||
;;; evaluate EXP in it. When the evaluation is done, you throw away
|
|
||||||
;;; the environment, so EXP's side-effects don't persist from one
|
|
||||||
;;; EVAL-SAFELY call to the next. If EXP raises an error exception,
|
|
||||||
;;; we abort and return #f.
|
|
||||||
|
|
||||||
(define-interface toothless-eval-interface (export eval-safely))
|
|
||||||
|
|
||||||
(define-structure toothless-eval toothless-eval-interface
|
|
||||||
(open evaluation ; eval
|
|
||||||
package-commands-internal ; config-package, get-reflective-tower
|
|
||||||
packages ; structure-package, make-simple-package
|
|
||||||
environments ; environment-ref
|
|
||||||
handle ; ignore-errors
|
|
||||||
scheme)
|
|
||||||
(access toothless) ; Force it to be loaded.
|
|
||||||
(begin
|
|
||||||
|
|
||||||
(define toothless-struct (environment-ref (config-package) 'toothless))
|
|
||||||
(define toothless-package (structure-package toothless-struct))
|
|
||||||
|
|
||||||
(define (new-safe-package)
|
|
||||||
(make-simple-package (list toothless-struct) #t
|
|
||||||
(get-reflective-tower toothless-package) ; ???
|
|
||||||
'safe-env))
|
|
||||||
|
|
||||||
(define (eval-safely exp)
|
|
||||||
(ignore-errors (lambda () (eval exp (new-safe-package)))))))
|
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue