sunet/scheme/packages.scm

1237 lines
29 KiB
Scheme

;; Scheme 48 package definitions for the
;; Scheme Untergrund Networking Suite
;;; This file is part of the Scheme Untergrund Networking package.
;;; Copyright (c) 1994 by Brian D. Carlstrom and Olin Shivers.
;;; Copyright (c) 1996-2002 by Mike Sperber.
;;; Copyright (c) 2000-2002 by Martin Gasbichler.
;;; Copyright (c) 1998-2001 by Eric Marsden.
;;; Copyright (c) 2005-2006 by Norbert Freudemann.
;;; For copyright information, see the file COPYING which comes with
;;; the distribution.
;; 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 smtp-send-mail
smtp-expand smtp-verify smtp-help
smtp-transactions
smtp-transactions/no-close
smtp-connect
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))
(define-interface rfc822-interface
(export read-rfc822-headers
read-rfc822-headers-with-line-breaks
read-rfc822-field
read-rfc822-field-with-line-breaks
rfc822-time->string))
(define-interface uri-interface
(export parse-uri
uri-escaped-chars
unescape-uri
escape-uri
split-uri
uri-path->uri
simplify-uri-path))
(define-interface url-interface
(export server?
make-server
server-user
server-password
server-host
server-port
parse-server
server->string
http-url?
make-http-url
http-url-server
http-url-path
http-url-search
http-url-fragment-identifier
parse-http-url
parse-http-url-string
http-url->string))
(define-interface ftp-library-interface
(export copy-port->port-binary
copy-port->port-ascii
copy-ascii-port->port
parse-port-arg))
(define-interface ftp-interface
(export ftp-connect
(ftp-type :syntax)
ftp-set-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?
copy-port->port-binary
copy-port->port-ascii
copy-ascii-port->port))
(define-interface netrc-interface
(export netrc-machine-entry
netrc-entry?
netrc-entry-machine
netrc-entry-login
netrc-entry-password
netrc-entry-account
netrc-macro-definitions))
(define-interface pop3-interface
(export pop3-connect
pop3-stat
pop3-retrieve-message
pop3-retrieve-headers
pop3-last
pop3-delete
pop3-reset
pop3-quit
pop3-error?))
(define-interface rfc868-interface
(export rfc868-time/tcp rfc868-time/udp))
(define-interface rfc867-interface
(export rfc867-daytime/tcp rfc867-daytime/udp))
(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 lookup function
pretty-print-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
dns-check-nameservers ; checks for working nameservers
socket-address->fqdn
host-fqdn
system-fqdn
address32? ; for dnsd.scm
octet-pair->number ; -"-
number->octet-pair ; -"-
parse ; -"- produces a message-record-type
mc-message->octets ; -"- produces a byte-encoded (compressed) message
make-fqdn-name ; -"- maybe adds an ending dot to a string
fqdn? ; -"- checks for fully quallified domain names
cut-name ; -"- domain name split tool
dn-split? ; -"- domain name split tool
dns-server-error? ; -"- error condition predicate
dns-format-error? ; -"-
dns-server-failure? ; -"-
dns-name-error? ; -"-
dns-not-implemented? ; -"-
dns-refused? ; -"-
dns-error? ; -"-
bad-nameserver? ; -"-
dns-query/cache ; -"-
add-size-tag
(network-protocol :syntax)
network-protocol?
dns-lookup
dns-message? dns-message-query dns-message-reply dns-message-cache?
dns-message-protocol dns-message-tried-nameservers
pretty-print-dns-message
make-message message? message-header message-questions message-answers
message-nameservers message-additionals message-source
set-message-source!
make-query-message make-simple-query-message
make-header header? header-id header-flags header-question-count
header-answer-count header-nameserver-count header-additional-count
make-flags flags? flags-query-type flags-opcode flags-authoritative?
flags-truncated? flags-recursion-desired? flags-recursion-available?
flags-zero flags-response-code set-flags-response-code!
set-flags-authoritative! set-flags-recursion-available!
set-flags-truncated!
make-question question? question-name question-type question-class
(message-class :syntax)
message-class? message-class-name message-class-number
the-message-class
message-class-number->type
message-class-symbol->type
(message-type :syntax)
message-type? message-type-name message-type-number
the-message-type
message-type-number->type
message-type-symbol->type
make-resource-record
resource-record?
resource-record-name
resource-record-type
resource-record-class
resource-record-ttl
resource-record-data
make-resource-record-data-a
resource-record-data-a?
resource-record-data-a-ip
make-resource-record-data-ns
resource-record-data-ns?
resource-record-data-ns-name
make-resource-record-data-cname
resource-record-data-cname?
resource-record-data-cname-name
make-resource-record-data-mx
resource-record-data-mx?
resource-record-data-mx-preference
resource-record-data-mx-exchanger
make-resource-record-data-ptr
resource-record-data-ptr?
resource-record-data-ptr-name
make-resource-record-data-soa
resource-record-data-soa?
resource-record-data-soa-mname
resource-record-data-soa-rname
resource-record-data-soa-serial
resource-record-data-soa-refresh
resource-record-data-soa-retry
resource-record-data-soa-expire
resource-record-data-soa-minimum
make-resource-record-data-aaaa
resource-record-data-aaaa?
resource-record-data-aaaa-ipv6
make-resource-record-data-hinfo
resource-record-data-hinfo?
resource-record-data-hinfo-data
make-resource-record-data-txt
resource-record-data-txt?
resource-record-data-txt-text
cache? cache-answer cache-ttl cache-time
resolv.conf-parse-error?
resolv.conf parse-resolv.conf!
domains-for-search))
(define-interface ips-interface
(export address32->ip-string
ip-string->address32
ip-string->in-addr.arpa-string
octet-ip->address32 ;for dns.scm
address32->octet-ip ;for dns.scm
ip-string?))
(define-interface cgi-scripts-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 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
dump
copy-inport->outport
dotdot-check
with-lock
get-header))
(define-interface handle-fatal-error-interface
(export with-fatal-error-handler*
(with-fatal-error-handler :syntax)))
;; DNS server
(define-interface dnsd-silex-interface
(export lexer
lexer-getc
lexer-ungetc
lexer-init))
(define-interface dnsd-rw-locks-interface
(export make-r/w-lock
obtain-R/w-lock
obtain-r/W-lock
release-R/w-lock
release-r/W-lock
with-R/w-lock
with-r/W-lock))
(define-interface dnsd-semaphores-interface
(export make-semaphore
set-semaphore!
semaphore-post
semaphore-wait))
(define-interface dnsd-mf-parser-interface
(export parse-mf))
(define-interface dnsd-logging-interface
(export display-debug
apply-w/debug
dnsd-log))
(define-interface dnsd-rr-def-interface
(export dns-rr-a
dns-rr-ns
dns-rr-cname
dns-rr-soa
dns-rr-ptr
dns-rr-hinfo
dns-rr-mx
dns-rr-txt
dns-rr-aaaa))
(define-interface dnsd-options-interface
(export make-default-dnsd-options
make-options-from-list
dnsd-options?
dnsd-options-port
dnsd-options-dir
dnsd-options-nameservers
dnsd-options-use-axfr?
dnsd-options-use-cache?
dnsd-options-cleanup-interval
dnsd-options-retry-interval
dnsd-options-use-db?
dnsd-options-use-recursion?
dnsd-options-rec-timeout
dnsd-options-socket-timeout
dnsd-options-socket-max-tries
dnsd-options-max-connections
dnsd-options-blacklist-time
dnsd-options-blacklist-value
dnsd-options-use-pre/post
dnsd-options-debug-mode
with-port
with-dir
with-nameservers
with-axfr
with-cache
with-cleanup-interval
with-retry-interval
with-db
with-recursion
with-rec-timeout
with-socket-timeout
with-socket-max-tries
with-max-connections
with-blacklist-time
with-blacklist-value
with-use-pre/post
with-debug-mode))
(define-interface dnsd-database-interface
(export maybe-get-soa-rr-name
db-clear-database
db-clear-zone
db-update-zone
db-get-zone
db-get-zone-for-axfr
db-get-zone-soa-rr
db-pretty-print
db-lookup-rec))
(define-interface dnsddb-options-interface
(export make-default-dnsddb-options
make-db-options-from-list
dnsddb-options?
dnsddb-options-name
dnsddb-options-class
dnsddb-options-type
dnsddb-options-primary? ;; depreached
dnsddb-options-file
dnsddb-options-filetype
dnsddb-options-master-name
dnsddb-options-master-ip
with-name
with-class
with-type
with-primary?
with-file
with-filetype
with-master-name
with-master-ip))
(define-interface dnsd-cache-interface
(export dnsd-cache-clear!
dnsd-cache-clean!
dnsd-cache-lookup?
dnsd-cache-update!
dnsd-cache-pretty-print))
(define-interface dnsd-slist-interface
(export dnsd-slist-clear!
dnsd-slist-clean!
dnsd-slist-lookup
dnsd-slist-update!
dnsd-slist-pretty-print
dnsd-blacklist-clear!
;deprecated dnsd-blacklist-clean!
dnsd-blacklist!
dnsd-blacklist-unlist!
dnsd-blacklist-print))
(define-interface dnsd-resolver-interface
(export dnsd-ask-resolver-rec
dnsd-ask-resolver-direct
;; Some stuff needed in dnsd.scm:
msg-set-rcode!
make-response))
(define-interface dnsd-interface
(export))
;; FTP server
(define-interface ftpd-interface
(export with-port with-anonymous-home with-banner with-log-port with-dns-lookup?
make-ftpd-options
ftpd
ftpd-inetd))
;; Web server
(define-interface httpd-core-interface
(export httpd))
(define-interface httpd-make-options-interface
(export make-httpd-options
with-port
with-root-directory
with-fqdn
with-reported-port
with-request-handler
with-server-admin
with-simultaneous-requests
with-log-file
with-syslog?
with-resolve-ips?
with-post-bind-thunk))
(define-interface httpd-read-options-interface
(export httpd-options-port
httpd-options-root-directory
httpd-options-fqdn
httpd-options-reported-port
httpd-options-request-handler
httpd-options-server-admin
httpd-options-simultaneous-requests
httpd-options-log-file
httpd-options-syslog?
httpd-options-resolve-ips?
httpd-options-post-bind-thunk))
(define-interface httpd-access-control-interface
(export access-denier
access-allower
access-controller
access-controlled-handler))
(define-interface httpd-errors-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
logging
make-logging))
(define-interface httpd-requests-interface
(export make-request ; HTTP request
request? ; record type.
request-method
request-uri
request-url
request-version
request-headers
request-socket
version< version<=
v0.9-request?
version->string))
(define-interface httpd-responses-interface
(export make-response response?
response-code
response-message
response-seconds
response-mime
response-extras
response-body
make-nph-response nph-response?
nph-response-body
make-input-response input-response?
input-response-body-maker
make-writer-body writer-body?
make-reader-writer-body reader-writer-body?
make-redirect-body redirect-body? redirect-body-location
display-http-body
status-code?
status-code-number
status-code-message
(status-code :syntax)
name->status-code
number->status-code
make-error-response
make-redirect-response))
(define-interface httpd-basic-handlers-interface
(export make-predicate-handler
make-path-predicate-handler
make-host-name-handler
make-path-prefix-handler
alist-path-dispatcher
null-request-handler))
(define-interface httpd-file-directory-handlers-interface
(export home-dir-handler
tilde-home-dir-handler
rooted-file-handler
rooted-file-or-directory-handler
make-file-directory-options
with-file-name->content-type
with-file-name->content-encoding
with-file-name->icon-url
with-blank-icon-url
with-back-icon-url
with-unknown-icon-url))
(define-interface httpd-seval-handlers-interface
(export seval-handler))
(define-interface httpd-info-gateway-interface
(export info-handler
find-info-file
info-gateway-error))
(define-interface httpd-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 httpd-cgi-handlers-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
(define-structure sunet-version (export sunet-version-identifier)
(open scheme)
(begin
(define sunet-version-identifier "2.1")))
;; Net protocols and formats
(define-structure parse-html-forms parse-html-forms-interface
(open scheme-with-scsh
let-opt
(subset srfi-13 (string-index string-map))
receiving
uri)
(files (lib parse-forms)))
(define-structure htmlout htmlout-interface
(open scheme-with-scsh
(subset srfi-13 (string-fold))
formats
ascii
receiving)
(files (lib htmlout)))
(define-structure smtp smtp-interface
(open scheme-with-scsh
signals conditions
define-record-types
(subset srfi-1 (filter-map))
(subset srfi-13 (string-tokenize string-join))
crlf-io ; read-crlf-line write-crlf
receiving ; values receive
dns ; SYSTEM-FQDN
let-opt
(subset rfc822 (rfc822-time->string)))
(files (lib smtp)))
(define-structure rfc822 rfc822-interface
(open scheme-with-scsh
receiving
(subset srfi-13 (string-map string-index string-concatenate))
let-opt
crlf-io
ascii)
(files (lib rfc822)))
(define-structure uri uri-interface
(open scheme-with-scsh
(subset srfi-13 (string-index string-index-right string-fold string-join))
let-opt
receiving
ascii
bitwise
field-reader-package)
(files (lib uri)))
(define-structure url url-interface
(open scheme-with-scsh
define-record-types
receiving
(subset srfi-13 (string-index))
uri
httpd-errors)
(files (lib url)))
(define-structure ftp-library ftp-library-interface
(open scheme-with-scsh
(subset signals (call-error))
(subset srfi-1 (any))
crlf-io)
(files (lib ftp-library)))
(define-structure ftp ftp-interface
(open scheme-with-scsh
netrc
define-record-types
finite-types
receiving
handle
conditions
signals
(subset srfi-13 (string-join string-prefix?))
let-opt
sunet-utilities
format-net
crlf-io
ftp-library)
(files (lib ftp)))
(define-structure netrc netrc-interface
(open scheme-with-scsh
define-record-types
srfi-14)
(files (lib netrc)))
(define-structure pop3 pop3-interface
(open scheme-with-scsh
netrc rfc822
define-record-types
handle
conditions handle-fatal-error
signals
(subset srfi-13 (string-index string-prefix? string-join))
let-opt
crlf-io)
(files (lib pop3)))
(define-structures ((rfc867 rfc867-interface)
(rfc868 rfc868-interface))
(open scheme-with-scsh
handle-fatal-error)
(files (lib nettime)))
(define-structure dns dns-interface
(open scheme-with-scsh
(subset srfi-1 (filter reverse! delete lset-difference lset-union
fold fold-right concatenate))
tables
ascii
formats
signals
finite-types
define-record-types
queues
conditions
handle
sort
threads
locks
ips
srfi-27)
(files (lib dns)))
(define-structure ips ips-interface
(open scheme-with-scsh
formats)
(files (lib ip)))
(define-structure cgi-scripts cgi-scripts-interface
(open scheme-with-scsh
parse-html-forms)
(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 scheme-with-scsh
ascii ; ascii->char
receiving ; MV return (RECEIVE and VALUES)
let-opt ; let-optionals
threads ; sleep
)
(files (lib crlf-io)))
(define-structure ls ls-interface
(open scheme-with-scsh
handle
(subset srfi-1 (filter))
bitwise
fluids
crlf-io)
(files (lib ls)))
(define-structure format-net format-net-interface
(open scheme-with-scsh
let-opt)
(files (lib format-net)))
(define-structure sunet-utilities sunet-utilities-interface
(open scheme-with-scsh
format-net
sigevents
(subset srfi-13 (string-join))
dns
let-opt ; :optional
locks
handle-fatal-error)
(files (lib sunet-utilities)))
(define-structure handle-fatal-error handle-fatal-error-interface
(open scheme conditions handle)
(files (lib handle-fatal-error)))
;; DNS server ******************************************************************
(define-structure dnsd dnsd-interface
(open scheme-with-scsh
(subset srfi-1 (fold-right take drop filter lset-difference lset-union))
srfi-2
(subset srfi-13 (string-downcase))
threads
thread-fluids ;; fork-thread
rendezvous ; Needs SUnterlib
rendezvous-channels ; Needs SUnterlib
tables
ascii
finite-types
define-record-types
handle-fatal-error
ips ;???
dns
dnsd-options
dnsd-logging
dnsddb-options
;; dnsd-rw-locks
dnsd-semaphores
dnsd-rr-def
dnsd-mf-parser
dnsd-database
dnsd-cache
dnsd-slist
dnsd-resolver)
(files (dnsd dnsd)))
(define-structure dnsd-resolver dnsd-resolver-interface
(open scheme-with-scsh
(subset srfi-1 (fold-right delete filter take drop))
srfi-2
srfi-27 ; for shake-list
threads
thread-fluids ;; fork-thread
rendezvous ; Needs SUnterlib
rendezvous-channels ; Needs SUnterlib
define-record-types
handle-fatal-error
dns
dnsd-cache
dnsd-logging
dnsd-slist
dnsd-options)
(files (dnsd resolver)))
(define-structure dnsd-logging dnsd-logging-interface
(open scheme-with-scsh)
(files (dnsd logging)))
(define-structure dnsddb-options dnsddb-options-interface
(open scheme-with-scsh
define-record-types
dns)
(files (dnsd db-options)))
(define-structure dnsd-database dnsd-database-interface
(open scheme-with-scsh
(subset srfi-1 (fold-right))
srfi-2
(subset srfi-13 (string-downcase))
define-record-types
tables
dns
dnsd-rw-locks
dnsd-logging)
(files (dnsd database)))
(define-structure dnsd-cache dnsd-cache-interface
(open scheme-with-scsh
define-record-types
(subset srfi-1 (fold-right))
(subset srfi-13 (string-downcase))
tables
dns
dnsd-rw-locks)
(files (dnsd cache)))
(define-structure dnsd-slist dnsd-slist-interface
(open scheme-with-scsh
define-record-types
(subset srfi-1 (fold-right filter))
srfi-2
(subset srfi-13 (string-downcase))
tables
dns
dnsd-options
dnsd-rw-locks)
(files (dnsd slist)))
(define-structure dnsd-options dnsd-options-interface
(open scheme-with-scsh
define-record-types)
(files (dnsd options)))
(define-structure dnsd-rw-locks dnsd-rw-locks-interface
(open scheme-with-scsh
locks
threads
define-record-types)
(files (dnsd rw-locks)))
(define-structure dnsd-semaphores dnsd-semaphores-interface
(open scheme-with-scsh
define-record-types
locks)
(files (dnsd semaphores)))
(define-structure dnsd-rr-def dnsd-rr-def-interface
(open scheme-with-scsh
ips
dns
srfi-2)
(files (dnsd rr-def)))
(define-structure dnsd-mf-parser dnsd-mf-parser-interface
(open scheme-with-scsh
(subset srfi-1 (fold-right))
srfi-2
(subset srfi-13 (string-downcase))
handle-fatal-error
dns
dnsd-options
dnsd-logging
dnsd-silex
dnsd-rr-def)
(files (dnsd masterfile-parser)))
(define-structure dnsd-silex dnsd-silex-interface
(open scheme-with-scsh)
(files (dnsd masterfile.l)))
;; FTP server
(define-structure ftpd ftpd-interface
(open scheme-with-scsh
conditions handle signals
define-record-types
handle-fatal-error
threads threads-internal ; last one to get CURRENT-THREAD
fluids thread-fluids
locks
(subset srfi-13 (string-map string-trim-both string-index))
(subset srfi-1 (partition))
crlf-io
ls
ftp-library
dns
sunet-version
sunet-utilities
receiving
format-net)
(files (ftpd ftpd)))
;; Web server
(define-structure httpd-core httpd-core-interface
(open scheme-with-scsh
thread-fluids ; fork-thread
receiving
crlf-io ; write-crlf, read-crlf-line
rfc822
handle ; ignore-errors
conditions ; condition-stuff
uri
url
format-net
rate-limit ; rate-limiting stuff
(subset srfi-13 (string-index))
dns ; dns-lookup-ip
sunet-utilities ; socket-address->string
locks ; make-lock et al.
fluids ; let-fluid
enumerated ; enum
architecture ; os-error
handle-fatal-error
httpd-read-options
httpd-errors
httpd-logging
httpd-requests
httpd-responses
sunet-version
)
(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 (compound-interface httpd-core-interface
httpd-make-options-interface)
(open httpd-core
httpd-make-options))
(define-structure httpd-access-control httpd-access-control-interface
(open scheme-with-scsh
(subset srfi-1 (any every))
httpd-responses
httpd-requests
httpd-errors
(subset srfi-13 (string-map))
)
(files (httpd access-control)))
(define-structure httpd-errors httpd-errors-interface
(open conditions signals handle scheme)
(files (httpd error)))
(define-structure httpd-logging httpd-logging-interface
(open scheme-with-scsh
httpd-read-options
i/o ; make-null-output-port
locks
receiving
uri ; uri-path->uri
url ; http-url-path
httpd-requests ; request record
httpd-responses
formats
format-net ; format-internet-host-address
(subset srfi-13 (string-join string-trim))
rfc822 ; get-header
sunet-utilities ; on-interrupt
threads ; spawn
dns ; dns-lookup-ip
define-record-types
thread-fluids ; make-preserved-fluid et al.
handle-fatal-error
)
(files (httpd logging)))
(define-structure httpd-requests httpd-requests-interface
(open scheme
define-record-types)
(files (httpd request)))
(define-structure httpd-responses httpd-responses-interface
(open scheme
(subset scsh (format-date write-string time date))
syslog
define-record-types
finite-types
formats
(subset signals (call-error))
httpd-requests
httpd-read-options)
(files (httpd response)))
(define-structure httpd-basic-handlers httpd-basic-handlers-interface
(open scheme-with-scsh
rfc822
httpd-requests ; REQUEST record type, v0.9-request
(subset srfi-1 (fold-right))
(subset srfi-13 (string-trim string-prefix-ci?))
httpd-responses
httpd-errors
)
(files (httpd handlers)))
(define-structure httpd-file-directory-handlers httpd-file-directory-handlers-interface
(open scheme-with-scsh
define-record-types
httpd-core
httpd-requests
httpd-responses
httpd-errors
httpd-basic-handlers
httpd-read-options
url
htmlout
crlf-io
(subset srfi-13 (string-join))
(subset rfc822 (rfc822-time->string))
sunet-utilities ; dotdot-check, copy-inport->outport
conditions
let-opt
handle-fatal-error
)
(files (httpd file-dir-handler)))
(define-structure httpd-seval-handlers httpd-seval-handlers-interface
(open scheme-with-scsh ; syscalls & INDEX
httpd-errors
httpd-requests ; v0.9-request
httpd-responses
httpd-logging ; http-log
uri ; UNESCAPE-URI
htmlout ; Formatted HTML output
pp
(subset srfi-13 (string-skip))
rfc822
toothless-eval ; EVAL-SAFELY
handle ; IGNORE-ERROR
parse-html-forms ; PARSE-HTML-FORM-QUERY
threads ; SLEEP
sunet-utilities ; GET-HEADER
)
(files (httpd seval)))
(define-structure httpd-info-gateway httpd-info-gateway-interface
(open scheme-with-scsh
(subset srfi-1 (find))
(subset srfi-13 (string-map string-skip string-index))
conditions signals handle
htmlout
httpd-requests
httpd-responses
httpd-errors
url
uri
handle-fatal-error)
(files (httpd info-gateway)))
(define-structure httpd-rman-gateway httpd-rman-gateway-interface
(open scheme-with-scsh
httpd-responses
httpd-requests
httpd-errors
conditions
url
uri
htmlout
httpd-basic-handlers
handle-fatal-error
let-opt
sunet-utilities
(subset srfi-13 (string-join))
)
(files (httpd rman-gateway)))
(define-structure httpd-cgi-handlers httpd-cgi-handlers-interface
(open scheme-with-scsh
(subset srfi-1 (alist-delete))
(subset srfi-13 (string-prefix? string-index string-trim substring/shared))
rfc822
crlf-io ; WRITE-CRLF
uri
url ; HTTP-URL record type
httpd-logging
httpd-requests
httpd-responses
httpd-basic-handlers ; HTTP-HOMEDIR, SERVE-ROOTED-FILE-PATH
httpd-errors ; HTTP-ERROR
httpd-file-directory-handlers ; dot-dot-check, copy-inport->outport
sunet-version
formats
format-net
sunet-utilities ; host-name-or-empty, get-header
let-opt ; let-optionals
handle-fatal-error
)
(files (httpd cgi-server)))
(define-structure loser (export loser)
(open scheme signals)
(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 scheme
package-commands-internal ; config-package, get-reflective-tower
packages ; structure-package, make-simple-package
environments ; environment-ref
handle ; ignore-errors
)
(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)))))))