sunet/modules.scm

;;; Scheme 48 module definitions for TCP/IP protocol suites. 
;;; Copyright (c) 1995 by Olin Shivers.

(define-structures
  ((smtp (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))
   (smtp-internals (export read-crlf-line 	; These two should be in an
			   write-crlf		; auxiliary module.

			   smtp-query
			   nullary-smtp-command
			   unary-smtp-command)))

				
  (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
	switch-syntax		; switchq
	condhax			; ? for COND
	scheme)
  (files smtp))


(define-structure crlf-io (export read-crlf-line
				  read-crlf-line-timeout
				  write-crlf)
  (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))


(define-structures ((switch-syntax  (export (switch  :syntax)
					    (switchq :syntax)))
		    (condhax (export (when   :syntax)
				     (unless :syntax)
				     (?      :syntax))))
  (open scheme)
  (files conditionals))


(define-structure rfc822 (export  read-rfc822-headers
				  read-rfc822-field
				 %read-rfc822-headers
				 %read-rfc822-field
				 rejoin-header-lines
				 get-header-all
				 get-header-lines
				 get-header
				 )
  (open receiving	; MV return (RECEIVE and VALUES)
	condhax		; ? for COND
	scsh-utilities	; index
	string-lib
	let-opt         ; let-optionals
	strings		; lowercase-string uppercase-string
	crlf-io		; read-crlf-line
	ascii		; ascii->char
	error-package	; error
	scsh		; join-strings
	scheme)
  (files rfc822))


(define-structure strings (export string-map
				  downcase-string
				  upcase-string
				  char-set-index
				  char-set-rindex
				  string-reduce
				  skip-whitespace
				  string-prefix?
				  string-suffix?
				  trim-spaces)
  (open char-set-package let-opt scheme) 
  (files stringhax))

(define-structure uri-package (export parse-uri
				      uri-escaped-chars
				      unescape-uri
				      escape-uri
				      resolve-uri
				      split-uri-path
				      uri-path-list->path
				      simplify-uri-path)
  (open scsh-utilities
	string-lib
	let-opt
	receiving
	condhax
	ascii
	strings
	char-set-package
	bitwise
	field-reader-package
	scheme)
  (files uri))

(define-structure url-package (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.

  (open defrec-package
	receiving
	condhax
	string-lib
	char-set-package
	uri-package
	scsh-utilities
	httpd-error
	scheme)
  (files url))


(define-structure httpd-error (export http-error?
				      http-error
				      fatal-syntax-error?
				      fatal-syntax-error)
  (open conditions signals handle scheme)
  (files httpd-error))

(define-structure handle-fatal-error (export with-fatal-error-handler*
					     (with-fatal-error-handler :syntax))
  (open scheme conditions handle)
  (files handle-fatal-error))

(define-structure httpd-core (export server/version
				     server/protocol
				     server/admin
				     set-server/admin!

				     http-log
				     *http-log?*
				     *http-log-port*

				     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

				     set-my-fqdn!
				     set-my-port!)
  (open threads
	scsh
	receiving
	let-opt
	crlf-io
	rfc822
	switch-syntax
	condhax
	strings
	char-set-package
	defrec-package
	define-record-types
	handle
	conditions	; condition-stuff
	defenum-package
	httpd-error
	handle-fatal-error
	uri-package
	url-package
	formats
	scheme)
  (files httpd-core))


;;; For parsing submissions from HTML forms.
(define-structure parse-html-forms (export parse-html-form-query unescape-uri+)
  (open scsh scsh-utilities let-opt string-lib
	receiving uri-package strings condhax scheme)
  (files parse-forms))


;;; For writing CGI scripts in Scheme.
(define-structure cgi-script-package (export cgi-form-query)
  (open scsh
	switch-syntax
	error-package
	parse-html-forms
	scheme)
  (files cgi-script))

;;; Provides the server interface to CGI scripts.
(define-structure cgi-server-package (export cgi-default-bin-path
					     cgi-handler
					     initialise-request-invariant-cgi-env)
  (open strings
	string-lib
	rfc822
	crlf-io			; WRITE-CRLF
	uri-package
	url-package		; HTTP-URL record type
	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
	condhax			; ? is COND
	switch-syntax		; SWITCHQ
	scheme)
  (files cgi-server))

(define-structure htmlout-package (export emit-tag
					  emit-close-tag

					  emit-p
					  emit-title	
					  emit-header	; And so forth...

					  with-tag
					  with-tag*

					  escape-html
					  emit-text)
  (open scsh scsh-utilities strings formats ascii receiving scheme)
  (files htmlout))

(define-structure httpd-basic-handlers (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)
  (open scsh		; syscalls
	formats		; FORMAT
	condhax		; UNLESS, ? for COND
	switch-syntax	; Conditionals
	httpd-core	; REQUEST record type, HTTP-ERROR & reply codes,
			; v0.9-request, begin-http-header
	httpd-error
	htmlout-package
	conditions	; CONDITION-STUFF
	url-package	; HTTP-URL record type
	scheme)
  (files httpd-handlers))


(define-structure seval-handler-package (export seval-handler)
  (open scsh		; syscalls & INDEX
	condhax		; WHEN, ? for COND
	switch-syntax	; Conditionals
	httpd-error
	httpd-core	; REQUEST  record type, HTTP-ERROR & reply codes,
			; v0.9-request, reply formatting stuff.
	uri-package	; UNESCAPE-URI
	htmlout-package	; Formatted HTML output
	error-package	; ERROR
	pp		; Pretty-printer
	strings rfc822
	toothless-eval	; EVAL-SAFELY
	handle		; IGNORE-ERROR
	strings		; SKIP-WHITESPACE
	parse-html-forms ; PARSE-HTML-FORM-QUERY
	scheme)
  (files seval))

(define-structure httpd-access-control (export access-denier
					       access-allower
					       access-controller
					       access-controlled-handler)
  (open big-scheme
	strings
	httpd-core
	httpd-error
	scsh
	scheme)
  (files httpd-access-control))

(define-structure info-gateway (export info-handler
				       find-info-file
				       info-gateway-error)
  (open big-scheme
	string-lib
	conditions signals handle
	switch-syntax
	condhax
	strings
	htmlout-package
	httpd-core
	httpd-error
	url-package
	uri-package
	scsh
	scheme)
  (files info-gateway))

(define-structure rman-gateway (export rman-handler
				       man
				       parse-man-entry
				       cat-man-page
				       find-man-file
				       file->man-directory
				       cat-n-decode
				       nroff-n-decode)
  (open httpd-core
	httpd-error
	conditions
	url-package
	uri-package
	htmlout-package
	httpd-basic-handlers
	switch-syntax
	condhax
	handle-fatal-error
	scsh
	let-opt
	scheme)
  (files rman-gateway))

(define-structure ls (export ls
			     arguments->ls-flags)
  (open scheme
	big-scheme bitwise
	scsh)
  (files ls))
	
(define-structure ftpd (export ftpd
			       ftpd-inetd)
  (open scheme
	conditions handle signals
	structure-refs
	handle-fatal-error
	scsh
	threads
	fluids
	string-lib
	defrec-package
	crlf-io strings ls)
  (access big-scheme)
  (files ftpd))