(FILECREATED "17-NOV-83 14:54:12" {PHYLUM}<LISPCORE>SOURCES>COURIER.;14 55336 changes to: (VARS COURIERCOMS) (FNS CH.ADD.USER CH.LOOKUP CH.ENUMERATE CH.SERVERS CH.ORGANIZATIONS CH.DOMAINS CH.DOMAINS.SERVED CH.FINDSERVER NSPRINTREQUEST.STATUS NSPRINTER.PROPERTIES NSPRINTER.STATUS OPEN.NS.PRINTING.STREAM NSPRINT.WATCHDOG) previous date: " 3-NOV-83 22:51:58" {PHYLUM}<LISPCORE>SOURCES>COURIER.;10) (* Copyright (c) 1983 by Xerox Corporation) (PRETTYCOMPRINT COURIERCOMS) (RPAQQ COURIERCOMS ((COMS (DECLARE: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP) SPP))) (COMS (* Authentication Protocol.) (COURIERPROGRAMS AUTHENTICATION) (DECLARE: DONTCOPY (CONSTANTS (\AUTHENTICATION.SIMPLE.CREDENTIALS 0))) (FNS HASH.PASSWORD NSLOGIN)) (COMS (* Printing Protocol.) (COURIERPROGRAMS PRINTING) (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.) (COURIERPROGRAMS CLEARINGHOUSE) (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) (IRS 12) (USER 14) (MAILSERVER 15) (WORKSTATION 17) (ECS 20) (ITS 23] (\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)) (ADDVARS (\SYSTEMCACHEVARS LOCAL.CLEARINGHOUSE \CH.CACHE NS.SERVER.NAMES.TO.ADDRESSES)) (FNS GETCLEARINGHOUSE START.CLEARINGHOUSE SHOW.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.GUESS.NEW.PROPERTIES CH.NSADDRESS CH.GETAUTHENTICATOR CH.ENUMERATE CH.LOOKUP LOOKUP.NS.SERVER CH.LOOKUP.USER CH.ADD.USER)))) (DECLARE: DONTCOPY EVAL@COMPILE (FILESLOAD (LOADCOMP) SPP) ) (* 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]) (DECLARE: DONTCOPY (DECLARE: EVAL@COMPILE (RPAQQ \AUTHENTICATION.SIMPLE.CREDENTIALS 0) (CONSTANTS (\AUTHENTICATION.SIMPLE.CREDENTIALS 0)) ) ) (DEFINEQ (HASH.PASSWORD [LAMBDA (PASSWORD) (* bvm: " 3-NOV-83 22:35") (* 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 (\DECRYPT.PWD.CHAR CHAR))) 65357)) finally (RETURN HASH]) (NSLOGIN [LAMBDA (HOST MSG) (* ecc "16-AUG-83 15:51") (PROG (INFO NAME/PASSWORD) (SETQ HOST (MKATOM (CH.NAME.TO.STRING HOST T))) (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))) (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 (PRINTERNAME FILE OPTIONS) (* lmm " 3-OCT-83 18:11") (PROG (FULLFILENAME COURIERSTREAM PRINTINGSTREAM) (if (NULL (SETQ FULLFILENAME (INFILEP FILE))) then (LISPERROR "FILE NOT FOUND" FILE)) (RETURN (COND ([SETQ PRINTINGSTREAM (OPEN.NS.PRINTING.STREAM PRINTERNAME (OR (LISTGET OPTIONS (QUOTE DOCUMENT.NAME)) FULLFILENAME) (OR (LISTGET OPTIONS (QUOTE DOCUMENT.CREATION.DATE)) (GETFILEINFO FULLFILENAME (QUOTE ICREATIONDATE))) (LISTGET OPTIONS (QUOTE SENDER.NAME)) (LISTGET OPTIONS (QUOTE RECIPENT.NAME)) (LISTGET OPTIONS (QUOTE #COPIES)) (LISTGET OPTIONS (QUOTE MEDIUM)) (LISTGET OPTIONS (QUOTE PRIORITY)) (LISTGET OPTIONS (QUOTE STAPLE?)) (EQ 2 (OR (LISTGET OPTIONS (QUOTE #SIDES)) EMPRESS#SIDES] (RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) PRINTINGSTREAM)) (RESETSAVE NIL (LIST (FUNCTION 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) (* bvm: "16-NOV-83 15:28") (PROG [[PRINTER (CADR (ASSOC (QUOTE PRINTSERVER) (fetch NSPRINTING.ATTRIBUTES of SUBSTREAM] (JOBNAME (CADR (ASSOC (QUOTE DOCUMENT) (fetch NSPRINTING.ATTRIBUTES of SUBSTREAM] (ADD.PROCESS (LIST (FUNCTION \NSPRINT.WATCHDOG.INTERNAL) (KWOTE ID) (KWOTE PRINTER) (KWOTE JOBNAME)) (QUOTE NAME) (PACK* (OR (ROOTFILENAME JOBNAME) JOBNAME) " Watchdog"]) (\NSPRINT.WATCHDOG.INTERNAL [LAMBDA (ID PRINTER JOBNAME) (* ecc "23-AUG-83 16:09") (bind (RESULT STATUS MSG) do (SETQ RESULT (NSPRINTREQUEST.STATUS ID PRINTER)) (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?) (* bvm: "16-NOV-83 15:10") (* Return a stream for Interpress printing.) (PROG (COURIERSTREAM PROPERTIES STATUS ATTRIBUTES OPTIONS) [COND ((NULL DOCUMENT.CREATION.DATE) (SETQ DOCUMENT.CREATION.DATE (IDATE] [COND ((NULL SENDER.NAME) (SETQ SENDER.NAME (USERNAME NIL NIL T] (COND ((NULL RECIPIENT.NAME) (SETQ RECIPIENT.NAME SENDER.NAME))) (COND ((NULL #COPIES) (SETQ #COPIES 1))) [COND ((NULL PRIORITY) (SETQ PRIORITY (QUOTE NORMAL] (SETQ PRINTER (GETNSPRINTER PRINTER)) (SETQ COURIERSTREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER) NIL (PACK* (CH.NAME.TO.STRING PRINTER) " Printing"))) (RETURN (COND (COURIERSTREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) COURIERSTREAM)) [COND ((OR MEDIUM STAPLE? TWO.SIDED?) (* Check that the printer supports these options.) (SETQ PROPERTIES (COURIER.CALL COURIERSTREAM (QUOTE PRINTING) (QUOTE GET.PRINTER.PROPERTIES))) (COND ([AND MEDIUM (NOT (MEMBER MEDIUM (CADR (ASSOC (QUOTE MEDIA) PROPERTIES] (ERROR "Printer does not support medium" PROPERTIES T))) (COND ([AND STAPLE? (NOT (CADR (ASSOC (QUOTE STAPLE) PROPERTIES] (ERROR "Printer does not support stapled copies" PROPERTIES T))) (COND ([AND TWO.SIDED? (NOT (CADR (ASSOC (QUOTE TWO.SIDED) PROPERTIES] (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] (COND ((EQ STATUS (QUOTE AVAILABLE)) (RETURN))) (COND ((NEQ STATUS (QUOTE BUSY)) (ERROR "Printer spooler" STATUS T))) (printout PROMPTWINDOW .TAB0 0 "[Spooler busy; will retry]") (BLOCK 5000)) [SETQ ATTRIBUTES (BQUOTE ((PRINT.OBJECT.NAME , DOCUMENT.NAME) (PRINT.OBJECT.CREATE.DATE , DOCUMENT.CREATION.DATE) (SENDER.NAME , SENDER.NAME] [SETQ OPTIONS (BQUOTE ((RECIPIENT.NAME , RECIPIENT.NAME) (COPY.COUNT , #COPIES) (PRIORITY.HINT , PRIORITY) (STAPLE , STAPLE?) (TWO.SIDED , TWO.SIDED?] [COND (MEDIUM (* We've already checked that the printer supports this medium.) (SETQ OPTIONS (CONS (BQUOTE (MEDIUM.HINT , MEDIUM)) OPTIONS] (SETQ PRINTINGSTREAM (COURIER.CALL COURIERSTREAM (QUOTE PRINTING) (QUOTE PRINT) (COND (NOWATCHDOG? NIL) (T (FUNCTION NSPRINT.WATCHDOG))) ATTRIBUTES OPTIONS)) [replace NSPRINTING.ATTRIBUTES of PRINTINGSTREAM with (BQUOTE ((PRINTSERVER , PRINTER) (DOCUMENT , DOCUMENT.NAME] PRINTINGSTREAM]) (NSPRINTER.STATUS [LAMBDA (PRINTER) (* bvm: "16-NOV-83 15:09") (PROG (STREAM) (SETQ PRINTER (GETNSPRINTER PRINTER)) (SETQ STREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER) NIL (PACK* (CH.NAME.TO.STRING PRINTER) " Printing"))) (RETURN (COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (COURIER.CALL STREAM (QUOTE PRINTING) (QUOTE GET.PRINTER.STATUS]) (NSPRINTER.PROPERTIES [LAMBDA (PRINTER) (* bvm: "16-NOV-83 15:09") (PROG (STREAM) (SETQ PRINTER (GETNSPRINTER PRINTER)) (SETQ STREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER) NIL (PACK* (CH.NAME.TO.STRING PRINTER) " Printing"))) (RETURN (COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (COURIER.CALL STREAM (QUOTE PRINTING) (QUOTE GET.PRINTER.PROPERTIES]) (NSPRINTREQUEST.STATUS [LAMBDA (REQUESTID PRINTERHOST) (* bvm: "16-NOV-83 15:09") (PROG (STREAM) (SETQ PRINTER (GETNSPRINTER PRINTER)) (SETQ STREAM (COURIER.OPEN PRINTER (QUOTE PRINTSERVER) NIL (PACK* (CH.NAME.TO.STRING PRINTER) " Printing"))) (RETURN (COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) 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] (USER.ENTRY (RECORD (LAST.NAME.INDEX CARDINAL) (PASSWORD STRING) (SYSTEM.ADMINISTRATOR BOOLEAN) (FILESERVER OBJECT.NAME) (MAILSERVER OBJECT.NAME) (DESCRIPTION STRING) (PRODUCT STRING) (TRAINING STRING) (HELP UNSPECIFIED))) (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))) (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) (IRS 12) (USER 14) (MAILSERVER 15) (WORKSTATION 17) (ECS 20) (ITS 23))) (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) (IRS 12) (USER 14) (MAILSERVER 15) (WORKSTATION 17) (ECS 20) (ITS 23] (\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) (ADDTOVAR \SYSTEMCACHEVARS LOCAL.CLEARINGHOUSE \CH.CACHE NS.SERVER.NAMES.TO.ADDRESSES) (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 (ENTIRE.CLEARINGHOUSE? DONT.GRAPH) (* ecc "18-AUG-83 14:50") (PROG (SEXPR) [SETQ SEXPR (CONS "" (if ENTIRE.CLEARINGHOUSE? then (* Find all domains in all organizations.) [for ORG in (CH.ORGANIZATIONS "*") collect (CONS ORG (CH.DOMAINS (CONCAT "*:" ORG] else (* Use cached structure.) (for ORG in \CH.CACHE collect (CONS (CAR ORG) (for DOM in (CDR ORG) collect (CADR (ASSOC (QUOTE DOMAIN) (CAR DOM] (if DONT.GRAPH then (RETURN SEXPR)) (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]) (CH.FINDSERVER [LAMBDA (DOMAINPATTERN NOERRORFLG DONTPROBEFLG) (* bvm: "16-NOV-83 15:08") (* 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 (COND ((STREQUAL.EXCEPT.FOR.CASE (CAR X) ORGANIZATION) (SETQ ORGANIZATION.INFO X) (RETURN] [COND (ORGANIZATION.INFO (for DOMAIN.INFO in (CDR ORGANIZATION.INFO) do (COND ((MATCHING.CH.NAMES (CAR DOMAIN.INFO) DOMAINPATTERN) (SETQ ADDRESS (CADADR DOMAIN.INFO)) (RETURN] (COND (ADDRESS (RETURN ADDRESS)) [DONTPROBEFLG (COND (NOERRORFLG (RETURN NIL)) (T (ERROR "Couldn't find Clearinghouse server for domain" ( CH.NAME.TO.STRING DOMAINPATTERN) T] (T (printout PROMPTWINDOW .TAB0 0 "[Finding Clearinghouse server for " (CH.NAME.TO.STRING DOMAINPATTERN) "]") [COND ((SETQ STREAM (COURIER.OPEN (COND (ORGANIZATION.INFO (CH.FINDSERVER (BQUOTE ((ORGANIZATION , ORGANIZATION) (DOMAIN , "*"))) NOERRORFLG T)) (T (GETCLEARINGHOUSE))) NIL NOERRORFLG (QUOTE CLEARINGHOUSE))) (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE) (QUOTE RETRIEVE.MEMBERS) [PARSE.CH.NAME (COND [ORGANIZATION.INFO (BQUOTE ((ORGANIZATION , "CHServers") (DOMAIN , ORGANIZATION) (OBJECT , DOMAIN] (T (BQUOTE ((ORGANIZATION , "CHServers") (DOMAIN , "CHServers") (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)) (COND (CHDOMAINS (\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) (* bvm: "16-NOV-83 15:03") (PROG ((STREAM (COURIER.OPEN CH NIL T (QUOTE CLEARINGHOUSE))) TRANSFER.STREAM DOMAINS) [COND (STREAM (* We wrap this in an NLSETQ because we might get an error underneath the Bulk Data transfer if we're not really talking to a Clearinghouse.) (NLSETQ (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) 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) (* bvm: "16-NOV-83 15:03") (PROG (STREAM TRANSFER.STREAM DOMAINS) (SETQ DOMAINPATTERN (PARSE.CH.NAME DOMAINPATTERN 2)) (SETQ STREAM (COURIER.OPEN (CH.FINDSERVER DOMAINPATTERN T) NIL T (QUOTE CLEARINGHOUSE))) [COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) 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) (* bvm: "16-NOV-83 15:03") (PROG ((STREAM (COURIER.OPEN (GETCLEARINGHOUSE) NIL NIL (QUOTE CLEARINGHOUSE))) TRANSFER.STREAM ORGANIZATIONS) (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) 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 (* bvm: "16-NOV-83 15:02") (* 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 (FUNCTION \SPP.RESETCLOSE) 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 "29-AUG-83 13:08") (* 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)) CH.NET.HINT) then (* Now use a hint for which network to try first.) (if (FIXP CH.NET.HINT) then (if (SETQ RESULT (\CH.BROADCAST.FOR.SERVERS.ON.NET CH.NET.HINT SKT EPKT)) then (GO DONE)) elseif (LISTP CH.NET.HINT) then (for NET in CH.NET.HINT do (if (SETQ RESULT ( \CH.BROADCAST.FOR.SERVERS.ON.NET NET SKT EPKT)) then (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 "15-AUG-83 14:43") (* 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 (BQUOTE ((ORGANIZATION , (\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE ORGANIZATION) NAME)) T)) (DOMAIN , (\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE DOMAIN) NAME)) NOWILDCARDS] [3 (BQUOTE ((ORGANIZATION , (\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE ORGANIZATION) NAME)) T)) (DOMAIN , (\CH.CHECK.WILDCARD (CADR (ASSOC (QUOTE DOMAIN) NAME)) T)) (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 (BQUOTE ((ORGANIZATION , (\CH.CHECK.WILDCARD (OR THIRDPART SECONDPART CH.DEFAULT.ORGANIZATION) T)) (DOMAIN , (\CH.CHECK.WILDCARD (OR (AND THIRDPART SECONDPART) FIRSTPART) NOWILDCARDS] [3 (BQUOTE ((ORGANIZATION , (\CH.CHECK.WILDCARD (OR THIRDPART CH.DEFAULT.ORGANIZATION) T)) (DOMAIN , (\CH.CHECK.WILDCARD (OR SECONDPART CH.DEFAULT.DOMAIN) T)) (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.GUESS.NEW.PROPERTIES [LAMBDA (DOMAIN MINPROPERTYID MAXPROPERTYID) (* ecc "12-AUG-83 14:58") (* This is a hack that finds all the objects in the given domain with any properties in the given range. Useful for finding out what the Services people are up to.) (PROG ([PATTERN (PARSE.CH.NAME (APPEND (PARSE.CH.NAME DOMAIN 2) (QUOTE (OBJECT "*"] OBJECTS) (SETQ MINPROPERTYID (OR MINPROPERTYID 1)) (SETQ MAXPROPERTYID (OR MAXPROPERTYID 25)) (RETURN (for ID from MINPROPERTYID to MAXPROPERTYID when (SETQ OBJECTS (CH.ENUMERATE PATTERN ID)) collect (CONS ID OBJECTS]) (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) (* bvm: "16-NOV-83 15:02") (PROG (STREAM TRANSFER.STREAM ENUMERATION.LIST) (SETQ OBJECTPATTERN (PARSE.CH.NAME OBJECTPATTERN)) [COND ((NULL PROPERTY) (* Use the null property.) (SETQ PROPERTY (QUOTE ALL] (SETQ STREAM (COURIER.OPEN (CH.FINDSERVER (PARSE.CH.NAME OBJECTPATTERN 2) T) NIL T (QUOTE CLEARINGHOUSE))) [COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (SETQ TRANSFER.STREAM (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE) (QUOTE LIST.OBJECTS) OBJECTPATTERN (CH.PROPERTY PROPERTY) NIL (CH.GETAUTHENTICATOR) T)) (COND (TRANSFER.STREAM (SETQ ENUMERATION.LIST (COURIER.READ.BULKDATA TRANSFER.STREAM (QUOTE CLEARINGHOUSE) (QUOTE OBJECT))) (CLOSEF TRANSFER.STREAM] (RETURN ENUMERATION.LIST]) (CH.LOOKUP [LAMBDA (OBJECTPATTERN PROPERTY) (* bvm: "16-NOV-83 15:01") (SETQ OBJECTPATTERN (PARSE.CH.NAME OBJECTPATTERN)) (PROG [(STREAM (COURIER.OPEN (CH.FINDSERVER (PARSE.CH.NAME OBJECTPATTERN 2) T) NIL T (QUOTE CLEARINGHOUSE] (RETURN (COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE) (QUOTE RETRIEVE.ITEM) OBJECTPATTERN (CH.PROPERTY PROPERTY) (CH.GETAUTHENTICATOR) T]) (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 "24-AUG-83 10:35") (PROG ((X (CH.LOOKUP NAME (QUOTE USER))) USER) (RETURN (if X then (LIST (CAR X) (COURIER.READ.REP (CADR X) (QUOTE CLEARINGHOUSE) (QUOTE USER.ENTRY]) (CH.ADD.USER [LAMBDA NIL (* bvm: "16-NOV-83 14:59") (PROG ((INFO (\INTERNAL/GETPASSWORD "New Clearinghouse user:" T)) FULL.NAME (LAST.NAME.INDEX 0) LAST.NAME PASSWORD SYSTEM.ADMINISTRATOR STREAM) (SETQ FULL.NAME (MKSTRING (CAR INFO))) (bind I while (SETQ I (STRPOS " " FULL.NAME (ADD1 LAST.NAME.INDEX))) do (SETQ LAST.NAME.INDEX I)) [SETQ LAST.NAME (PARSE.CH.NAME (SUBSTRING FULL.NAME (ADD1 LAST.NAME.INDEX] (SETQ FULL.NAME (PARSE.CH.NAME FULL.NAME)) (SETQ PASSWORD (CDR INFO)) (SETQ SYSTEM.ADMINISTRATOR (EQ (ASKUSER NIL NIL "System administrator? ") (QUOTE Y))) (COND ((NEQ (ASKUSER NIL NIL (CONCAT "Confirm new user '" (CH.NAME.TO.STRING FULL.NAME T) "' with alias '" (CH.NAME.TO.STRING LAST.NAME T) "' (Y or N) ")) (QUOTE Y)) (RETURN))) [SETQ INFO (BQUOTE ((LAST.NAME.INDEX , LAST.NAME.INDEX) (PASSWORD , (\DECRYPT.PWD PASSWORD)) (SYSTEM.ADMINISTRATOR , SYSTEM.ADMINISTRATOR) (FILESERVER , (PARSE.CH.NAME "FS")) (MAILSERVER , (PARSE.CH.NAME "MS")) (DESCRIPTION "") (PRODUCT "") (TRAINING "") (HELP 0] (SETQ STREAM (COURIER.OPEN (CH.FINDSERVER (PARSE.CH.NAME CH.DEFAULT.DOMAIN 2) T) NIL T (QUOTE CLEARINGHOUSE))) (COND (STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE) STREAM)) (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE) (QUOTE CREATE.OBJECT) FULL.NAME (CH.GETAUTHENTICATOR)) (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE) (QUOTE CREATE.ALIAS) LAST.NAME FULL.NAME (CH.GETAUTHENTICATOR)) (COURIER.CALL STREAM (QUOTE CLEARINGHOUSE) (QUOTE ADD.ITEM.PROPERTY) FULL.NAME (CH.PROPERTY (QUOTE USER)) (COURIER.WRITE.REP INFO (QUOTE CLEARINGHOUSE) (QUOTE USER.ENTRY)) (CH.GETAUTHENTICATOR]) ) (PUTPROPS COURIER COPYRIGHT ("Xerox Corporation" 1983)) (DECLARE: DONTCOPY (FILEMAP (NIL (3515 4629 (HASH.PASSWORD 3525 . 4181) (NSLOGIN 4183 . 4627)) (9203 17951 (GETNSPRINTER 9213 . 9620) (NSPRINT 9622 . 10923) (IP.SENDTOPRINTER 10925 . 11256) (NSPRINT.WATCHDOG 11258 . 11817) (\NSPRINT.WATCHDOG.INTERNAL 11819 . 12551) (OPEN.NS.PRINTING.STREAM 12553 . 16298) (NSPRINTER.STATUS 16300 . 16835) (NSPRINTER.PROPERTIES 16837 . 17380) (NSPRINTREQUEST.STATUS 17382 . 17949)) (26888 55258 (GETCLEARINGHOUSE 26898 . 28105) (START.CLEARINGHOUSE 28107 . 28705) (SHOW.CLEARINGHOUSE 28707 . 29921) (CH.FINDSERVER 29923 . 33134) (\CH.UPDATE.CACHE 33136 . 34433) (EQUAL.CH.NAMES 34435 . 34782 ) (MATCHING.CH.NAMES 34784 . 35240) (STREQUAL.EXCEPT.FOR.CASE 35242 . 35758) (CH.DOMAINS.SERVED 35760 . 36619) (CH.DOMAINS 36621 . 37422) (CH.ORGANIZATIONS 37424 . 38138) (CH.SERVERS 38140 . 39180) ( CH.BROADCAST.FOR.SERVERS 39182 . 42101) (\CH.BROADCAST.FOR.SERVERS.ON.NET 42103 . 42705) ( \CH.READ.BROADCAST.RESPONSE 42707 . 43409) (PARSE.CH.NAME 43411 . 46356) (CH.NAME.TO.STRING 46358 . 47772) (CANONICAL.CH.NAME 47774 . 47948) (\CH.CHECK.WILDCARD 47950 . 48273) (CH.PROPERTY 48275 . 48710 ) (\CH.GUESS.NEW.PROPERTIES 48712 . 49423) (CH.NSADDRESS 49425 . 50054) (CH.GETAUTHENTICATOR 50056 . 50200) (CH.ENUMERATE 50202 . 51281) (CH.LOOKUP 51283 . 51889) (LOOKUP.NS.SERVER 51891 . 52808) ( CH.LOOKUP.USER 52810 . 53130) (CH.ADD.USER 53132 . 55256))))) STOP