sunet/modules.scm

813 lines
18 KiB
Scheme
Raw Normal View History

2000-09-26 10:35:26 -04:00
;;; Scheme 48 module definitions for TCP/IP protocol suites.
;;; Copyright (c) 1995 by Olin Shivers.
(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))
(define-interface sunet-utilities-interface
2002-05-08 08:04:56 -04:00
(export host-name-or-ip
on-interrupt))
(define-structure sunet-utilities sunet-utilities-interface
(open scsh
scheme
format-net
2002-05-08 08:04:56 -04:00
sigevents
handle-fatal-error)
(files sunet-utilities))
(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))
2000-09-26 10:35:26 -04:00
(define-structures
((smtp smtp-interface)
(smtp-internals smtp-internals-interface))
2000-09-26 10:35:26 -04:00
(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))
(define-interface crlf-io-interface
(export read-crlf-line
read-crlf-line-timeout
write-crlf))
(define-structure crlf-io crlf-io-interface
2000-09-26 10:35:26 -04:00
(open ascii ; ascii->char
scsh ; read-line write-string force-output
receiving ; MV return (RECEIVE and VALUES)
let-opt ; let-optionals
2001-04-27 12:19:34 -04:00
threads ; sleep
2000-09-26 10:35:26 -04:00
scheme)
(files crlf-io))
(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
2000-09-26 10:35:26 -04:00
(open receiving ; MV return (RECEIVE and VALUES)
scsh-utilities ; index
2001-04-27 12:19:34 -04:00
string-lib
2000-09-26 10:35:26 -04:00
let-opt ; let-optionals
crlf-io ; read-crlf-line
ascii ; ascii->char
error-package ; error
scsh ; string-join
2000-09-26 10:35:26 -04:00
scheme)
(files rfc822))
(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
2000-09-26 10:35:26 -04:00
(open scsh-utilities
2001-04-27 12:19:34 -04:00
string-lib
2000-09-26 10:35:26 -04:00
let-opt
receiving
2000-09-26 10:35:26 -04:00
ascii
char-set-lib
2000-09-26 10:35:26 -04:00
bitwise
field-reader-package
scheme)
(files uri))
(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
2000-09-26 10:35:26 -04:00
(open defrec-package
receiving
2001-04-27 12:19:34 -04:00
string-lib
char-set-lib
uri
2000-09-26 10:35:26 -04:00
scsh-utilities
httpd-error
scheme)
(files url))
(define-interface httpd-error-interface
(export http-error?
http-error
fatal-syntax-error?
fatal-syntax-error))
(define-structure httpd-error httpd-error-interface
2000-09-26 10:35:26 -04:00
(open conditions signals handle scheme)
(files httpd-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
2000-09-26 11:32:01 -04:00
(open scheme conditions handle)
(files handle-fatal-error))
2000-09-26 10:35:26 -04:00
(define-interface httpd-core-interface
(export server/version
server/protocol
http-syslog
http-log
2002-04-04 02:38:46 -05:00
http-syslog
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))
(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?))
2002-03-01 03:54:48 -05:00
(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))
(define-structure httpd-core httpd-core-interface
(open threads locks
thread-fluids ; fork-thread
2001-04-27 12:19:34 -04:00
scsh
2000-09-26 10:35:26 -04:00
receiving
crlf-io
rfc822
char-set-lib
2000-09-26 10:35:26 -04:00
defrec-package
2001-04-27 12:19:34 -04:00
define-record-types
2000-09-26 10:35:26 -04:00
handle
conditions ; condition-stuff
defenum-package
httpd-error
2000-09-26 11:32:01 -04:00
handle-fatal-error
uri
url
2000-09-26 10:35:26 -04:00
formats
format-net
sunet-utilities
httpd-read-options
2002-03-01 03:54:48 -05:00
rate-limit
string-lib ; STRING-JOIN
i/o ; make-null-output-port
2000-09-26 10:35:26 -04:00
scheme)
(files httpd-core))
(define-structures ((httpd-make-options httpd-make-options-interface)
(httpd-read-options httpd-read-options-interface))
(open scheme
define-record-types)
(files httpd-options))
2000-09-26 10:35:26 -04:00
;;; 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)
2000-09-26 10:35:26 -04:00
(files parse-forms))
;;; For writing CGI scripts in Scheme.
(define-interface cgi-script-interface (export cgi-form-query))
(define-structure cgi-script cgi-script-interface
2000-09-26 10:35:26 -04:00
(open scsh
error-package
parse-html-forms
scheme)
(files cgi-script))
;;; 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
2000-09-26 10:35:26 -04:00
rfc822
crlf-io ; WRITE-CRLF
uri
url ; HTTP-URL record type
2000-09-26 10:35:26 -04:00
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
format-net ; FORMAT-INTERNET-HOST-ADDRESS
sunet-utilities ; host-name-or-empty
let-opt ; let-optionals
2000-09-26 10:35:26 -04:00
scheme)
(files cgi-server))
(define-interface htmlout-interface
(export emit-tag
emit-close-tag
emit-p
emit-title
emit-header ; And so forth...
2000-09-26 10:35:26 -04:00
with-tag
with-tag*
2000-09-26 10:35:26 -04:00
escape-html
emit-text))
(define-structure htmlout htmlout-interface
(open scsh scsh-utilities string-lib formats ascii receiving scheme)
2000-09-26 10:35:26 -04:00
(files htmlout))
(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
2000-09-26 10:35:26 -04:00
(open scsh ; syscalls
formats ; FORMAT
httpd-core ; REQUEST record type, HTTP-ERROR & reply codes,
; v0.9-request, begin-http-header
httpd-error
htmlout
2000-09-26 10:35:26 -04:00
conditions ; CONDITION-STUFF
url ; HTTP-URL record type
handle-fatal-error ; WITH-FATAL-ERROR-HANDLER
string-lib ; STRING-JOIN
2000-09-26 10:35:26 -04:00
scheme)
(files httpd-handlers))
(define-interface seval-handler-interface
(export seval-handler))
(define-structure seval-handler seval-handler-interface
2000-09-26 10:35:26 -04:00
(open scsh ; syscalls & INDEX
httpd-error
httpd-core ; REQUEST record type, HTTP-ERROR & reply codes,
; v0.9-request, reply formatting stuff.
uri ; UNESCAPE-URI
htmlout ; Formatted HTML output
2000-09-26 10:35:26 -04:00
error-package ; ERROR
pp ; Pretty-printer
string-lib ; STRING-SKIP
rfc822
2000-09-26 10:35:26 -04:00
toothless-eval ; EVAL-SAFELY
handle ; IGNORE-ERROR
parse-html-forms ; PARSE-HTML-FORM-QUERY
threads ; SLEEP
2000-09-26 10:35:26 -04:00
scheme)
(files seval))
(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
2000-09-26 10:35:26 -04:00
(open big-scheme
httpd-core
httpd-error
string-lib ; STRING-MAP
2000-09-26 10:35:26 -04:00
scsh
scheme)
(files httpd-access-control))
(define-interface info-gateway-interface
(export info-handler
find-info-file
info-gateway-error))
(define-structure info-gateway info-gateway-interface
2000-09-26 10:35:26 -04:00
(open big-scheme
2001-04-27 12:19:34 -04:00
string-lib
2000-09-26 10:35:26 -04:00
conditions signals handle
htmlout
2000-09-26 10:35:26 -04:00
httpd-core
httpd-error
url
uri
2000-09-26 10:35:26 -04:00
scsh
handle-fatal-error
2000-09-26 10:35:26 -04:00
scheme)
(files info-gateway))
2000-09-26 11:32:01 -04:00
(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
2000-09-26 11:32:01 -04:00
(open httpd-core
httpd-error
conditions
url
uri
htmlout
2000-09-26 11:32:01 -04:00
httpd-basic-handlers
handle-fatal-error
scsh
let-opt
string-lib
2000-09-26 11:32:01 -04:00
scheme)
(files rman-gateway))
(define-interface ls-interface
(export ls-crlf?
ls
arguments->ls-flags))
(define-structure ls ls-interface
(open scheme handle
2000-09-26 11:32:01 -04:00
big-scheme bitwise
fluids
crlf-io
2000-09-26 11:32:01 -04:00
scsh)
(files ls))
(define-interface ftpd-interface
(export ftpd
ftpd-inetd))
(define-structure ftpd ftpd-interface
2002-04-19 11:50:06 -04:00
(open scsh
2000-09-26 11:32:01 -04:00
conditions handle signals
structure-refs
handle-fatal-error
2002-04-19 11:50:06 -04:00
scheme
threads threads-internal ; last one to get CURRENT-THREAD
2002-04-19 11:50:06 -04:00
locks
thread-fluids ; fork-thread
2001-04-27 12:19:34 -04:00
fluids
string-lib
big-util
2001-04-27 12:19:34 -04:00
defrec-package
crlf-io
ls
2002-04-19 11:50:06 -04:00
let-opt
receiving ; RECEIVE
format-net) ; pretty print of internet-addresses
2000-09-26 11:32:01 -04:00
(access big-scheme)
(files ftpd))
;; some utilities for the following stuff
;; 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))
;; 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))
;; ftp.scm is a module for transfering files between networked
;; machines using the File Transfer Protocol
(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 netrc
scsh
defrec-package
receiving
handle
conditions
signals
error-package
ecm-utilities
string-lib
let-opt
ftp
scheme)
(files ftp-obsolete))
(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))
;; 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))
;; 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-interface nettime-obsolete-interface
(export net:time
net:daytime))
(define-structure nettime nettime-interface
(open scsh
scheme)
(files nettime))
(define-structure nettime-obsolete nettime-obsolete-interface
(open scsh
scheme
nettime)
(files nettime-obsolete))
;;; Here is toothless.scm
;;; Shouldn't the definitions be in an extra file? Andreas.
;;; -*- 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)))))))
2002-04-15 09:53:47 -04:00
;; dns.scm is a module to resolve hostnames and ip-addresses.
;; it implements the rfc1035.
(define-interface dns-interface
2002-04-15 09:53:47 -04:00
(export dns-clear-cache
dns-lookup
dns-lookup-name
2002-04-23 17:42:41 -04:00
dns-inverse-lookup
dns-lookup-ip
dns-lookup-nameserver
dns-lookup-mail-exchanger
concurrent-lookup
2002-04-15 09:53:47 -04:00
show-dns-message
dns-find-nameserver
dns-find-nameserver-list))
(define-structure dns dns-interface
(open scheme
scsh
big-util
tables
ascii
formats
signals
2002-04-15 09:53:47 -04:00
defrec-package
random
queues
threads
locks)
(files dns))