(FILECREATED "14-AUG-83 18:07:00" {PHYLUM}<LISPCORE>SOURCES>COURIER.;5 68024
changes to: (VARS COURIERCOMS)
previous date: " 3-AUG-83 17:10:41" {PHYLUM}<LISPCORE>SOURCES>COURIER.;4)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT COURIERCOMS)
(RPAQQ COURIERCOMS ([COMS (DECLARE: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
SPP)
(ADDVARS (LITATOM.HIT.LIST CHANGE.ITEM CREATE.ALIAS CREATE.OBJECT
CREDENTIALS.TYPE DELETE.ALIAS
DELETE.MEMBER DELETE.OBJECT
DELETE.PROPERTY DELETE.SELF
DOMAIN.NAME.PATTERN
GET.PRINT.REQUEST.STATUS
GET.PRINTER.PROPERTIES
GET.PRINTER.STATUS HASHED.PASSWORD
LIST.DOMAINS.SERVED LIST.OBJECTS
LIST.ORGANIZATIONS LIST.PROPERTIES
LOOKUP.OBJECT OBJECT.NAME.PATTERN
ORGANIZATION.NAME BULK.DATA.SOURCE
PRINT.ATTRIBUTES PRINT.OPTIONS
PRINTER.PROPERTIES PROPERTY.ERROR
PROPERTY.PROBLEM REQUEST.ID
REQUEST.STATUS RETRIEVE.ADDRESSES
RETRIEVE.MEMBERS SERVICE.UNAVAILABLE
SIMPLE.CREDENTIALS SIMPLE.VERIFIER
\CH.BROADCAST.FOR.SERVERS.ON.NET
\CH.CHECK.WILDCARD
\CH.READ.BROADCAST.RESPONSE
\CH.UPDATE.CACHE
\NSPRINT.WATCHDOG.INTERNAL]
(COMS (* Authentication Protocol.)
[P (COURIERPROGRAM AUTHENTICATION (14 1)
TYPES
((CREDENTIALS.TYPE CARDINAL)
[CREDENTIALS (RECORD (TYPE CREDENTIALS.TYPE)
(VALUE (SEQUENCE UNSPECIFIED]
(SIMPLE.CREDENTIALS (CLEARINGHOUSE . NAME))
(VERIFIER (SEQUENCE UNSPECIFIED))
(SIMPLE.VERIFIER HASHED.PASSWORD)
(HASHED.PASSWORD CARDINAL)
(PROBLEM (ENUMERATION (CREDENTIALS.INVALID 0)
(VERIFIER.INVALID 1]
(* Lisp support.)
(DECLARE: DONTCOPY (CONSTANTS (\AUTHENTICATION.SIMPLE.CREDENTIALS 0)))
(FNS HASH.PASSWORD NSLOGIN))
(COMS (* Printing Protocol.)
[P (COURIERPROGRAM PRINTING (4 3)
TYPES
[(REQUEST.ID (ARRAY 5 UNSPECIFIED))
[PRINT.ATTRIBUTES (SEQUENCE (CHOICE (PRINT.OBJECT.NAME 0 STRING)
(PRINT.OBJECT.CREATE.DATE
1 TIME)
(SENDER.NAME 2 STRING]
[PRINT.OPTIONS (SEQUENCE (CHOICE (PRINT.OBJECT.SIZE 0 LONGCARDINAL)
(RECIPIENT.NAME 1 STRING)
(MESSAGE 2 STRING)
(COPY.COUNT 3 CARDINAL)
(PAGES.TO.PRINT
4
(RECORD (BEGINNING.PAGE.NUMBER
CARDINAL)
(ENDING.PAGE.NUMBER
CARDINAL)))
(MEDIUM.HINT 5 MEDIUM)
(PRIORITY.HINT
6
(ENUMERATION (HOLD 0)
(LOW 1)
(NORMAL 2)
(HIGH 3)))
(RELEASE.KEY 7 HASHED.PASSWORD)
(STAPLE 8 BOOLEAN)
(TWO.SIDED 9 BOOLEAN]
[PRINTER.PROPERTIES (SEQUENCE (CHOICE (MEDIA 0 MEDIA)
(STAPLE 1 BOOLEAN)
(TWO.SIDED 2 BOOLEAN]
[PRINTER.STATUS (SEQUENCE (CHOICE (SPOOLER 0 (ENUMERATION
(AVAILABLE 0)
(BUSY 1)
(DISABLED 2)
(FULL 3)))
(FORMATTER 1 (ENUMERATION
(AVAILABLE 0)
(BUSY 1)
(DISABLED 2)))
(PRINTER 2 (ENUMERATION
(AVAILABLE 0)
(BUSY 1)
(DISABLED 2)
(NEEDS.ATTENTION
3)
(NEED.KEY.OPERATOR
4)))
(MEDIA 3 MEDIA]
(MEDIA (SEQUENCE MEDIUM))
(MEDIUM (CHOICE (PAPER 0 PAPER)))
[PAPER (CHOICE (UNKNOWN 0 NIL)
(KNOWN.SIZE 1 (ENUMERATION (US.LETTER 1)
(US.LEGAL 2)
(A0 3)
(A1 4)
(A2 5)
(A3 6)
(A4 7)
(A5 8)
(A6 9)
(A7 10)
(A8 11)
(A9 12)
(A10 35)
(ISO.B0 13)
(ISO.B1 14)
(ISO.B2 15)
(ISO.B3 16)
(ISO.B4 17)
(ISO.B5 18)
(ISO.B6 19)
(ISO.B7 20)
(ISO.B8 21)
(ISO.B9 22)
(ISO.B10 23)
(JIS.B0 24)
(JIS.B1 25)
(JIS.B2 26)
(JIS.B3 27)
(JIS.B4 28)
(JIS.B5 29)
(JIS.B6 30)
(JIS.B7 31)
(JIS.B8 32)
(JIS.B9 33)
(JIS.B10 34)))
(OTHER.SIZE 2 (RECORD (WIDTH CARDINAL)
(LENGTH CARDINAL]
[REQUEST.STATUS (SEQUENCE (CHOICE (STATUS 0 (ENUMERATION
(PENDING 0)
(IN.PROGRESS 1)
(COMPLETED 2)
(UNKNOWN 3)
(REJECTED 4)
(ABORTED 5)
(CANCELLED 6)
(HELD 7)))
(STATUS.MESSAGE 1 STRING]
(CONNECTION.PROBLEM (ENUMERATION (NO.ROUTE 0)
(NO.RESPONSE 1)
(TRANSMISSION.HARDWARE 2)
(TRANSPORT.TIMEOUT 3)
(TOO.MANY.LOCAL.CONNECTIONS 4)
(TOO.MANY.REMOTE.CONNECTIONS
5)
(MISSING.COURIER 6)
(MISSING.PROGRAM 6)
(MISSING.PROCEDURE 7)
(PROTOCOL.MISMATCH 9)
(PARAMETER.INCONSISTENCY 10)
(INVALID.MESSAGE 11)
(RETURN.TIMED.OUT 12)
(OTHER.CALL.PROBLEM -1)))
(TRANSFER.PROBLEM (ENUMERATION (ABORTED 0)
(FORMAT.INCORRECT 2)
(NO.RENDEZVOUS 3)
(WRONG.DIRECTION 4]
PROCEDURES
((PRINT ARGS (BULK.DATA.SOURCE PRINT.ATTRIBUTES PRINT.OPTIONS)
RESULTS
(REQUEST.ID)
ERRORS
(BUSY CONNECTION.ERROR INSUFFICIENT.SPOOL.SPACE
INVALID.PRINT.PARAMETERS MASTER.TOO.LARGE
MEDIUM.UNAVAILABLE SERVICE.UNAVAILABLE
SPOOLING.DISABLED SPOOLING.QUEUE.FULL SYSTEM.ERROR
TOO.MANY.CLIENTS TRANSFER.ERROR UNDEFINED.ERROR)
0)
(GET.PRINTER.PROPERTIES RESULTS (PRINTER.PROPERTIES)
ERRORS
(SERVICE.UNAVAILABLE SYSTEM.ERROR
UNDEFINED.ERROR)
1)
(GET.PRINT.REQUEST.STATUS ARGS (REQUEST.ID)
RESULTS
(REQUEST.STATUS)
ERRORS
(SERVICE.UNAVAILABLE SYSTEM.ERROR
UNDEFINED.ERROR)
2)
(GET.PRINTER.STATUS RESULTS (PRINTER.STATUS)
ERRORS
(SERVICE.UNAVAILABLE SYSTEM.ERROR
UNDEFINED.ERROR)
3))
ERRORS
((BUSY 0)
(CONNECTION.ERROR ERROR ARGS (CONNECTION.PROBLEM)
11)
(INSUFFICIENT.SPOOL.SPACE 1)
(INVALID.PRINT.PARAMETERS 2)
(MASTER.TOO.LARGE 3)
(MEDIUM.UNAVAILABLE 4)
(SERVICE.UNAVAILABLE 5)
(SPOOLING.DISABLED 6)
(SPOOLING.QUEUE.FULL 7)
(SYSTEM.ERROR 8)
(TOO.MANY.CLIENTS 9)
(TRANSFER.ERROR ARGS (TRANSFER.PROBLEM)
12)
(UNDEFINED.ERROR ARGS (CARDINAL)
10]
(* Lisp support.)
(DECLARE: DONTCOPY (GLOBALVARS NS.DEFAULT.PRINTER)
(RECORDS NSPRINTINGSTREAM))
(INITVARS (NS.DEFAULT.PRINTER NIL))
(FNS GETNSPRINTER NSPRINT IP.SENDTOPRINTER NSPRINT.WATCHDOG \NSPRINT.WATCHDOG.INTERNAL
OPEN.NS.PRINTING.STREAM NSPRINTER.STATUS NSPRINTER.PROPERTIES
NSPRINTREQUEST.STATUS))
(COMS (* Clearinghouse Protocol.)
[P (COURIERPROGRAM CLEARINGHOUSE (2 2)
TYPES
[(ORGANIZATION STRING)
(DOMAIN STRING)
(OBJECT STRING)
(ORGANIZATION.NAME ORGANIZATION)
(TWO.PART.NAME (RECORD (ORGANIZATION ORGANIZATION)
(DOMAIN DOMAIN)))
(DOMAIN.NAME TWO.PART.NAME)
(THREE.PART.NAME (RECORD (ORGANIZATION ORGANIZATION)
(DOMAIN DOMAIN)
(OBJECT OBJECT)))
(OBJECT.NAME THREE.PART.NAME)
(NAME THREE.PART.NAME)
(ORGANIZATION.NAME.PATTERN ORGANIZATION)
(DOMAIN.NAME.PATTERN TWO.PART.NAME)
(OBJECT.NAME.PATTERN THREE.PART.NAME)
(PROPERTY LONGCARDINAL)
(PROPERTIES (SEQUENCE PROPERTY))
(ITEM (SEQUENCE UNSPECIFIED))
(NETWORK.ADDRESS (RECORD (NETWORK (ARRAY 2 UNSPECIFIED))
(HOST (ARRAY 3 UNSPECIFIED))
(SOCKET UNSPECIFIED)))
(NETWORK.ADDRESS.LIST (SEQUENCE NETWORK.ADDRESS))
[AUTHENTICATOR (RECORD (CREDENTIALS (AUTHENTICATION . CREDENTIALS))
(VERIFIER (AUTHENTICATION . VERIFIER]
(WHICH.ARGUMENT (ENUMERATION (FIRST 1)
(SECOND 2)))
(ARGUMENT.PROBLEM (ENUMERATION (ILLEGAL.PROPERTY 10)
(ILLEGAL.ORGANIZATION.NAME 11)
(ILLEGAL.DOMAIN.NAME 12)
(ILLEGAL.OBJECT.NAME 13)
(NO.SUCH.ORGANIZATION 14)
(NO.SUCH.DOMAIN 15)
(NO.SUCH.OBJECT 16)))
(CALL.PROBLEM (ENUMERATION (ACCESS.RIGHTS.INSUFFICIENT 1)
(TOO.BUSY 2)
(SERVER.DOWN 3)
(USE.COURIER 4)
(OTHER 5)))
(PROPERTY.PROBLEM (ENUMERATION (MISSING 20)
(WRONG.TYPE 21)))
(UPDATE.PROBLEM (ENUMERATION (NO.CHANGE 30)
(OUT.OF.DATE 31)
(OBJECT.OVERFLOW 32)
(DATABASE.OVERFLOW 33]
PROCEDURES
((CREATE.OBJECT ARGS (OBJECT.NAME AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
UPDATE.ERROR WRONG.SERVER)
2)
(DELETE.OBJECT ARGS (OBJECT.NAME AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
UPDATE.ERROR WRONG.SERVER)
3)
(LOOKUP.OBJECT ARGS (OBJECT.NAME.PATTERN AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR CALL.ERROR WRONG.SERVER)
4)
(LIST.ORGANIZATIONS ARGS (ORGANIZATION.NAME.PATTERN BULK.DATA.SINK
AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
WRONG.SERVER)
5)
(LIST.DOMAINS ARGS (DOMAIN.NAME.PATTERN BULK.DATA.SINK
AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
WRONG.SERVER)
6)
(LIST.OBJECTS ARGS (OBJECT.NAME.PATTERN PROPERTY BULK.DATA.SINK
AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
WRONG.SERVER)
7)
(LIST.ALIASES.OF ARGS (OBJECT.NAME.PATTERN BULK.DATA.SINK
AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
WRONG.SERVER)
9)
(CREATE.ALIAS ARGS (OBJECT.NAME OBJECT.NAME AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
UPDATE.ERROR WRONG.SERVER)
10)
(DELETE.ALIAS ARGS (OBJECT.NAME AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
UPDATE.ERROR WRONG.SERVER)
11)
(LIST.ALIASES ARGS (OBJECT.NAME.PATTERN BULK.DATA.SINK
AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
WRONG.SERVER)
8)
(DELETE.PROPERTY ARGS (OBJECT.NAME PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
14)
(LIST.PROPERTIES ARGS (OBJECT.NAME.PATTERN AUTHENTICATOR)
RESULTS
(OBJECT.NAME PROPERTIES)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
WRONG.SERVER)
15)
(ADD.ITEM.PROPERTY ARGS (OBJECT.NAME PROPERTY ITEM AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
13)
(RETRIEVE.ITEM ARGS (OBJECT.NAME.PATTERN PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME ITEM)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR WRONG.SERVER)
16)
(CHANGE.ITEM ARGS (OBJECT.NAME PROPERTY ITEM AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
17)
(ADD.GROUP.PROPERTY ARGS (OBJECT.NAME PROPERTY BULK.DATA.SOURCE
AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
12)
(RETRIEVE.MEMBERS ARGS (OBJECT.NAME.PATTERN PROPERTY BULK.DATA.SINK
AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR WRONG.SERVER)
18)
(ADD.MEMBER ARGS (OBJECT.NAME PROPERTY THREE.PART.NAME
AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
19)
(ADD.SELF ARGS (OBJECT.NAME PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR WRONG.SERVER)
20)
(DELETE.MEMBER ARGS (OBJECT.NAME PROPERTY THREE.PART.NAME
AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
21)
(DELETE.SELF ARGS (OBJECT.NAME PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR UPDATE.ERROR
WRONG.SERVER)
22)
(IS.MEMBER ARGS (OBJECT.NAME.PATTERN PROPERTY PROPERTY
THREE.PART.NAME AUTHENTICATOR)
RESULTS
(BOOLEAN OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR
PROPERTY.ERROR WRONG.SERVER)
23)
(RETRIEVE.ADDRESSES RESULTS (NETWORK.ADDRESS.LIST)
ERRORS
(CALL.ERROR)
0)
(LIST.DOMAINS.SERVED ARGS (BULK.DATA.SINK AUTHENTICATOR)
ERRORS
(CALL.ERROR)
1))
ERRORS
((ARGUMENT.ERROR ARGS (ARGUMENT.PROBLEM WHICH.ARGUMENT)
2)
(AUTHENTICATION.ERROR ARGS (AUTHENTICATION.PROBLEM)
6)
(CALL.ERROR ARGS (CALL.PROBLEM)
1)
(PROPERTY.ERROR ARGS (PROPERTY.PROBLEM OBJECT.NAME)
3)
(UPDATE.ERROR ARGS (UPDATE.PROBLEM BOOLEAN WHICH.ARGUMENT
OBJECT.NAME)
4)
(WRONG.SERVER ARGS (OBJECT.NAME)
5]
(* Lisp support.)
(DECLARE: DONTCOPY (CONSTANTS [\CH.NULL.AUTHENTICATOR (QUOTE ((CREDENTIALS
((TYPE 0)
(VALUE NIL)))
(VERIFIER (0]
[CH.PROPERTYIDS (QUOTE ((ALL 0)
(CLEARINGHOUSE.NAMES 3)
(CLEARINGHOUSE.ADDRESSES 4)
(FILESERVER 10)
(PRINTSERVER 11)
(USER 14]
(\CH.BROADCAST.TYPE 2)
(\CH.BROADCAST.SOCKET 20)
(\BROADCAST.FOR.SERVERS.LENGTH 22))
(RECORDS \BROADCAST.FOR.SERVERS.PACKET)
(GLOBALVARS LOCAL.CLEARINGHOUSE \CH.CACHE CH.DEFAULT.DOMAIN
CH.DEFAULT.ORGANIZATION))
(INITVARS (CH.DEFAULT.DOMAIN NIL)
(CH.DEFAULT.ORGANIZATION NIL)
(LOCAL.CLEARINGHOUSE NIL)
(\CH.CACHE NIL)
(CLEARINGHOUSE.STRUCTURE.WINDOW NIL)
(NS.SERVER.NAMES.TO.ADDRESSES NIL))
(FNS GETCLEARINGHOUSE START.CLEARINGHOUSE SHOW.CLEARINGHOUSE SHOW.ENTIRE.CLEARINGHOUSE
CH.FINDSERVER \CH.UPDATE.CACHE EQUAL.CH.NAMES MATCHING.CH.NAMES
STREQUAL.EXCEPT.FOR.CASE CH.DOMAINS.SERVED CH.DOMAINS CH.ORGANIZATIONS CH.SERVERS
CH.BROADCAST.FOR.SERVERS \CH.BROADCAST.FOR.SERVERS.ON.NET
\CH.READ.BROADCAST.RESPONSE PARSE.CH.NAME CH.NAME.TO.STRING CANONICAL.CH.NAME
\CH.CHECK.WILDCARD CH.PROPERTY CH.NSADDRESS CH.GETAUTHENTICATOR CH.ENUMERATE
CH.LOOKUP LOOKUP.NS.SERVER CH.LOOKUP.USER))))
(DECLARE: DONTCOPY EVAL@COMPILE
(FILESLOAD (LOADCOMP)
SPP)
(ADDTOVAR LITATOM.HIT.LIST CHANGE.ITEM CREATE.ALIAS CREATE.OBJECT CREDENTIALS.TYPE DELETE.ALIAS
DELETE.MEMBER DELETE.OBJECT DELETE.PROPERTY DELETE.SELF
DOMAIN.NAME.PATTERN GET.PRINT.REQUEST.STATUS
GET.PRINTER.PROPERTIES GET.PRINTER.STATUS HASHED.PASSWORD
LIST.DOMAINS.SERVED LIST.OBJECTS LIST.ORGANIZATIONS
LIST.PROPERTIES LOOKUP.OBJECT OBJECT.NAME.PATTERN
ORGANIZATION.NAME BULK.DATA.SOURCE PRINT.ATTRIBUTES
PRINT.OPTIONS PRINTER.PROPERTIES PROPERTY.ERROR
PROPERTY.PROBLEM REQUEST.ID REQUEST.STATUS RETRIEVE.ADDRESSES
RETRIEVE.MEMBERS SERVICE.UNAVAILABLE SIMPLE.CREDENTIALS
SIMPLE.VERIFIER \CH.BROADCAST.FOR.SERVERS.ON.NET
\CH.CHECK.WILDCARD \CH.READ.BROADCAST.RESPONSE
\CH.UPDATE.CACHE \NSPRINT.WATCHDOG.INTERNAL)
)
(* Authentication Protocol.)
[COURIERPROGRAM AUTHENTICATION (14 1)
TYPES
((CREDENTIALS.TYPE CARDINAL)
[CREDENTIALS (RECORD (TYPE CREDENTIALS.TYPE)
(VALUE (SEQUENCE UNSPECIFIED]
(SIMPLE.CREDENTIALS (CLEARINGHOUSE . NAME))
(VERIFIER (SEQUENCE UNSPECIFIED))
(SIMPLE.VERIFIER HASHED.PASSWORD)
(HASHED.PASSWORD CARDINAL)
(PROBLEM (ENUMERATION (CREDENTIALS.INVALID 0)
(VERIFIER.INVALID 1]
(* Lisp support.)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \AUTHENTICATION.SIMPLE.CREDENTIALS 0)
(CONSTANTS (\AUTHENTICATION.SIMPLE.CREDENTIALS 0))
)
)
(DEFINEQ
(HASH.PASSWORD
[LAMBDA (PASSWORD) (* ecc "30-JUN-83 11:32")
(* Compute remainder mod 65357 of PASSWORD considered as an arbitrary length integer whose 16 bit words, from most
to least significant, are the characters in PASSWORD. Uses Horner's rule and properties of modular arithmetic to
do it efficiently.)
(bind (HASH ← 0) for CHAR instring (MKSTRING PASSWORD)
do (SETQ HASH (IMOD (IPLUS (ITIMES HASH (CONSTANT (IMOD (EXPT 2 16)
65357)))
(L-CASECODE CHAR))
65357))
finally (RETURN HASH])
(NSLOGIN
[LAMBDA (HOST MSG) (* ecc "22-JUN-83 13:24")
(PROG (INFO NAME/PASSWORD)
(SETQ HOST (MKATOM HOST))
(SETQ INFO (GETHASH HOST LOGINPASSWORDS))
(if (OR MSG (NULL INFO))
then (SETQ NAME/PASSWORD (\INTERNAL/GETPASSWORD HOST T NIL MSG))
else (SETQ NAME/PASSWORD (CAR INFO)))
(RETURN NAME/PASSWORD])
)
(* Printing Protocol.)
(COURIERPROGRAM PRINTING (4 3)
TYPES
[(REQUEST.ID (ARRAY 5 UNSPECIFIED))
[PRINT.ATTRIBUTES (SEQUENCE (CHOICE (PRINT.OBJECT.NAME 0 STRING)
(PRINT.OBJECT.CREATE.DATE 1 TIME)
(SENDER.NAME 2 STRING]
[PRINT.OPTIONS (SEQUENCE (CHOICE (PRINT.OBJECT.SIZE 0 LONGCARDINAL)
(RECIPIENT.NAME 1 STRING)
(MESSAGE 2 STRING)
(COPY.COUNT 3 CARDINAL)
(PAGES.TO.PRINT 4 (RECORD (BEGINNING.PAGE.NUMBER
CARDINAL)
(ENDING.PAGE.NUMBER
CARDINAL)))
(MEDIUM.HINT 5 MEDIUM)
(PRIORITY.HINT 6 (ENUMERATION (HOLD 0)
(LOW 1)
(NORMAL 2)
(HIGH 3)))
(RELEASE.KEY 7 HASHED.PASSWORD)
(STAPLE 8 BOOLEAN)
(TWO.SIDED 9 BOOLEAN]
[PRINTER.PROPERTIES (SEQUENCE (CHOICE (MEDIA 0 MEDIA)
(STAPLE 1 BOOLEAN)
(TWO.SIDED 2 BOOLEAN]
[PRINTER.STATUS (SEQUENCE (CHOICE (SPOOLER 0 (ENUMERATION (AVAILABLE 0)
(BUSY 1)
(DISABLED 2)
(FULL 3)))
(FORMATTER 1 (ENUMERATION (AVAILABLE 0)
(BUSY 1)
(DISABLED 2)))
(PRINTER 2 (ENUMERATION (AVAILABLE 0)
(BUSY 1)
(DISABLED 2)
(NEEDS.ATTENTION 3)
(NEED.KEY.OPERATOR 4)))
(MEDIA 3 MEDIA]
(MEDIA (SEQUENCE MEDIUM))
(MEDIUM (CHOICE (PAPER 0 PAPER)))
[PAPER (CHOICE (UNKNOWN 0 NIL)
(KNOWN.SIZE 1 (ENUMERATION (US.LETTER 1)
(US.LEGAL 2)
(A0 3)
(A1 4)
(A2 5)
(A3 6)
(A4 7)
(A5 8)
(A6 9)
(A7 10)
(A8 11)
(A9 12)
(A10 35)
(ISO.B0 13)
(ISO.B1 14)
(ISO.B2 15)
(ISO.B3 16)
(ISO.B4 17)
(ISO.B5 18)
(ISO.B6 19)
(ISO.B7 20)
(ISO.B8 21)
(ISO.B9 22)
(ISO.B10 23)
(JIS.B0 24)
(JIS.B1 25)
(JIS.B2 26)
(JIS.B3 27)
(JIS.B4 28)
(JIS.B5 29)
(JIS.B6 30)
(JIS.B7 31)
(JIS.B8 32)
(JIS.B9 33)
(JIS.B10 34)))
(OTHER.SIZE 2 (RECORD (WIDTH CARDINAL)
(LENGTH CARDINAL]
[REQUEST.STATUS (SEQUENCE (CHOICE (STATUS 0 (ENUMERATION (PENDING 0)
(IN.PROGRESS 1)
(COMPLETED 2)
(UNKNOWN 3)
(REJECTED 4)
(ABORTED 5)
(CANCELLED 6)
(HELD 7)))
(STATUS.MESSAGE 1 STRING]
(CONNECTION.PROBLEM (ENUMERATION (NO.ROUTE 0)
(NO.RESPONSE 1)
(TRANSMISSION.HARDWARE 2)
(TRANSPORT.TIMEOUT 3)
(TOO.MANY.LOCAL.CONNECTIONS 4)
(TOO.MANY.REMOTE.CONNECTIONS 5)
(MISSING.COURIER 6)
(MISSING.PROGRAM 6)
(MISSING.PROCEDURE 7)
(PROTOCOL.MISMATCH 9)
(PARAMETER.INCONSISTENCY 10)
(INVALID.MESSAGE 11)
(RETURN.TIMED.OUT 12)
(OTHER.CALL.PROBLEM -1)))
(TRANSFER.PROBLEM (ENUMERATION (ABORTED 0)
(FORMAT.INCORRECT 2)
(NO.RENDEZVOUS 3)
(WRONG.DIRECTION 4]
PROCEDURES
((PRINT ARGS (BULK.DATA.SOURCE PRINT.ATTRIBUTES PRINT.OPTIONS)
RESULTS
(REQUEST.ID)
ERRORS
(BUSY CONNECTION.ERROR INSUFFICIENT.SPOOL.SPACE INVALID.PRINT.PARAMETERS
MASTER.TOO.LARGE MEDIUM.UNAVAILABLE SERVICE.UNAVAILABLE
SPOOLING.DISABLED SPOOLING.QUEUE.FULL SYSTEM.ERROR TOO.MANY.CLIENTS
TRANSFER.ERROR UNDEFINED.ERROR)
0)
(GET.PRINTER.PROPERTIES RESULTS (PRINTER.PROPERTIES)
ERRORS
(SERVICE.UNAVAILABLE SYSTEM.ERROR UNDEFINED.ERROR)
1)
(GET.PRINT.REQUEST.STATUS ARGS (REQUEST.ID)
RESULTS
(REQUEST.STATUS)
ERRORS
(SERVICE.UNAVAILABLE SYSTEM.ERROR UNDEFINED.ERROR)
2)
(GET.PRINTER.STATUS RESULTS (PRINTER.STATUS)
ERRORS
(SERVICE.UNAVAILABLE SYSTEM.ERROR UNDEFINED.ERROR)
3))
ERRORS
((BUSY 0)
(CONNECTION.ERROR ERROR ARGS (CONNECTION.PROBLEM)
11)
(INSUFFICIENT.SPOOL.SPACE 1)
(INVALID.PRINT.PARAMETERS 2)
(MASTER.TOO.LARGE 3)
(MEDIUM.UNAVAILABLE 4)
(SERVICE.UNAVAILABLE 5)
(SPOOLING.DISABLED 6)
(SPOOLING.QUEUE.FULL 7)
(SYSTEM.ERROR 8)
(TOO.MANY.CLIENTS 9)
(TRANSFER.ERROR ARGS (TRANSFER.PROBLEM)
12)
(UNDEFINED.ERROR ARGS (CARDINAL)
10)))
(* Lisp support.)
(DECLARE: DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS NS.DEFAULT.PRINTER)
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS NSPRINTINGSTREAM ((NSPRINTING.ATTRIBUTES (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))))
]
)
(RPAQ? NS.DEFAULT.PRINTER NIL)
(DEFINEQ
(GETNSPRINTER
[LAMBDA (HOSTNAME) (* ecc "28-JUN-83 10:29")
(COND
(HOSTNAME)
(NS.DEFAULT.PRINTER)
([SETQ NS.DEFAULT.PRINTER (CAR (CH.ENUMERATE "*" (QUOTE PRINTSERVER]
(printout PROMPTWINDOW .TAB0 0 "[Default NS printer set to " NS.DEFAULT.PRINTER "]")
NS.DEFAULT.PRINTER)
(T (ERROR "Can't find an NS printserver" NIL T])
(NSPRINT
[LAMBDA (PRINTER FILE.NAME DOCUMENT.NAME DOCUMENT.CREATION.DATE SENDER.NAME RECIPIENT.NAME #COPIES
MEDIUM PRIORITY STAPLE? TWO.SIDED?) (* ecc "15-JUN-83 11:09")
(PROG (FULLFILENAME COURIERSTREAM PRINTINGSTREAM)
(if (NULL (SETQ FULLFILENAME (INFILEP FILE.NAME)))
then (LISPERROR "FILE NOT FOUND" FILE.NAME))
(if (NULL DOCUMENT.NAME)
then (SETQ DOCUMENT.NAME FULLFILENAME))
[if (NULL DOCUMENT.CREATION.DATE)
then (SETQ DOCUMENT.CREATION.DATE (GETFILEINFO FULLFILENAME (QUOTE ICREATIONDATE]
(RETURN (COND
((SETQ PRINTINGSTREAM (OPEN.NS.PRINTING.STREAM PRINTER DOCUMENT.NAME
DOCUMENT.CREATION.DATE SENDER.NAME
RECIPIENT.NAME #COPIES MEDIUM
PRIORITY STAPLE? TWO.SIDED?))
(RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEF?)
PRINTINGSTREAM))
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
FULLFILENAME))
(COPYBYTES (OPENSTREAM FULLFILENAME (QUOTE INPUT))
PRINTINGSTREAM))
FULLFILENAME])
(IP.SENDTOPRINTER
[LAMBDA (HOST FILE #COPIES #SIDES DOCUMENT.NAME DOCUMENT.CREATION.DATE SENDER.NAME RECIPIENT.NAME
MEDIUM PRIORITY STAPLE?) (* lmm "12-JUN-83 01:55")
(NSPRINT HOST FILE DOCUMENT.NAME DOCUMENT.CREATION.DATE SENDER.NAME RECIPIENT.NAME #COPIES MEDIUM
PRIORITY STAPLE?])
(NSPRINT.WATCHDOG
[LAMBDA (SUBSTREAM ID) (* ecc "21-JUN-83 16:22")
(PROG [[PRINTER (CADR (ASSOC (QUOTE PRINTSERVER)
(fetch NSPRINTING.ATTRIBUTES of SUBSTREAM]
[JOBNAME (CADR (ASSOC (QUOTE DOCUMENT)
(fetch NSPRINTING.ATTRIBUTES of SUBSTREAM]
(STREAM (fetch SPPSTREAM of (GETSPPCON SUBSTREAM]
(ADD.PROCESS (LIST (QUOTE \NSPRINT.WATCHDOG.INTERNAL)
(KWOTE STREAM)
(KWOTE PRINTER)
(KWOTE JOBNAME)
(KWOTE ID))
(PACK* (OR (ROOTFILENAME JOBNAME)
JOBNAME)
(QUOTE #WATCHDOG])
(\NSPRINT.WATCHDOG.INTERNAL
[LAMBDA (STREAM PRINTER JOBNAME ID) (* ecc "28-JUN-83 10:30")
(PROG (RESULT STATUS MSG)
(RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(do (SETQ RESULT (COURIER.CALL STREAM (QUOTE PRINTING)
(QUOTE GET.PRINT.REQUEST.STATUS)
ID))
(SETQ STATUS (CADR (ASSOC (QUOTE STATUS)
RESULT)))
(SETQ MSG (CADR (ASSOC (QUOTE STATUS.MESSAGE)
RESULT)))
(printout PROMPTWINDOW .TAB0 0)
(if JOBNAME
then (printout PROMPTWINDOW JOBNAME " on "))
(printout PROMPTWINDOW PRINTER ": " STATUS)
(if (AND MSG (NOT (STREQUAL MSG "")))
then (printout PROMPTWINDOW " (" MSG ")"))
(if (MEMBER STATUS (QUOTE (PENDING IN.PROGRESS)))
then (BLOCK 30000)
else (RETURN])
(OPEN.NS.PRINTING.STREAM
[LAMBDA (PRINTER DOCUMENT.NAME DOCUMENT.CREATION.DATE SENDER.NAME RECIPIENT.NAME #COPIES MEDIUM
PRIORITY STAPLE? TWO.SIDED? NOWATCHDOG?)
(* ecc " 3-AUG-83 16:59")
(* Return a stream for Interpress printing.)
(PROG (COURIERSTREAM PROPERTIES STATUS ATTRIBUTES OPTIONS)
(if (NULL DOCUMENT.CREATION.DATE)
then (SETQ DOCUMENT.CREATION.DATE (IDATE)))
(if (NULL SENDER.NAME)
then (SETQ SENDER.NAME (USERNAME NIL NIL T)))
(if (NULL RECIPIENT.NAME)
then (SETQ RECIPIENT.NAME SENDER.NAME))
(if (NULL #COPIES)
then (SETQ #COPIES 1))
(if (NULL PRIORITY)
then (SETQ PRIORITY (QUOTE NORMAL)))
(SETQ PRINTER (GETNSPRINTER PRINTER))
(SETQ COURIERSTREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER)
T
(PACK* (CH.NAME.TO.STRING PRINTER)
"#PRINTING")))
(RETURN (if COURIERSTREAM
then (RESETLST (if NOWATCHDOG?
then (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X
RESETSTATE])
COURIERSTREAM))
else (* If there's going to be a watchdog, it will take care
of closing the connection, so only close it in the
abnormal case.)
(RESETSAVE NIL (LIST [QUOTE (LAMBDA (X)
(if RESETSTATE
then
(SPP.CLOSE
X T]
COURIERSTREAM)))
(if (OR MEDIUM STAPLE? TWO.SIDED?)
then (* Check that the printer supports these options.)
(SETQ PROPERTIES (COURIER.CALL COURIERSTREAM
(QUOTE PRINTING)
(QUOTE
GET.PRINTER.PROPERTIES)))
(if [AND MEDIUM
(NOT (MEMBER MEDIUM
(CADR (ASSOC (QUOTE MEDIA)
PROPERTIES]
then (ERROR "Printer does not support medium"
PROPERTIES T))
(if [AND STAPLE? (NOT (CADR (ASSOC (QUOTE STAPLE)
PROPERTIES]
then (ERROR
"Printer does not support stapled copies"
PROPERTIES T))
(if [AND TWO.SIDED? (NOT (CADR (ASSOC (QUOTE TWO.SIDED)
PROPERTIES]
then (ERROR
"Printer does not support two-sided copies"
PROPERTIES T)))
(* Check the status of the printer.)
(do [SETQ STATUS (CADR (ASSOC (QUOTE SPOOLER)
(COURIER.CALL COURIERSTREAM
(QUOTE PRINTING)
(QUOTE
GET.PRINTER.STATUS]
(if (EQ STATUS (QUOTE AVAILABLE))
then (RETURN))
(if (NEQ STATUS (QUOTE BUSY))
then (ERROR "Printer spooler" STATUS T))
(printout PROMPTWINDOW .TAB0 0 "[Spooler busy; will retry]")
(BLOCK 5000))
(SETQ ATTRIBUTES (LIST (LIST (QUOTE PRINT.OBJECT.NAME)
DOCUMENT.NAME)
(LIST (QUOTE PRINT.OBJECT.CREATE.DATE)
DOCUMENT.CREATION.DATE)
(LIST (QUOTE SENDER.NAME)
SENDER.NAME)))
(SETQ OPTIONS (LIST (LIST (QUOTE RECIPIENT.NAME)
RECIPIENT.NAME)
(LIST (QUOTE COPY.COUNT)
#COPIES)
(LIST (QUOTE PRIORITY.HINT)
PRIORITY)
(LIST (QUOTE STAPLE)
STAPLE?)
(LIST (QUOTE TWO.SIDED)
TWO.SIDED?)))
(if MEDIUM
then (* We've already checked that the printer supports this
medium.)
(SETQ OPTIONS (CONS (LIST (QUOTE MEDIUM.HINT)
MEDIUM)
OPTIONS)))
(SETQ PRINTINGSTREAM (COURIER.CALL
COURIERSTREAM
(QUOTE PRINTING)
(QUOTE PRINT)
(if NOWATCHDOG?
then NIL
else (FUNCTION NSPRINT.WATCHDOG))
ATTRIBUTES OPTIONS))
(replace NSPRINTING.ATTRIBUTES of PRINTINGSTREAM
with (LIST (LIST (QUOTE PRINTSERVER)
PRINTER)
(LIST (QUOTE DOCUMENT)
DOCUMENT.NAME)))
PRINTINGSTREAM])
(NSPRINTER.STATUS
[LAMBDA (PRINTER) (* ecc "15-JUN-83 14:55")
(PROG (STREAM)
(SETQ PRINTER (GETNSPRINTER PRINTER))
(SETQ STREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER)
NIL
(PACK* (CH.NAME.TO.STRING PRINTER)
"#PRINTING")))
(RETURN (if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(COURIER.CALL STREAM (QUOTE PRINTING)
(QUOTE GET.PRINTER.STATUS])
(NSPRINTER.PROPERTIES
[LAMBDA (PRINTER) (* ecc "15-JUN-83 14:55")
(PROG (STREAM)
(SETQ PRINTER (GETNSPRINTER PRINTER))
(SETQ STREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER)
NIL
(PACK* (CH.NAME.TO.STRING PRINTER)
"#PRINTING")))
(RETURN (if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(COURIER.CALL STREAM (QUOTE PRINTING)
(QUOTE GET.PRINTER.PROPERTIES])
(NSPRINTREQUEST.STATUS
[LAMBDA (REQUESTID PRINTERHOST) (* ecc "15-JUN-83 14:55")
(PROG (STREAM)
(SETQ PRINTER (GETNSPRINTER PRINTER))
(SETQ STREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER)
NIL
(PACK* (CH.NAME.TO.STRING PRINTER)
"#PRINTING")))
(RETURN (if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(COURIER.CALL STREAM (QUOTE PRINTING)
(QUOTE GET.PRINT.REQUEST.STATUS)
REQUESTID])
)
(* Clearinghouse Protocol.)
(COURIERPROGRAM CLEARINGHOUSE (2 2)
TYPES
[(ORGANIZATION STRING)
(DOMAIN STRING)
(OBJECT STRING)
(ORGANIZATION.NAME ORGANIZATION)
(TWO.PART.NAME (RECORD (ORGANIZATION ORGANIZATION)
(DOMAIN DOMAIN)))
(DOMAIN.NAME TWO.PART.NAME)
(THREE.PART.NAME (RECORD (ORGANIZATION ORGANIZATION)
(DOMAIN DOMAIN)
(OBJECT OBJECT)))
(OBJECT.NAME THREE.PART.NAME)
(NAME THREE.PART.NAME)
(ORGANIZATION.NAME.PATTERN ORGANIZATION)
(DOMAIN.NAME.PATTERN TWO.PART.NAME)
(OBJECT.NAME.PATTERN THREE.PART.NAME)
(PROPERTY LONGCARDINAL)
(PROPERTIES (SEQUENCE PROPERTY))
(ITEM (SEQUENCE UNSPECIFIED))
(NETWORK.ADDRESS (RECORD (NETWORK (ARRAY 2 UNSPECIFIED))
(HOST (ARRAY 3 UNSPECIFIED))
(SOCKET UNSPECIFIED)))
(NETWORK.ADDRESS.LIST (SEQUENCE NETWORK.ADDRESS))
[AUTHENTICATOR (RECORD (CREDENTIALS (AUTHENTICATION . CREDENTIALS))
(VERIFIER (AUTHENTICATION . VERIFIER]
(WHICH.ARGUMENT (ENUMERATION (FIRST 1)
(SECOND 2)))
(ARGUMENT.PROBLEM (ENUMERATION (ILLEGAL.PROPERTY 10)
(ILLEGAL.ORGANIZATION.NAME 11)
(ILLEGAL.DOMAIN.NAME 12)
(ILLEGAL.OBJECT.NAME 13)
(NO.SUCH.ORGANIZATION 14)
(NO.SUCH.DOMAIN 15)
(NO.SUCH.OBJECT 16)))
(CALL.PROBLEM (ENUMERATION (ACCESS.RIGHTS.INSUFFICIENT 1)
(TOO.BUSY 2)
(SERVER.DOWN 3)
(USE.COURIER 4)
(OTHER 5)))
(PROPERTY.PROBLEM (ENUMERATION (MISSING 20)
(WRONG.TYPE 21)))
(UPDATE.PROBLEM (ENUMERATION (NO.CHANGE 30)
(OUT.OF.DATE 31)
(OBJECT.OVERFLOW 32)
(DATABASE.OVERFLOW 33]
PROCEDURES
((CREATE.OBJECT ARGS (OBJECT.NAME AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR
WRONG.SERVER)
2)
(DELETE.OBJECT ARGS (OBJECT.NAME AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR
WRONG.SERVER)
3)
(LOOKUP.OBJECT ARGS (OBJECT.NAME.PATTERN AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR CALL.ERROR WRONG.SERVER)
4)
(LIST.ORGANIZATIONS ARGS (ORGANIZATION.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER)
5)
(LIST.DOMAINS ARGS (DOMAIN.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER)
6)
(LIST.OBJECTS ARGS (OBJECT.NAME.PATTERN PROPERTY BULK.DATA.SINK AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER)
7)
(LIST.ALIASES.OF ARGS (OBJECT.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER)
9)
(CREATE.ALIAS ARGS (OBJECT.NAME OBJECT.NAME AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR
WRONG.SERVER)
10)
(DELETE.ALIAS ARGS (OBJECT.NAME AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR
WRONG.SERVER)
11)
(LIST.ALIASES ARGS (OBJECT.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER)
8)
(DELETE.PROPERTY ARGS (OBJECT.NAME PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
14)
(LIST.PROPERTIES ARGS (OBJECT.NAME.PATTERN AUTHENTICATOR)
RESULTS
(OBJECT.NAME PROPERTIES)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER)
15)
(ADD.ITEM.PROPERTY ARGS (OBJECT.NAME PROPERTY ITEM AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
13)
(RETRIEVE.ITEM ARGS (OBJECT.NAME.PATTERN PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME ITEM)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
WRONG.SERVER)
16)
(CHANGE.ITEM ARGS (OBJECT.NAME PROPERTY ITEM AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
17)
(ADD.GROUP.PROPERTY ARGS (OBJECT.NAME PROPERTY BULK.DATA.SOURCE AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
12)
(RETRIEVE.MEMBERS ARGS (OBJECT.NAME.PATTERN PROPERTY BULK.DATA.SINK AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
WRONG.SERVER)
18)
(ADD.MEMBER ARGS (OBJECT.NAME PROPERTY THREE.PART.NAME AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
19)
(ADD.SELF ARGS (OBJECT.NAME PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
20)
(DELETE.MEMBER ARGS (OBJECT.NAME PROPERTY THREE.PART.NAME AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
21)
(DELETE.SELF ARGS (OBJECT.NAME PROPERTY AUTHENTICATOR)
RESULTS
(OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
UPDATE.ERROR WRONG.SERVER)
22)
(IS.MEMBER ARGS (OBJECT.NAME.PATTERN PROPERTY PROPERTY THREE.PART.NAME AUTHENTICATOR)
RESULTS
(BOOLEAN OBJECT.NAME)
ERRORS
(ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR
WRONG.SERVER)
23)
(RETRIEVE.ADDRESSES RESULTS (NETWORK.ADDRESS.LIST)
ERRORS
(CALL.ERROR)
0)
(LIST.DOMAINS.SERVED ARGS (BULK.DATA.SINK AUTHENTICATOR)
ERRORS
(CALL.ERROR)
1))
ERRORS
((ARGUMENT.ERROR ARGS (ARGUMENT.PROBLEM WHICH.ARGUMENT)
2)
(AUTHENTICATION.ERROR ARGS (AUTHENTICATION.PROBLEM)
6)
(CALL.ERROR ARGS (CALL.PROBLEM)
1)
(PROPERTY.ERROR ARGS (PROPERTY.PROBLEM OBJECT.NAME)
3)
(UPDATE.ERROR ARGS (UPDATE.PROBLEM BOOLEAN WHICH.ARGUMENT OBJECT.NAME)
4)
(WRONG.SERVER ARGS (OBJECT.NAME)
5)))
(* Lisp support.)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \CH.NULL.AUTHENTICATOR ((CREDENTIALS ((TYPE 0)
(VALUE NIL)))
(VERIFIER (0))))
(RPAQQ CH.PROPERTYIDS ((ALL 0)
(CLEARINGHOUSE.NAMES 3)
(CLEARINGHOUSE.ADDRESSES 4)
(FILESERVER 10)
(PRINTSERVER 11)
(USER 14)))
(RPAQQ \CH.BROADCAST.TYPE 2)
(RPAQQ \CH.BROADCAST.SOCKET 20)
(RPAQQ \BROADCAST.FOR.SERVERS.LENGTH 22)
(CONSTANTS [\CH.NULL.AUTHENTICATOR (QUOTE ((CREDENTIALS ((TYPE 0)
(VALUE NIL)))
(VERIFIER (0]
[CH.PROPERTYIDS (QUOTE ((ALL 0)
(CLEARINGHOUSE.NAMES 3)
(CLEARINGHOUSE.ADDRESSES 4)
(FILESERVER 10)
(PRINTSERVER 11)
(USER 14]
(\CH.BROADCAST.TYPE 2)
(\CH.BROADCAST.SOCKET 20)
(\BROADCAST.FOR.SERVERS.LENGTH 22))
)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD \BROADCAST.FOR.SERVERS.PACKET ((NIL 3 WORD) (* Packet exchange header)
(LOW.VERSION WORD)
(HIGH.VERSION WORD)
(ZERO1 WORD)
(ZERO2 WORD)
(PROGRAM# FIXP)
(VERSION# WORD)
(ZERO3 WORD)))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS LOCAL.CLEARINGHOUSE \CH.CACHE CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION)
)
)
(RPAQ? CH.DEFAULT.DOMAIN NIL)
(RPAQ? CH.DEFAULT.ORGANIZATION NIL)
(RPAQ? LOCAL.CLEARINGHOUSE NIL)
(RPAQ? \CH.CACHE NIL)
(RPAQ? CLEARINGHOUSE.STRUCTURE.WINDOW NIL)
(RPAQ? NS.SERVER.NAMES.TO.ADDRESSES NIL)
(DEFINEQ
(GETCLEARINGHOUSE
[LAMBDA NIL (* ecc "18-JUL-83 15:38")
(if (AND CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION LOCAL.CLEARINGHOUSE)
elseif [AND (NULL LOCAL.CLEARINGHOUSE)
(NULL (SETQ LOCAL.CLEARINGHOUSE (CH.BROADCAST.FOR.SERVERS]
then (ERROR "Can't find a Clearinghouse" NIL T)
else (PROG ((DOMAINS (CH.DOMAINS.SERVED LOCAL.CLEARINGHOUSE))
DOM)
(SETQ DOM (CAR DOMAINS))
(if (OR (NULL CH.DEFAULT.DOMAIN)
(NULL CH.DEFAULT.ORGANIZATION))
then (* Use the first domain that this server serves to set
the default domain and organization.)
(SETQ CH.DEFAULT.DOMAIN (CADR (ASSOC (QUOTE DOMAIN)
DOM)))
(SETQ CH.DEFAULT.ORGANIZATION (CADR (ASSOC (QUOTE ORGANIZATION)
DOM)))
(printout PROMPTWINDOW .TAB0 0 "[Default Clearinghouse domain set to "
CH.DEFAULT.DOMAIN ":" CH.DEFAULT.ORGANIZATION "]"))
(\CH.UPDATE.CACHE (PARSE.CH.NAME "local Clearinghouse:CHServers:CHServers")
LOCAL.CLEARINGHOUSE DOMAINS)
(RETURN LOCAL.CLEARINGHOUSE])
(START.CLEARINGHOUSE
[LAMBDA (RESTARTFLG) (* ecc "20-JUL-83 12:17")
(if RESTARTFLG
then (SETQ LOCAL.CLEARINGHOUSE NIL))
(if (NULL LOCAL.CLEARINGHOUSE)
then (SETQ \NS.ROUTING.TABLE.RADIUS 5)
(SETQ \CH.CACHE NIL)
(printout PROMPTWINDOW .TAB0 0 "[Starting Clearinghouse: this will take a few seconds]")
(if (NOT \NSFLG)
then (\NSINIT)
(BLOCK 5000) (* Allow time for routing info to be received.)
)
(GETCLEARINGHOUSE))
LOCAL.CLEARINGHOUSE])
(SHOW.CLEARINGHOUSE
[LAMBDA NIL (* ecc "20-JUL-83 16:06")
(* Show the cached Clearinghouse structure using
GRAPHER.)
(PROG (SEXPR)
[SETQ SEXPR (CONS "" (for ORG in \CH.CACHE collect
(CONS (CAR ORG)
(for DOM in (CDR ORG)
collect (CADR (ASSOC (QUOTE DOMAIN)
(CAR DOM]
(LOAD? (QUOTE GRAPHER.DCOM)
(QUOTE SYSLOAD))
(SETQ CLEARINGHOUSE.STRUCTURE.WINDOW (SHOWGRAPH (LAYOUTSEXPR SEXPR (QUOTE HORIZONTAL)
NIL
(QUOTE (HELVETICA 10 BOLD)))
(OR CLEARINGHOUSE.STRUCTURE.WINDOW
"Clearinghouse structure")))
[WINDOWPROP CLEARINGHOUSE.STRUCTURE.WINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA NIL
(SETQ CLEARINGHOUSE.STRUCTURE.WINDOW NIL]
(RETURN CLEARINGHOUSE.STRUCTURE.WINDOW])
(SHOW.ENTIRE.CLEARINGHOUSE
[LAMBDA NIL (* ecc "15-JUN-83 10:41")
(for ORG in (CH.ORGANIZATIONS) do (CH.FINDSERVER (LIST (LIST (QUOTE ORGANIZATION)
ORG)
(LIST (QUOTE DOMAIN)
"*"))
T)) (* Cache servers for all domains.)
(SHOW.CLEARINGHOUSE])
(CH.FINDSERVER
[LAMBDA (DOMAINPATTERN NOERRORFLG DONTPROBEFLG) (* ecc " 7-JUL-83 14:41")
(* Find a Clearinghouse which serves the specified
domain and return its NS address.
If DONTPROBEFLG is T, just search the cache.)
(PROG (ORGANIZATION DOMAIN ORGANIZATION.INFO ADDRESS STREAM TRANSFER.STREAM RESULTS NAMELIST)
(SETQ DOMAINPATTERN (PARSE.CH.NAME DOMAINPATTERN 2))
(SETQ ORGANIZATION (CADR (ASSOC (QUOTE ORGANIZATION)
DOMAINPATTERN)))
(SETQ DOMAIN (CADR (ASSOC (QUOTE DOMAIN)
DOMAINPATTERN)))
(for X in \CH.CACHE do (if (STREQUAL.EXCEPT.FOR.CASE (CAR X)
ORGANIZATION)
then (SETQ ORGANIZATION.INFO X)
(RETURN)))
[if ORGANIZATION.INFO
then (for DOMAIN.INFO in (CDR ORGANIZATION.INFO) do (if (MATCHING.CH.NAMES
(CAR DOMAIN.INFO)
DOMAINPATTERN)
then (SETQ ADDRESS
(CADADR DOMAIN.INFO))
(RETURN]
(if ADDRESS
then (RETURN ADDRESS)
elseif DONTPROBEFLG
then (if NOERRORFLG
then (RETURN NIL)
else (ERROR "Couldn't find Clearinghouse server for domain" (CH.NAME.TO.STRING
DOMAINPATTERN)
T))
else (printout PROMPTWINDOW .TAB0 0 "[Finding Clearinghouse server for " (
CH.NAME.TO.STRING DOMAINPATTERN)
"]")
[if (SETQ STREAM (COURIER.OPEN (if ORGANIZATION.INFO
then (CH.FINDSERVER (LIST (LIST (QUOTE
ORGANIZATION)
ORGANIZATION)
(LIST (QUOTE DOMAIN)
"*"))
NOERRORFLG T)
else (GETCLEARINGHOUSE))
NIL NOERRORFLG (QUOTE CLEARINGHOUSE)))
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ TRANSFER.STREAM
(COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE RETRIEVE.MEMBERS)
[PARSE.CH.NAME (if ORGANIZATION.INFO
then
(LIST (LIST (QUOTE
ORGANIZATION)
"CHServers")
(LIST (QUOTE DOMAIN)
ORGANIZATION)
(LIST (QUOTE OBJECT)
DOMAIN))
else (LIST (LIST (QUOTE
ORGANIZATION)
"CHServers")
(LIST (QUOTE DOMAIN)
"CHServers")
(LIST (QUOTE OBJECT)
ORGANIZATION]
(CH.PROPERTY (QUOTE CLEARINGHOUSE.NAMES))
NIL
(CH.GETAUTHENTICATOR)))
(SETQ NAMELIST (COURIER.READ.BULKDATA TRANSFER.STREAM
(QUOTE CLEARINGHOUSE)
(QUOTE OBJECT.NAME)))
(CLOSEF TRANSFER.STREAM)
(bind CHDOMAINS CHADDR for CH in NAMELIST
do (SETQ RESULTS (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE RETRIEVE.ITEM)
CH
(CH.PROPERTY (QUOTE
CLEARINGHOUSE.ADDRESSES))
(CH.GETAUTHENTICATOR)))
[SETQ CHADDR (CH.NSADDRESS (CAR (COURIER.READ.REP
(CADR RESULTS)
(QUOTE CLEARINGHOUSE)
(QUOTE
NETWORK.ADDRESS.LIST]
(SETQ CHDOMAINS (CH.DOMAINS.SERVED CHADDR))
(if CHDOMAINS
then (\CH.UPDATE.CACHE CH CHADDR CHDOMAINS]
(RETURN (CH.FINDSERVER DOMAINPATTERN NOERRORFLG T])
(\CH.UPDATE.CACHE
[LAMBDA (OBJECT ADDRESS DOMAINS.SERVED) (* ecc "28-JUN-83 10:31")
(PROG (NAME.AND.ADDRESS ORGANIZATION ORGANIZATION.INFO)
(printout PROMPTWINDOW .TAB0 0 "[Adding " (CADR (ASSOC (QUOTE OBJECT)
OBJECT))
" to cache of known Clearinghouses]")
(SETQ NAME.AND.ADDRESS (LIST OBJECT ADDRESS))
[for DOMAIN in DOMAINS.SERVED
do (SETQ ORGANIZATION (CADR (ASSOC (QUOTE ORGANIZATION)
DOMAIN)))
(SETQ ORGANIZATION.INFO NIL)
(for X in \CH.CACHE do (if (STREQUAL.EXCEPT.FOR.CASE (CAR X)
ORGANIZATION)
then (SETQ ORGANIZATION.INFO X)
(RETURN)))
(if (NULL ORGANIZATION.INFO)
then [SETQ \CH.CACHE (NCONC \CH.CACHE (LIST (LIST ORGANIZATION (LIST DOMAIN
NAME.AND.ADDRESS]
else (for DOMAIN.INFO in (CDR ORGANIZATION.INFO) do (if (EQUAL.CH.NAMES
(CAR DOMAIN.INFO)
DOMAIN)
then (NCONC DOMAIN.INFO
(LIST
NAME.AND.ADDRESS))
(RETURN))
finally (NCONC ORGANIZATION.INFO (LIST (LIST DOMAIN NAME.AND.ADDRESS]
(if CLEARINGHOUSE.STRUCTURE.WINDOW
then (SHOW.CLEARINGHOUSE])
(EQUAL.CH.NAMES
[LAMBDA (NAME1 NAME2) (* ecc "25-MAY-83 14:05")
(* Check if two Clearinghouse names are the same.)
(for X in NAME1 as Y in NAME2 always (STREQUAL.EXCEPT.FOR.CASE (CADR X)
(CADR Y])
(MATCHING.CH.NAMES
[LAMBDA (NAME1 NAME2) (* ecc " 2-MAY-83 14:02")
(* Check if two Clearinghouse names match.)
(AND NAME1 NAME2 (for X in NAME1 as Y in NAME2 always (OR (STREQUAL (CADR X)
"*")
(STREQUAL (CADR Y)
"*")
(STREQUAL.EXCEPT.FOR.CASE (CADR X)
(CADR Y])
(STREQUAL.EXCEPT.FOR.CASE
[LAMBDA (S1 S2) (* ecc " 7-JUN-83 11:35")
(* Use this version if instring doesn't work: (AND (EQP (fetch (STRINGP LENGTH) of S1) (fetch
(STRINGP LENGTH) of S2)) (STREQUAL (U-CASE S1) (U-CASE S2))))
(AND (EQP (fetch (STRINGP LENGTH) of S1)
(fetch (STRINGP LENGTH) of S2))
(for C1 instring S1 as C2 instring S2 always (EQP (U-CASECODE C1)
(U-CASECODE C2])
(CH.DOMAINS.SERVED
[LAMBDA (CH) (* ecc " 7-JUL-83 14:35")
(PROG ((STREAM (COURIER.OPEN CH NIL T (QUOTE CLEARINGHOUSE)))
TRANSFER.STREAM DOMAINS)
(if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE LIST.DOMAINS.SERVED)
NIL
(CH.GETAUTHENTICATOR)))
(SETQ DOMAINS (COURIER.READ.BULKDATA TRANSFER.STREAM (QUOTE
CLEARINGHOUSE)
(QUOTE DOMAIN.NAME)))
(CLOSEF TRANSFER.STREAM)))
(RETURN DOMAINS])
(CH.DOMAINS
[LAMBDA (DOMAINPATTERN) (* ecc " 7-JUL-83 14:36")
(PROG (STREAM TRANSFER.STREAM DOMAINS)
(SETQ DOMAINPATTERN (PARSE.CH.NAME DOMAINPATTERN 2))
(SETQ STREAM (COURIER.OPEN (CH.FINDSERVER DOMAINPATTERN T)
NIL T (QUOTE CLEARINGHOUSE)))
(if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE LIST.DOMAINS)
DOMAINPATTERN NIL (
CH.GETAUTHENTICATOR)))
(SETQ DOMAINS (COURIER.READ.BULKDATA TRANSFER.STREAM (QUOTE
CLEARINGHOUSE)
(QUOTE DOMAIN)))
(CLOSEF TRANSFER.STREAM)))
(RETURN DOMAINS])
(CH.ORGANIZATIONS
[LAMBDA (ORGANIZATIONPATTERN) (* ecc " 7-JUL-83 14:36")
(PROG ((STREAM (COURIER.OPEN (GETCLEARINGHOUSE)
NIL NIL (QUOTE CLEARINGHOUSE)))
TRANSFER.STREAM ORGANIZATIONS)
(RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE LIST.ORGANIZATIONS)
(PARSE.CH.NAME ORGANIZATIONPATTERN 1)
NIL
(CH.GETAUTHENTICATOR)))
(SETQ ORGANIZATIONS (COURIER.READ.BULKDATA TRANSFER.STREAM (QUOTE CLEARINGHOUSE)
(QUOTE ORGANIZATION)))
(CLOSEF TRANSFER.STREAM))
(RETURN ORGANIZATIONS])
(CH.SERVERS
[LAMBDA NIL (* ecc " 7-JUL-83 14:36")
(* Return a list of the names of all Clearinghouse
servers.)
(PROG (STREAM TRANSFER.STREAM ENUMERATION.LIST)
(SETQ STREAM (COURIER.OPEN (GETCLEARINGHOUSE)
NIL NIL (QUOTE CLEARINGHOUSE)))
(RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE RETRIEVE.MEMBERS)
(PARSE.CH.NAME
"CHServers:CHServers:CHServers")
(CH.PROPERTY (QUOTE CLEARINGHOUSE.NAMES))
NIL
(CH.GETAUTHENTICATOR)))
(SETQ ENUMERATION.LIST (COURIER.READ.BULKDATA TRANSFER.STREAM (QUOTE
CLEARINGHOUSE)
(QUOTE OBJECT.NAME)))
(CLOSEF TRANSFER.STREAM))
(RETURN (for OBJ in ENUMERATION.LIST collect (CADR (ASSOC (QUOTE OBJECT)
OBJ])
(CH.BROADCAST.FOR.SERVERS
[LAMBDA NIL (* ecc " 7-JUL-83 17:57")
(* Expanding ring broadcast, as defined in Clearinghouse
Protocol spec.)
(PROG ((SKT (OPENNSOCKET \CH.BROADCAST.SOCKET T))
EPKT BASE ROUTINGTABLE RESULT)
(SETQ EPKT (\FILLINXIP \XIPT.EXCHANGE SKT BROADCASTNSHOSTNUMBER \CH.BROADCAST.SOCKET 0
(IPLUS \XIPOVLEN \BROADCAST.FOR.SERVERS.LENGTH)))
(SETQ BASE (fetch XIPCONTENTS of EPKT))
(replace (PACKETEXCHANGEXIP PACKETEXCHANGEID) of BASE with (RAND))
(replace (PACKETEXCHANGEXIP PACKETEXCHANGETYPE) of BASE with \CH.BROADCAST.TYPE)
(replace (\BROADCAST.FOR.SERVERS.PACKET LOW.VERSION) of BASE with COURIER.VERSION#)
(replace (\BROADCAST.FOR.SERVERS.PACKET HIGH.VERSION) of BASE with COURIER.VERSION#)
[replace (\BROADCAST.FOR.SERVERS.PACKET PROGRAM#) of BASE
with (CAR (\GET.COURIER.PROG#VERS#.PAIR (QUOTE CLEARINGHOUSE]
[replace (\BROADCAST.FOR.SERVERS.PACKET VERSION#) of BASE
with (CADR (\GET.COURIER.PROG#VERS#.PAIR (QUOTE CLEARINGHOUSE]
(replace (\BROADCAST.FOR.SERVERS.PACKET ZERO1) of BASE with (replace (
\BROADCAST.FOR.SERVERS.PACKET ZERO2) of BASE with (replace (\BROADCAST.FOR.SERVERS.PACKET ZERO3)
of BASE with 0)))
(if (SETQ RESULT (\CH.BROADCAST.FOR.SERVERS.ON.NET 0 SKT EPKT))
then (* First try directly connected network.)
(GO DONE))
(if (AND (BOUNDP (QUOTE CH.NET.HINT))
(FIXP CH.NET.HINT)
(SETQ RESULT (\CH.BROADCAST.FOR.SERVERS.ON.NET CH.NET.HINT SKT EPKT)))
then (* Now use a hint for which network to try first.)
(GO DONE))
(SETQ ROUTINGTABLE (COPY (CDR \NS.ROUTING.TABLE)))
(* Need to make a copy so that the network code doesn't
change it out from under us.)
[for #HOPS from 0 to 5 do (for RT in ROUTINGTABLE
do (if (AND (EQP (fetch (ROUTING RTHOPCOUNT) of RT)
#HOPS)
(SETQ RESULT (\CH.BROADCAST.FOR.SERVERS.ON.NET
(fetch (ROUTING RTNET#) of RT)
SKT EPKT)))
then (GO DONE]
DONE(CLOSENSOCKET SKT)
(RETURN RESULT])
(\CH.BROADCAST.FOR.SERVERS.ON.NET
[LAMBDA (NET SOCKET EPKT) (* ecc "28-JUN-83 10:32")
(PROG (RESPONSE RESULT)
(replace XIPDESTNET of EPKT with NET)
(printout PROMPTWINDOW .TAB0 0 "[Broadcasting for Clearinghouse servers on net " .I0.8 NET
"]")
(to \MAXETHERTRIES do (if (AND (SETQ RESPONSE (EXCHANGEXIPS SOCKET EPKT T))
(SETQ RESULT (\CH.READ.BROADCAST.RESPONSE RESPONSE)))
then (SETQ RESULT (CH.NSADDRESS (CAR RESULT)))
(RETURN)))
(RETURN RESULT])
(\CH.READ.BROADCAST.RESPONSE
[LAMBDA (EPKT) (* ecc " 7-JUL-83 14:31")
(PROG ((STREAM (\STREAM.FROM.PACKET EPKT))
LOW.VERSION HIGH.VERSION)
(SETQ LOW.VERSION (GETWORD STREAM))
(SETQ HIGH.VERSION (GETWORD STREAM))
(RETURN (if (AND (AND (ILEQ LOW.VERSION COURIER.VERSION#)
(ILEQ COURIER.VERSION# HIGH.VERSION))
(EQ (GETWORD STREAM)
2))
then (GETWORD STREAM) (* This word isn't documented in the spec, but the
Clearinghouse sends it.)
(COURIER.READ STREAM (QUOTE CLEARINGHOUSE)
(QUOTE NETWORK.ADDRESS.LIST))
else NIL])
(PARSE.CH.NAME
[LAMBDA (NAME #PARTS.REQUESTED NOWILDCARDS) (* ecc "25-MAY-83 18:08")
(* Return a Clearinghouse name with 1, 2, or 3 parts
(default 3))
(PROG (FIRSTPART SECONDPART THIRDPART I J)
(GETCLEARINGHOUSE)
(if (NULL #PARTS.REQUESTED)
then (SETQ #PARTS.REQUESTED 3))
(if (NULL NAME)
then (SETQ NAME "*"))
(if [OR (NULL NAME)
(NOT (OR (LISTP NAME)
(STRINGP NAME)
(LITATOM NAME]
then (LISPERROR "ILLEGAL ARG" NAME))
(if (LISTP NAME)
then (* Since NAME is a list, it must already be a two or
three part name.)
(RETURN (SELECTQ #PARTS.REQUESTED
(1 (\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE ORGANIZATION)
NAME))
NOWILDCARDS))
[2 (LIST (LIST (QUOTE ORGANIZATION)
(\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE
ORGANIZATION)
NAME))
T))
(LIST (QUOTE DOMAIN)
(\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE DOMAIN)
NAME))
NOWILDCARDS]
[3 (LIST (LIST (QUOTE ORGANIZATION)
(\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE
ORGANIZATION)
NAME))
T))
(LIST (QUOTE DOMAIN)
(\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE DOMAIN)
NAME))
T))
(LIST (QUOTE OBJECT)
(\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE OBJECT)
NAME))
NOWILDCARDS]
(ERROR "Clearinghouse names must have 1, 2, or 3 parts"
#PARTS.REQUESTED)))
else (SETQ NAME (MKSTRING NAME))
(if (SETQ I (STRPOS ":" NAME))
then (SETQ FIRSTPART (SUBSTRING NAME 1 (SUB1 I)))
(if (SETQ J (STRPOS ":" NAME (ADD1 I)))
then (SETQ SECONDPART (SUBSTRING NAME (ADD1 I)
(SUB1 J)))
(SETQ THIRDPART (SUBSTRING NAME (ADD1 J)
NIL))
else (SETQ SECONDPART (SUBSTRING NAME (ADD1 I)
NIL)))
else (SETQ FIRSTPART NAME))
(RETURN (SELECTQ #PARTS.REQUESTED
(1 (\CH.CHECK.WILDCARD (OR THIRDPART SECONDPART FIRSTPART)
NOWILDCARDS))
[2 (LIST (LIST (QUOTE ORGANIZATION)
(\CH.CHECK.WILDCARD (OR THIRDPART SECONDPART
CH.DEFAULT.ORGANIZATION)
T))
(LIST (QUOTE DOMAIN)
(\CH.CHECK.WILDCARD (OR (AND THIRDPART SECONDPART)
FIRSTPART)
NOWILDCARDS]
[3 (LIST (LIST (QUOTE ORGANIZATION)
(\CH.CHECK.WILDCARD (OR THIRDPART
CH.DEFAULT.ORGANIZATION)
T))
(LIST (QUOTE DOMAIN)
(\CH.CHECK.WILDCARD (OR SECONDPART CH.DEFAULT.DOMAIN)
T))
(LIST (QUOTE OBJECT)
(\CH.CHECK.WILDCARD FIRSTPART NOWILDCARDS]
(ERROR "Clearinghouse names must have 1, 2, or 3 parts"
#PARTS.REQUESTED])
(CH.NAME.TO.STRING
[LAMBDA (CHNAME FULLNAMEFLG) (* ecc "20-JUN-83 11:56")
(* Return a string for a Clearinghouse name.
Leaves off default components unless FULLNAMEFLG is
set.)
(if (OR (LITATOM CHNAME)
(STRINGP CHNAME))
then (SETQ CHNAME (PARSE.CH.NAME CHNAME)))
(SELECTQ (LENGTH CHNAME)
[2 (PROG [(ORG (CADR (ASSOC (QUOTE ORGANIZATION)
CHNAME)))
(DOM (CADR (ASSOC (QUOTE DOMAIN)
CHNAME]
(RETURN (if (OR FULLNAMEFLG (NOT (STREQUAL.EXCEPT.FOR.CASE ORG
CH.DEFAULT.ORGANIZATION)))
then (CONCAT DOM ":" ORG)
else DOM]
[3 (PROG [(ORG (CADR (ASSOC (QUOTE ORGANIZATION)
CHNAME)))
(DOM (CADR (ASSOC (QUOTE DOMAIN)
CHNAME)))
(OBJ (CADR (ASSOC (QUOTE OBJECT)
CHNAME]
(RETURN (if (OR FULLNAMEFLG (NOT (STREQUAL.EXCEPT.FOR.CASE ORG
CH.DEFAULT.ORGANIZATION)))
then (CONCAT OBJ ":" DOM ":" ORG)
elseif (NOT (STREQUAL.EXCEPT.FOR.CASE DOM CH.DEFAULT.DOMAIN))
then (CONCAT OBJ ":" DOM)
else (* Leave a trailing colon on the name as a hack to
distinguish it from PUP names.)
(CONCAT OBJ ":"]
(LISPERROR "ILLEGAL ARG" CHNAME])
(CANONICAL.CH.NAME
[LAMBDA (NAME) (* ecc "22-JUN-83 13:17")
(MKATOM (CH.NAME.TO.STRING (PARSE.CH.NAME NAME])
(\CH.CHECK.WILDCARD
[LAMBDA (STRING WILDCARDSILLEGALP) (* ecc "27-APR-83 17:41")
(if (NULL STRING)
then (SETQ STRING "*"))
(if (OR (NOT WILDCARDSILLEGALP)
(NOT (STRPOS "*" STRING)))
then STRING
else (ERROR "Wildcard characters not allowed" STRING])
(CH.PROPERTY
[LAMBDA (PROP) (* ecc "27-APR-83 12:28")
(* Return the official Clearinghouse property ID for the
specified property.)
(if (LITATOM PROP)
then (COND
((CADR (ASSOC PROP CH.PROPERTYIDS)))
(T (ERROR "Unknown Clearinghouse property" PROP)))
else PROP])
(CH.NSADDRESS
[LAMBDA (X) (* ecc " 7-JUL-83 14:42")
(* Convert a network address returned by Clearinghouse
into an NSADDRESS record.)
(PROG (NET HOST)
(SETQ NET (COURIER.READ.REP (CADR (ASSOC (QUOTE NETWORK)
X))
(QUOTE CLEARINGHOUSE)
(QUOTE LONGCARDINAL)))
(SETQ HOST (CADR (ASSOC (QUOTE HOST)
X)))
(RETURN (create NSADDRESS
NSNET ← NET
NSHNM0 ←(CAR HOST)
NSHNM1 ←(CADR HOST)
NSHNM2 ←(CADDR HOST])
(CH.GETAUTHENTICATOR
[LAMBDA NIL (* ecc "31-MAY-83 15:41")
\CH.NULL.AUTHENTICATOR])
(CH.ENUMERATE
[LAMBDA (OBJECTPATTERN PROPERTY) (* ecc " 7-JUL-83 14:36")
(PROG (STREAM TRANSFER.STREAM ENUMERATION.LIST)
(SETQ OBJECTPATTERN (PARSE.CH.NAME OBJECTPATTERN))
(if (NULL PROPERTY)
then (* Use the null property.)
(SETQ PROPERTY (QUOTE ALL)))
(SETQ STREAM (COURIER.OPEN (CH.FINDSERVER (PARSE.CH.NAME OBJECTPATTERN 2)
T)
NIL T (QUOTE CLEARINGHOUSE)))
[if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE LIST.OBJECTS)
OBJECTPATTERN
(CH.PROPERTY PROPERTY)
NIL
(CH.GETAUTHENTICATOR)
T))
(if TRANSFER.STREAM
then (SETQ ENUMERATION.LIST (COURIER.READ.BULKDATA TRANSFER.STREAM
(QUOTE
CLEARINGHOUSE)
(QUOTE OBJECT)))
(CLOSEF TRANSFER.STREAM]
(RETURN ENUMERATION.LIST])
(CH.LOOKUP
[LAMBDA (OBJECTPATTERN PROPERTY) (* ecc "15-JUN-83 15:02")
(PROG (STREAM RESULTS)
(SETQ OBJECTPATTERN (PARSE.CH.NAME OBJECTPATTERN))
(SETQ STREAM (COURIER.OPEN (CH.FINDSERVER (PARSE.CH.NAME OBJECTPATTERN 2)
T)
NIL T (QUOTE CLEARINGHOUSE)))
[if STREAM
then (RESETLST (RESETSAVE NIL (LIST (QUOTE [LAMBDA (X)
(SPP.CLOSE X RESETSTATE])
STREAM))
(SETQ RESULTS (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE)
(QUOTE RETRIEVE.ITEM)
OBJECTPATTERN
(CH.PROPERTY PROPERTY)
(CH.GETAUTHENTICATOR)
T]
(RETURN RESULTS])
(LOOKUP.NS.SERVER
[LAMBDA (NAME TYPE) (* ecc " 7-JUL-83 14:42")
(* Return the NS address of the specified server.
If a type is given, use the Clearinghouse if the address
isn't in the cache.)
(PROG (ADDRESS X)
(SETQ NAME (PARSE.CH.NAME NAME))
(for PAIR in NS.SERVER.NAMES.TO.ADDRESSES do (if (EQUAL.CH.NAMES (CAR PAIR)
NAME)
then (SETQ ADDRESS (CADR PAIR))
(RETURN)))
(if (AND (NULL ADDRESS)
TYPE
(SETQ X (CH.LOOKUP NAME TYPE)))
then [SETQ ADDRESS (CH.NSADDRESS (COURIER.READ.REP (CADR X)
(QUOTE CLEARINGHOUSE)
(QUOTE NETWORK.ADDRESS]
(push NS.SERVER.NAMES.TO.ADDRESSES (LIST NAME ADDRESS)))
(RETURN ADDRESS])
(CH.LOOKUP.USER
[LAMBDA (NAME) (* ecc " 7-JUL-83 14:42")
(PROG ((X (CH.LOOKUP NAME (QUOTE USER)))
USER)
(RETURN (if X
then (LIST (CAR X)
(COURIER.READ.REP (CADR X)
(QUOTE CLEARINGHOUSE)
(QUOTE (RECORD (LAST.NAME.INDEX CARDINAL)
(PASSWORD STRING)
(SYSTEM.ADMINISTRATOR BOOLEAN)
(FILESERVER OBJECT.NAME)
(MAILSERVER OBJECT.NAME)
(DESCRIPTION STRING)
(PRODUCT STRING)
(TRAINING STRING)
(HELP UNSPECIFIED])
)
(PUTPROPS COURIER COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (17952 19019 (HASH.PASSWORD 17962 . 18597) (NSLOGIN 18599 . 19017)) (23738 33198 (
GETNSPRINTER 23748 . 24155) (NSPRINT 24157 . 25241) (IP.SENDTOPRINTER 25243 . 25574) (NSPRINT.WATCHDOG
25576 . 26199) (\NSPRINT.WATCHDOG.INTERNAL 26201 . 27098) (OPEN.NS.PRINTING.STREAM 27100 . 31438) (
NSPRINTER.STATUS 31440 . 32011) (NSPRINTER.PROPERTIES 32013 . 32592) (NSPRINTREQUEST.STATUS 32594 .
33196)) (41609 67946 (GETCLEARINGHOUSE 41619 . 42826) (START.CLEARINGHOUSE 42828 . 43426) (
SHOW.CLEARINGHOUSE 43428 . 44422) (SHOW.ENTIRE.CLEARINGHOUSE 44424 . 44799) (CH.FINDSERVER 44801 .
48411) (\CH.UPDATE.CACHE 48413 . 49710) (EQUAL.CH.NAMES 49712 . 50059) (MATCHING.CH.NAMES 50061 .
50517) (STREQUAL.EXCEPT.FOR.CASE 50519 . 51035) (CH.DOMAINS.SERVED 51037 . 51741) (CH.DOMAINS 51743 .
52576) (CH.ORGANIZATIONS 52578 . 53316) (CH.SERVERS 53318 . 54382) (CH.BROADCAST.FOR.SERVERS 54384 .
57018) (\CH.BROADCAST.FOR.SERVERS.ON.NET 57020 . 57622) (\CH.READ.BROADCAST.RESPONSE 57624 . 58326) (
PARSE.CH.NAME 58328 . 61428) (CH.NAME.TO.STRING 61430 . 62844) (CANONICAL.CH.NAME 62846 . 63020) (
\CH.CHECK.WILDCARD 63022 . 63345) (CH.PROPERTY 63347 . 63782) (CH.NSADDRESS 63784 . 64413) (
CH.GETAUTHENTICATOR 64415 . 64559) (CH.ENUMERATE 64561 . 65715) (CH.LOOKUP 65717 . 66426) (
LOOKUP.NS.SERVER 66428 . 67345) (CH.LOOKUP.USER 67347 . 67944)))))
STOP