sunet/scheme/packages.scm

882 lines
20 KiB
Scheme

;; Scheme 48 package definitions for the
;; Scheme Underground Networking Suite
;; Interfaces
;; Net protocols and formats
(define-interface parse-html-forms-interface
(export parse-html-form-query unescape-uri+))
(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-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-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-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-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))
(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-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-interface netrc-interface
(export user-mail-address
netrc:lookup
netrc:lookup-password
netrc:lookup-login
netrc:parse
netrc:try-parse
netrc-refuse?))
(define-interface pop3-interface
(export pop3-connect
pop3-login
pop3-stat
pop3-get
pop3-headers
pop3-last
pop3-delete
pop3-reset
pop3-quit))
(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-interface nettime-interface
(export net-time
net-daytime))
(define-interface nettime-obsolete-interface
(export net:time
net:daytime))
(define-interface dns-interface
(export dns-clear-cache ; clears the cache
dns-lookup ; complex lookup function
dns-lookup-name ; simple lookup function
dns-inverse-lookup ; obsolete, use dns-lookup-ip
dns-lookup-ip ; simple lookup function
dns-lookup-nameserver ; simple lookup function
dns-lookup-mail-exchanger ; simple lookpu function
show-dns-message ; prints a human readable dns-msg
force-ip ; reruns a lookup until a ip is resolved
force-ip-list ; reruns a lookup until a list of ips is resolved
address32->ip-string ; converts a address32 in an ip-string
ip-string->address32 ; converts a ip-string in an address32
dns-find-nameserver ; returns a nameserver
dns-find-nameserver-list)) ; returns a list of nameservers
(define-interface cgi-script-interface
(export cgi-form-query))
;; Utility libraries
(define-interface rate-limit-interface
(export make-rate-limiter
rate-limit-block
rate-limit-open
rate-limit-close
rate-limiter-current-requests))
(define-interface crlf-io-interface
(export read-crlf-line
read-crlf-line-timeout
write-crlf))
(define-interface ecm-utilities-interface
(export system-fqdn
safe-first
safe-second
write-crlf
dump))
(define-interface ls-interface
(export ls-crlf?
ls
arguments->ls-flags))
(define-interface format-net-interface
(export format-internet-host-address
format-port))
(define-interface sunet-utilities-interface
(export host-name-or-ip
on-interrupt
socket-address->string))
(define-interface handle-fatal-error-interface
(export with-fatal-error-handler*
(with-fatal-error-handler :syntax)))
;; FTP server
(define-interface ftpd-interface
(export ftpd
ftpd-inetd))
;; Web server
(define-interface httpd-core-interface
(export httpd
make-http-error-response))
(define-interface httpd-make-options-interface
(export with-port
with-root-directory
with-icon-name
with-fqdn
with-reported-port
with-path-handler
with-server-admin
with-simultaneous-requests
with-logfile
with-syslog?
with-resolve-ips?))
(define-interface httpd-read-options-interface
(export httpd-options-port
httpd-options-root-directory
httpd-options-icon-name
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?
httpd-options-resolve-ips?))
(define-interface httpd-access-control-interface
(export access-denier
access-allower
access-controller
access-controlled-handler))
(define-interface httpd-error-interface
(export http-error?
http-error
fatal-syntax-error?
fatal-syntax-error))
(define-interface httpd-logging-interface
(export init-http-log!
*http-syslog?*
http-syslog
http-log))
(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-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-interface httpd-constants-interface
(export server/version
server/protocol))
(define-interface httpd-text-generation-interface
(export time->http-date-string
title-html))
(define-interface httpd-responses-interface
(export make-response response?
response-code
response-message
response-seconds
response-mime
response-extras
response-body
make-writer-body writer-body?
display-http-body))
(define-interface httpd-basic-handlers-interface
(export make-request-handler
make-path-handler
make-hostname-handler
make-path-prefix-handler
alist-path-dispatcher))
(define-interface httpd-file-directory-handlers-interface
(export home-dir-handler
tilde-home-dir-handler
tilde-home-dir-handler-predicate
rooted-file-handler
rooted-file-or-directory-handler
null-path-handler))
(define-interface seval-handler-interface
(export seval-handler))
(define-interface info-gateway-interface
(export info-handler
find-info-file
info-gateway-error))
(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-interface cgi-server-interface
(export cgi-default-bin-path
cgi-handler))
(define-interface loser-interface (export loser))
(define-interface toothless-interface (interface-of scheme))
(define-interface toothless-eval-interface (export eval-safely))
;; Structures
;; Net protocols and formats
(define-structure parse-html-forms parse-html-forms-interface
(open scsh
scsh-utilities
let-opt
string-lib
receiving
uri
scheme)
(files (lib parse-forms)))
(define-structure htmlout htmlout-interface
(open scsh scsh-utilities string-lib formats ascii receiving scheme)
(files (lib htmlout)))
(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 (lib smtp)))
(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 (lib rfc822)))
(define-structure uri uri-interface
(open scsh-utilities
string-lib
let-opt
receiving
ascii
char-set-lib
bitwise
field-reader-package
scheme)
(files (lib uri)))
(define-structure url url-interface
(open defrec-package
receiving
string-lib
char-set-lib
uri
scsh-utilities
httpd-error
scheme)
(files (lib url)))
(define-structure ftp ftp-interface
(open netrc
scsh
defrec-package
receiving
handle
conditions
signals
error-package
ecm-utilities
string-lib
let-opt
scheme)
(files (lib ftp)))
(define-structure ftp-obsolete ftp-obsolete-interface
(open scsh
scheme
ftp)
(files (lib ftp-obsolete)))
(define-structure netrc netrc-interface
(open defrec-package
records
scsh
error-package
ecm-utilities
string-lib
conditions signals handle
let-opt
scheme)
(files (lib netrc)))
(define-structure pop3 pop3-interface
(open netrc
scsh
defrec-package
handle
conditions
signals
ecm-utilities
string-lib
scheme)
(files (lib pop3)))
(define-structure pop3-obsolete pop3-obsolete-interface
(open scsh
scheme
pop3)
(files (lib pop3-obsolete)))
(define-structure nettime nettime-interface
(open scsh
scheme)
(files (lib nettime)))
(define-structure nettime-obsolete nettime-obsolete-interface
(open scsh
scheme
nettime)
(files (lib nettime-obsolete)))
(define-structure dns dns-interface
(open scheme
scsh
big-util
tables
ascii
formats
signals
defrec-package
random
queues
conditions
handle
sort
threads
locks)
(files (lib dns)))
(define-structure cgi-script cgi-script-interface
(open scsh
error-package
parse-html-forms
scheme)
(files (lib cgi-script)))
;; Utility libraries
(define-structure rate-limit rate-limit-interface
(open scheme
define-record-types
locks
signals)
(files (lib rate-limit)))
(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 (lib crlf-io)))
(define-structure ecm-utilities ecm-utilities-interface
(open scsh
string-lib
scheme)
(files (lib ecm-utilities)))
(define-structure ls ls-interface
(open scheme handle
big-scheme bitwise
fluids
crlf-io
scsh)
(files (lib ls)))
(define-structure format-net format-net-interface
(open scsh
scheme
let-opt) ; :optional
(files (lib format-net)))
(define-structure sunet-utilities sunet-utilities-interface
(open scsh
scheme
format-net
sigevents
let-opt
handle-fatal-error)
(files (lib sunet-utilities)))
(define-structure handle-fatal-error handle-fatal-error-interface
(open scheme conditions handle)
(files (httpd handle-fatal-error)))
;; FTP server
(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
dns
let-opt
receiving ; RECEIVE
format-net) ; pretty print of internet-addresses
(access big-scheme)
(files (ftpd ftpd)))
;; Web server
(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
dns ; dns-lookup-ip
sunet-utilities ; socket-address->string
locks ; make-lock et al.
handle-fatal-error
httpd-read-options
httpd-error
httpd-logging
httpd-request
httpd-reply-codes
httpd-constants
httpd-responses
httpd-text-generation
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)))
(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)))
(define-structure httpd-error httpd-error-interface
(open conditions signals handle scheme)
(files (httpd error)))
(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
dns ; dns-lookup-ip
scsh
scheme)
(files (httpd logging)))
(define-structure httpd-reply-codes httpd-reply-codes-interface
(open defenum-package
scheme)
(files (httpd reply-codes)))
(define-structure httpd-request httpd-request-interface
(open define-record-types ;; define-record-discloser
defrec-package ;; define-record
scheme)
(files (httpd request)))
(define-structure httpd-constants httpd-constants-interface
(open scheme)
(files (httpd constants)))
(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)))
(define-structure httpd-responses httpd-responses-interface
(open scheme
srfi-9)
(files (httpd response)))
(define-structure httpd-basic-handlers httpd-basic-handlers-interface
(open scheme scsh
httpd-request ; REQUEST record type, v0.9-request
srfi-1 ; FOLD-RIGHT
srfi-13 ; STRING-TRIM
)
(files (httpd handlers)))
(define-structure httpd-file-directory-handlers httpd-file-directory-handlers-interface
(open scheme scsh
httpd-core
httpd-request
httpd-reply-codes
httpd-responses
httpd-text-generation
httpd-error
httpd-read-options
url
htmlout
crlf-io
srfi-13 ; STRING-JOIN
conditions
handle-fatal-error
)
(files (httpd file-dir-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)))
(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)))
(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)))
(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)))
(define-structure loser (export loser)
(open scheme error-package)
(begin (define (loser name)
(lambda x (error "Illegal call" name)))))
(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"))))
(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)))))))