(FILECREATED " 9-Jan-86 05:20:28" {ERIS}<LISPUSERS>KOTO>COURIERSERVE.;7 20743
changes to: (FNS \COURIER.SERVE)
previous date: " 7-Jan-86 16:10:49" {ERIS}<LISPUSERS>KOTO>COURIERSERVE.;5)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COURIERSERVECOMS)
(RPAQQ COURIERSERVECOMS ((FNS COURIER.START.SERVER COURIER.RETURN COURIER.ABORT COURIER.REJECT
CLOSE.BULK.DATA)
(FNS \COURIERSERVER \COURIER.SERVE \COURIER.APPLY \COURIER.SETUP.REPLY
\COURIER.FINISH.REPLY \FIND.COURIER.PROGRAM \FIND.COURIER.PROCEDURE)
(FNS \EXPEDITEDCOURIERSERVER \EXPEDITEDCOURIER.SERVE
\CREATE.EXPEDITED.STREAM)
(CONSTANTS (\REJECT.NOSUCHPROGRAM 0)
(\REJECT.NOSUCHVERSION 1)
(\REJECT.NOSUCHPROCEDURE 2)
(\REJECT.INVALIDARGUMENTS 3)
(\REJECT.UNSPECIFIED 65535)
(\SINK.NULL 0)
(\SINK.IMMEDIATE 1)
(\SINK.PASSIVE 2)
(\SINK.ACTIVE 3))
(DECLARE: DONTCOPY (RECORDS COURIERSERVERFN XIPSOCKETPAIR))
(* Old)
(FNS \COURIERLISTENER)))
(DEFINEQ
(COURIER.START.SERVER
[LAMBDA NIL (* lmm " 7-Jan-86 16:08")
(if (NOT (FIND.PROCESS (QUOTE COURIER.LISTENER)))
then (if COURIERTRACEFLG
then (printout COURIERTRACEFILE T "Courier Server started"))
(SPP.OPEN NIL \NS.WKS.Courier NIL (QUOTE COURIER.LISTENER)
(QUOTE (SERVER.FUNCTION \COURIERSERVER OTHERXIPHANDLER
\EXPEDITEDCOURIERSERVER])
(COURIER.RETURN
[LAMBDA (COURIERSTREAM PROGRAM PROCEDURE RESULTLST) (* cdl "26-Nov-85 17:10")
(LET (RESULTS STREAM)
(SETQ RESULTS (with COURIERFN (\GET.COURIER.DEFINITION PROGRAM PROCEDURE (QUOTE
PROCEDURES)
(\GET.COURIERPROGRAM PROGRAM))
RESULTS))
(if (EQLENGTH RESULTLST (LENGTH RESULTS))
then (SETQ STREAM (\COURIER.SETUP.REPLY COURIERSTREAM \COURIERMSG.RETURN))
(if (\COURIER.EXPEDITED.ARGS STREAM PROGRAM RESULTLST RESULTS)
then (\COURIER.FINISH.REPLY COURIERSTREAM STREAM)
else (COURIER.REJECT COURIERSTREAM))
else (COURIER.REJECT COURIERSTREAM \REJECT.INVALIDARGUMENTS))])
(COURIER.ABORT
[LAMBDA (COURIERSTREAM PROGRAM ERROR RESULTLST) (* cdl "26-Nov-85 17:20")
(LET [(STREAM (\COURIER.SETUP.REPLY COURIERSTREAM \COURIERMSG.ABORT))
(ERRORFORM (CDR (ASSOC ERROR (fetch (COURIERPGM ERRORS) of (\GET.COURIERPROGRAM
PROGRAM]
(PUTWORD STREAM (CAR ERRORFORM))
(if (\COURIER.EXPEDITED.ARGS STREAM PROGRAM RESULTLST (CADR ERRORFORM))
then (\COURIER.FINISH.REPLY COURIERSTREAM STREAM)
else (COURIER.REJECT \REJECT.INVALIDARGUMENTS))])
(COURIER.REJECT
[LAMBDA (COURIERSTREAM ERROR RESULTLST) (* cdl "26-Nov-85 17:21")
(* DECLARATIONS: (RECORD VERSIONRANGE
(LOWEST . HIGHEST)))
(LET ((STREAM (\COURIER.SETUP.REPLY COURIERSTREAM \COURIERMSG.REJECT)))
[if (NOT (NUMBERP ERROR))
then (SETQ ERROR (SELECTQ ERROR
((NIL UNSPECIFIED)
\REJECT.UNSPECIFIED)
(NO.SUCH.PROGRAM \REJECT.NOSUCHPROGRAM)
(NO.SUCH.VERSION \REJECT.NOSUCHVERSION)
(NO.SUCH.PROCEDURE \REJECT.NOSUCHPROCEDURE)
(INVALID.ARGUMENTS \REJECT.INVALIDARGUMENTS)
(SHOULDNT]
(PUTWORD STREAM ERROR)
(SELECTC ERROR
(\REJECT.NOSUCHVERSION (with VERSIONRANGE RESULTLST (PUTWORD STREAM LOWEST)
(PUTWORD STREAM HIGHEST)))
NIL)
(\COURIER.FINISH.REPLY COURIERSTREAM STREAM])
(CLOSE.BULK.DATA
[LAMBDA (STREAM ABORTFLG) (* cdl "13-Nov-85 19:49")
(* Close a Bulk Data stream after the transfer has taken place. If a result function was specified in COURIER.CALL,
call it on the stream and the result or list of results.)
(PROG ((CON (GETSPPCON STREAM)))
(replace SPPATTENTIONFN of CON with NIL)
(if (NULL (fetch SPPSUBSTREAM of CON))
then (* This stream has already been closed.
We don't want to try to read the Courier results
twice)
(RETURN))
(if (WRITEABLE STREAM)
then (if ABORTFLG
then (SPP.SENDATTENTION STREAM 1)
else (SPP.SENDEOM STREAM))
elseif (NOT (\EOFP STREAM))
then (* Closing before all the data has been read -- abort
the transfer.)
(if (NOT ABORTFLG)
then (SETQ ABORTFLG T))
(\ABORT.BULK.DATA STREAM))
(SPP.DSTYPE STREAM \SPPDSTYPE.COURIER)
(with SPPCON CON (SETQ SPPINPKT NIL)
(SETQ SPPSUBSTREAM NIL)) (* This stream is closing; make sure there aren't any
dangling pointers into the middle of ether packets.)
(with STREAM STREAM (SETQ CBUFPTR NIL)
(SETQ CBUFSIZE 0))
(* The result of the Courier call may be an error which the user should see; however, we still need to clean up the
substream, so we wrap it in this RESETLST.)
(if ABORTFLG
then (replace ENDOFSTREAMOP of (fetch SPPINPUTSTREAM of CON)
with (FUNCTION \COURIER.EOF))
(replace ENDOFSTREAMOP of STREAM with (FUNCTION ERROR!])
)
(DEFINEQ
(\COURIERSERVER
[LAMBDA (STREAM) (* cdl "12-Dec-85 18:27")
(DECLARE (SPECVARS STREAM))
(RESETLST (RESETSAVE NIL (BQUOTE (CLOSEF? , STREAM)))
(PROG (LOW.VERSION HIGH.VERSION)
(SPP.DSTYPE STREAM \SPPDSTYPE.COURIER)
(with STREAM STREAM (SETQ ENDOFSTREAMOP (FUNCTION \COURIER.EOF)))
(PROCESS.NAME (THIS.PROCESS)
(PACK* (QUOTE COURIER)
(SPP.DESTADDRESS STREAM)))
(if COURIERTRACEFLG
then (printout COURIERTRACEFILE T "Server opened connection with" ,
(SPP.DESTADDRESS STREAM)))
(SETQ LOW.VERSION (GETWORD STREAM))
(SETQ HIGH.VERSION (GETWORD STREAM))
(PUTWORD STREAM COURIER.VERSION#)
(PUTWORD STREAM COURIER.VERSION#)
(SPP.FORCEOUTPUT STREAM)
(if (AND (ILEQ LOW.VERSION COURIER.VERSION#)
(ILEQ COURIER.VERSION# HIGH.VERSION))
then (\COURIER.SERVE STREAM)
else (if COURIERTRACEFLG
then (printout COURIERTRACEFILE T
"Client requesting unknown version of Courier"
,
(SPP.DESTADDRESS STREAM)
, LOW.VERSION , HIGH.VERSION])
(\COURIER.SERVE
[LAMBDA (STREAM) (* lmm " 9-Jan-86 05:20")
(SPP.CLEAREOM STREAM T)
(until (SPP.EOFP STREAM)
do (SELECTC (GETWORD STREAM)
[\COURIERMSG.CALL (PROG (PROGRAM PROGRAM# VERSION# PROCEDURE# PROCEDURE
PGMDEF PROCDEF VERSIONS RESULTLST)
(GETWORD STREAM)
(* Skip the Transaction ID.)
(SETQ PROGRAM# (GETLONG STREAM))
(SETQ VERSION# (GETWORD STREAM))
(SETQ PROCEDURE# (GETWORD STREAM))
(if (SETQ VERSIONS (\FIND.COURIER.PROGRAM
PROGRAM#))
then [if (SETQ PROGRAM
(CDR (FASSOC VERSION#
VERSIONS)))
then
(if (SETQ PROCEDURE
(\FIND.COURIER.PROCEDURE
(SETQ PGMDEF
(\GET.COURIERPROGRAM
PROGRAM))
PROCEDURE#))
then
(SETQ PROCDEF
(\GET.COURIER.DEFINITION
PROGRAM PROCEDURE
(QUOTE PROCEDURES)
PGMDEF))
(with COURIERSERVERFN PROCDEF
(if SERVERFN
then
(\COURIER.APPLY
SERVERFN STREAM
PROGRAM
PROCEDURE PGMDEF
PROCDEF)
else (
COURIER.REJECT
STREAM
\REJECT.NOSUCHPROCEDURE)))
else (COURIER.REJECT STREAM
\REJECT.NOSUCHPROCEDURE))
else
(COURIER.REJECT
STREAM \REJECT.NOSUCHVERSION
(CONS (in VERSIONS smallest
CAR
finally (RETURN
$$EXTREME))
(in VERSIONS LARGEST
CAR
FINALLY (RETURN
$$EXTREME]
else (COURIER.REJECT STREAM
\REJECT.NOSUCHPROGRAM]
(SHOULDNT])
(\COURIER.APPLY
[LAMBDA (FN STREAM PROGRAM PROCEDURE PGMDEF PROCDEF) (* cdl " 5-Dec-85 18:27")
(DECLARE (SPECVARS FN STREAM PROGRAM PROCEDURE PGMDEF PROCDEF))
(RESETLST (PROG (XIPSOCKETPAIR ARGLST RESULTS DATASTREAM)
(DECLARE (SPECVARS XIPSOCKETPAIR ARGLST))
[if (type? XIPSOCKETPAIR STREAM)
then (with XIPSOCKETPAIR (SETQ XIPSOCKETPAIR STREAM)
(SETQ STREAM (\CREATE.EXPEDITED.STREAM
XIP
(QUOTE INPUT)
NIL
(INDEXF (fetch (EXPEDITEDXIP ARG0) of T]
[SETQ ARGLST (for TYPE in (with COURIERFN PROCDEF ARGS)
collect (SELECTQ TYPE
((BULK.DATA.SINK BULK.DATA.SOURCE)
(SELECTC (GETWORD STREAM)
(\SINK.IMMEDIATE NIL)
((LIST \SINK.NULL
\SINK.PASSIVE
\SINK.ACTIVE)
(* Server only handles IMMEDIATE transfer, error out
as cleanly as we can)
(COURIER.REJECT
STREAM)
(RETURN))
(SHOULDNT))
(SETQ DATASTREAM
(\BULK.DATA.STREAM
STREAM
(if (EQ TYPE (QUOTE
BULK.DATA.SOURCE))
then (QUOTE INPUT)
else (QUOTE OUTPUT))
PROGRAM PROCEDURE PGMDEF PROCDEF)
))
(COURIER.READ STREAM PROGRAM TYPE]
(if (NULL XIPSOCKETPAIR)
then (if (EQ (QUOTE EOM)
(SPP.EOFP STREAM))
then (SPP.CLEAREOM STREAM)))
(if [SETQ RESULTS (NLSETQ (APPLY FN (LIST* (OR XIPSOCKETPAIR
STREAM)
PROGRAM PROCEDURE ARGLST]
then (SETQ RESULTS (CAR RESULTS))
else (if COURIERTRACEFLG
then (printout COURIERTRACEFILE T
"Courier server function break:"
, FN))
(COURIER.REJECT (OR XIPSOCKETPAIR STREAM)
\REJECT.UNSPECIFIED)
(RETURN))
(if (AND DATASTREAM (OPENP DATASTREAM))
then (CLOSE.BULK.DATA DATASTREAM))
(SELECTQ (CAR RESULTS)
(RETURN (COURIER.RETURN (OR XIPSOCKETPAIR STREAM)
PROGRAM PROCEDURE (CDR RESULTS)))
(ABORT (COURIER.ABORT (OR XIPSOCKETPAIR STREAM)
PROGRAM
(CADR RESULTS)
(CDDR RESULTS)))
(REJECT (COURIER.REJECT (OR XIPSOCKETPAIR STREAM)
(CADR RESULTS)
(CDDR RESULTS)))
NIL])
(\COURIER.SETUP.REPLY
[LAMBDA (STREAM TYPE) (* cdl "12-Sep-85 18:15")
[if (type? XIPSOCKETPAIR STREAM)
then (with XIPSOCKETPAIR STREAM (SETQ STREAM (\CREATE.EXPEDITED.STREAM
XIP
(QUOTE OUTPUT)
NIL
(INDEXF (fetch (EXPEDITEDXIP MSGTYPE) of T]
(PUTWORD STREAM TYPE)
(PUTWORD STREAM 0) (* Transaction ID ignored for now.)
STREAM])
(\COURIER.FINISH.REPLY
[LAMBDA (COURIERSTREAM STREAM) (* cdl " 7-Nov-85 19:22")
(if (type? XIPSOCKETPAIR COURIERSTREAM)
then (with XIPSOCKETPAIR COURIERSTREAM (replace (XIP XIPLENGTH) of XIP
with (with STREAM STREAM COFFSET))
(SWAPXIPADDRESSES XIP)
(with ETHERPACKET XIP (SETQ EPREQUEUE (QUOTE FREE)))
(SENDXIP SOCKET XIP))
else (SPP.SENDEOM COURIERSTREAM])
(\FIND.COURIER.PROGRAM
[LAMBDA (PROGRAM) (* cdl "10-Nov-85 15:52")
(DECLARE (SPECVARS PROGRAM))
(LET (VERSIONS)
(DECLARE (SPECVARS VERSIONS))
[MAPHASH \COURIERPROGRAM (FUNCTION (LAMBDA (VALUE KEY)
(with COURIERPGM VALUE (if (IEQP PROGRAM# PROGRAM)
then (push VERSIONS (CONS VERSION# KEY)))]
VERSIONS])
(\FIND.COURIER.PROCEDURE
[LAMBDA (PGMDEF PROCEDURE#) (* cdl "10-Nov-85 16:21")
(LET (PROCEDURE)
(if [SETQ PROCEDURE (OR (for PROCEDURE in (with COURIERPGM PGMDEF PROCEDURES)
thereis (IEQP (with COURIERFN (CDR PROCEDURE)
FN#)
PROCEDURE#))
(for OTHERPROGRAM in (with COURIERPGM PGMDEF INHERITS)
when [SETQ $$VAL
(with COURIERPGM (\GET.COURIERPROGRAM
OTHERPROGRAM)
(for PROCEDURE in PROCEDURES
thereis (IEQP (with COURIERFN
(CDR
PROCEDURE)
FN#)
PROCEDURE#]
do (RETURN $$VAL]
then
(CAR PROCEDURE])
)
(DEFINEQ
(\EXPEDITEDCOURIERSERVER
[LAMBDA (XIP SOCKET) (* cdl " 7-Nov-85 18:37")
(if COURIERTRACEFLG
then (printout COURIERTRACEFILE T "Expedited server connection with" ,
(with XIP XIP XIPSOURCENSADDRESS)))
(LET ((XIPSOCKETPAIR (create XIPSOCKETPAIR
XIP ← XIP
SOCKET ← SOCKET)))
(with EXPEDITEDXIP XIP (if (NOT (AND (ILEQ LOWVERSION COURIER.VERSION#)
(ILEQ COURIER.VERSION# HIGHVERSION)))
then (if COURIERTRACEFLG
then (printout COURIERTRACEFILE T
"Client requesting unknown version of Courier"
,
(with XIP XIP XIPSOURCENSADDRESS)
, LOWVERSION , HIGHVERSION))
(COURIER.REJECT XIPSOCKETPAIR)))
(\EXPEDITEDCOURIER.SERVE XIPSOCKETPAIR])
(\EXPEDITEDCOURIER.SERVE
[LAMBDA (XIPSOCKETPAIR) (* cdl "26-Nov-85 17:25")
(with EXPEDITEDXIP (with XIPSOCKETPAIR XIPSOCKETPAIR XIP)
(SELECTC MSGTYPE
[\COURIERMSG.CALL (PROG (PROGRAM PROCEDURE PGMDEF PROCDEF VERSIONS RESULTLST)
(if (SETQ VERSIONS (\FIND.COURIER.PROGRAM
PROGRAM#))
then [if (SETQ PROGRAM
(CDR (FASSOC VERSION#
VERSIONS)))
then
(if (SETQ PROCEDURE
(\FIND.COURIER.PROCEDURE
(SETQ PGMDEF
(\GET.COURIERPROGRAM
PROGRAM))
PROCEDURE#))
then
(SETQ PROCDEF
(\GET.COURIER.DEFINITION
PROGRAM PROCEDURE
(QUOTE PROCEDURES)
PGMDEF))
(with COURIERSERVERFN PROCDEF
(if SERVERFN
then
(\COURIER.APPLY
SERVERFN
XIPSOCKETPAIR
PROGRAM
PROCEDURE PGMDEF
PROCDEF)
else (
COURIER.REJECT
XIPSOCKETPAIR
\REJECT.NOSUCHPROCEDURE)))
else (COURIER.REJECT
XIPSOCKETPAIR
\REJECT.NOSUCHPROCEDURE))
else (COURIER.REJECT
XIPSOCKETPAIR
\REJECT.NOSUCHVERSION
(CONS (in VERSIONS
minimize CAR)
(in VERSIONS
maximize CAR]
else (COURIER.REJECT XIPSOCKETPAIR
\REJECT.NOSUCHPROGRAM))]
(SHOULDNT])
(\CREATE.EXPEDITED.STREAM
[LAMBDA (XIP ACCESS OSTREAM OFFSET) (* cdl " 8-Sep-85 16:20")
(* * Makes a STREAM to access the contents of XIP as an expedited courier message body. We use the BASEBYTES device
for simplicity. All the operations we actually need are BIN, BOUT, BLOCKIN and BLOCKOUT)
(PROG [END (STREAM (OR OSTREAM (NCREATE (QUOTE STREAM]
(replace DEVICE of STREAM with \BASEBYTESDEVICE)
(replace ACCESS of STREAM with ACCESS)
(replace CBUFPTR of STREAM with (fetch (XIP XIPBASE) of XIP))
[replace COFFSET of STREAM with (IPLUS \XIPOVLEN (UNFOLD 3 BYTESPERWORD)
(COND
((EQ ACCESS (QUOTE INPUT))
(* For COURIER.RESULTS)
(SETQ END (fetch XIPLENGTH of XIP))
(UNFOLD (OR OFFSET (INDEXF (fetch (EXPEDITEDXIP
MSGTYPE)
of T)))
BYTESPERWORD))
(T (* For COURIER.EXPEDITED.ARGS)
(SETQ END (IPLUS \MAX.XIPDATALENGTH \XIPOVLEN))
(UNFOLD (OR OFFSET (INDEXF (fetch (EXPEDITEDXIP
ARG0)
of T)))
BYTESPERWORD]
(replace EOFFSET of STREAM with (replace CBUFSIZE of STREAM with END))
[COND
((EQ ACCESS (QUOTE INPUT)) (* Will cause error if COURIER.RESULTS tries to read
more than was sent -- should never happen)
(replace ENDOFSTREAMOP of STREAM with (FUNCTION \COURIER.EOF)))
(T (* Invoked if COURIER.EXPEDITED.ARGS tries to write
more than will fit in the packet)
(replace (BASEBYTESTREAM WRITEXTENSIONFN) of STREAM with (FUNCTION
\COURIER.EXPEDITED.OVERFLOW]
(RETURN STREAM])
)
(DECLARE: EVAL@COMPILE
(RPAQQ \REJECT.NOSUCHPROGRAM 0)
(RPAQQ \REJECT.NOSUCHVERSION 1)
(RPAQQ \REJECT.NOSUCHPROCEDURE 2)
(RPAQQ \REJECT.INVALIDARGUMENTS 3)
(RPAQQ \REJECT.UNSPECIFIED 65535)
(RPAQQ \SINK.NULL 0)
(RPAQQ \SINK.IMMEDIATE 1)
(RPAQQ \SINK.PASSIVE 2)
(RPAQQ \SINK.ACTIVE 3)
(CONSTANTS (\REJECT.NOSUCHPROGRAM 0)
(\REJECT.NOSUCHVERSION 1)
(\REJECT.NOSUCHPROCEDURE 2)
(\REJECT.INVALIDARGUMENTS 3)
(\REJECT.UNSPECIFIED 65535)
(\SINK.NULL 0)
(\SINK.IMMEDIATE 1)
(\SINK.PASSIVE 2)
(\SINK.ACTIVE 3))
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD COURIERSERVERFN (FN# ARGS RETURNSNOISE RESULTS REPORTSNOISE ERRORS IMPLEMENTEDNOISE
SERVERFN))
(TYPERECORD XIPSOCKETPAIR (XIP . SOCKET))
]
)
(* Old)
(DEFINEQ
(\COURIERLISTENER
[LAMBDA NIL (* cdl "30-Oct-85 19:20")
(* Single connection server)
(if COURIERTRACEFLG
then (printout COURIERTRACEFILE T "Courier Server started"))
(bind STREAM PROCESS SOCKET
do (SETQ STREAM (SPP.OPEN NIL (SETQ SOCKET (OPENNSOCKET \NS.WKS.Courier
(QUOTE ACCEPT)))
T))
[SETQ PROCESS (ADD.PROCESS (BQUOTE (\COURIERSERVER , STREAM))
(QUOTE NAME)
(PACK* (QUOTE COURIER)
(SPP.DESTADDRESS STREAM]
(until (FIND.PROCESS PROCESS) do (BLOCK))
(until (NOT (FIND.PROCESS PROCESS)) do (BLOCK))
(CLOSENSOCKET SOCKET T])
)
(PUTPROPS COURIERSERVE COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1097 5780 (COURIER.START.SERVER 1107 . 1575) (COURIER.RETURN 1577 . 2330) (
COURIER.ABORT 2332 . 2912) (COURIER.REJECT 2914 . 3890) (CLOSE.BULK.DATA 3892 . 5778)) (5781 14265 (
\COURIERSERVER 5791 . 7100) (\COURIER.SERVE 7102 . 9214) (\COURIER.APPLY 9216 . 11987) (
\COURIER.SETUP.REPLY 11989 . 12493) (\COURIER.FINISH.REPLY 12495 . 13000) (\FIND.COURIER.PROGRAM 13002
. 13447) (\FIND.COURIER.PROCEDURE 13449 . 14263)) (14266 18991 (\EXPEDITEDCOURIERSERVER 14276 . 15137
) (\EXPEDITEDCOURIER.SERVE 15139 . 16910) (\CREATE.EXPEDITED.STREAM 16912 . 18989)) (19806 20655 (
\COURIERLISTENER 19816 . 20653)))))
STOP