;; 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)))))))