(FILECREATED "21-Feb-86 14:38:43" {ERIS}<LISPCORE>SOURCES>CLEARINGHOUSE.;32 77933  

      changes to:  (FNS GETCLEARINGHOUSE CH.RETRIEVE.MEMBERS)

      previous date: " 9-Jan-86 02:13:58" {ERIS}<LISPCORE>SOURCES>CLEARINGHOUSE.;31)


(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CLEARINGHOUSECOMS)

(RPAQQ CLEARINGHOUSECOMS ((COMS (* Authentication Protocol)
                                (COURIERPROGRAMS AUTHENTICATION CHACCESSCONTROL)
                                (DECLARE: DONTCOPY (CONSTANTS (\AUTHENTICATION.SIMPLE.CREDENTIALS
                                                               0)
                                                          (\AUTHENTICATION.SOCKET 21))
                                       (GLOBALVARS AUTHENTICATION.NET.HINT 
                                              \AUTHENTICATION.SERVER.CACHE))
                                (INITVARS (AUTHENTICATION.NET.HINT)
                                       (\AUTHENTICATION.SERVER.CACHE))
                                (ADDVARS (\SYSTEMCACHEVARS \AUTHENTICATION.SERVER.CACHE))
                                (FNS AS.CHANGE.PASSWORDS AS.CREATE.PASSWORDS AS.DELETE.PASSWORDS 
                                     AS.MAKE.CONVERSATION AS.NEXT.VERIFIER 
                                     CH.ADD.MEMBER.TO.DOMAIN.ACL CH.ADD.MEMBER.TO.PROPERTY.ACL 
                                     CH.ADD.SELF CH.DELETE.MEMBER.FROM.DOMAIN.ACL CH.DELETE.SELF 
                                     CH.IS.IN.DOMAIN.ACL CH.NUMBER.TO.PROPERTY CH.RETRIEVE.DOMAIN.ACL 
                                     CH.RETRIEVE.PROPERTY.ACL HASH.PASSWORD NSLOGIN NS.AUTHENTICATE 
                                     NS.MAKE.SIMPLE.CREDENTIALS \AUTHENTICATION.FIND.SERVER))
                          (COMS (* Clearinghouse Protocol)
                                (COURIERPROGRAMS CLEARINGHOUSE)
                                (DECLARE: DONTCOPY (CONSTANTS (\CH.BROADCAST.SOCKET 20)
                                                          (\CH.NULL.PROPERTY -1))
                                       (RECORDS CHBROADCAST DOMAINCACHE)
                                       (TEMPLATES CH.PROPERTY)
                                       (GLOBALVARS LOCAL.CLEARINGHOUSE \CH.CACHE CH.DEFAULT.DOMAIN 
                                              CH.DEFAULT.ORGANIZATION CH.NET.HINT \CH.MAINLOCK 
                                              NS.SERVER.NAMES.TO.ADDRESSES 
                                              CLEARINGHOUSE.STRUCTURE.WINDOW CH.PROPERTIES))
                                (INITVARS (CH.NET.HINT)
                                       (CH.DEFAULT.DOMAIN NIL)
                                       (CH.DEFAULT.ORGANIZATION NIL)
                                       (LOCAL.CLEARINGHOUSE NIL)
                                       (\CH.CACHE NIL)
                                       (CLEARINGHOUSE.STRUCTURE.WINDOW NIL)
                                       (NS.SERVER.NAMES.TO.ADDRESSES NIL)
                                       (\CH.MAINLOCK (CREATE.MONITORLOCK "Clearinghouse")))
                                (ADDVARS (\SYSTEMCACHEVARS LOCAL.CLEARINGHOUSE \CH.CACHE 
                                                NS.SERVER.NAMES.TO.ADDRESSES)
                                       (CH.PROPERTIES (ALL 0)
                                              (MEMBERS 3)
                                              (ADDRESS.LIST 4)
                                              (AUTHENTICATION.KEYS 6)
                                              (AUTHENTICATION.LEVEL 8)
                                              (MAILPRIMARY 30)
                                              (MAILBOXES 31)
                                              (MAILBOX.ACCESSCONTROL 32)
                                              (SERVICES 51)
                                              (FILE.SERVICE 10000)
                                              (PRINT.SERVICE 10001)
                                              (INTERNET.ROUTING.SERVICE 10002)
                                              (USER 10003)
                                              (MAIL.SERVICE 10004)
                                              (WORKSTATION 10005)
                                              (EXTERNAL.COMMUNICATION.SERVICE 10006)
                                              (RS232CPORT 10007)
                                              (INTERACTIVE.TERMINAL.SERVICE 10008)
                                              (GATEWAY.SERVICE 10009)
                                              (IBM3270.HOST 10010)
                                              (MAIL.GATEWAY 10011)
                                              (SIEMENS.9750.HOST 10012)
                                              (ADOBE.SERVICE 10013)
                                              (LIBRARIAN.SERVICE 10014)
                                              (TTX.GATEWAY 10015)
                                              (AUTHENTICATION.SERVICE 10016)
                                              (REMOTE.BATCH.SERVICE 10017)
                                              (NETWORK 10018)
                                              (NETWORK.SERVERS 10019)
                                              (CIU 10020)
                                              (CLEARINGHOUSE.SERVICE 10021)
                                              (USERGROUP 10022)
                                              (FETCH.SERVICE 10023)
                                              (USERDATA 20000)
                                              (RS232CDATA 20001)
                                              (IBM3270HOSTDATA 20002)
                                              (SIEMENS9750HOSTDATA 20003)
                                              (CANMAILTO 20005)
                                              (MAILGATEWAYROUTEDATA 20006)
                                              (FOREIGNMAILSYSTEMNAME 20007)
                                              (USERPASSWORD 20101)
                                              (FILESERVER 10)
                                              (PRINTSERVER 11)))
                                (COMS (* Clearinghouse names)
                                      (RECORDS NSNAME)
                                      (P (DEFPRINT (QUOTE NSNAME)
                                                (FUNCTION \NSNAME.DEFPRINT)))
                                      (PROP COURIERDEF NSNAME NSNAME2)
                                      (FNS \NSNAME.DEFPRINT NSNAME.TO.STRING COURIER.READ.NSNAME 
                                           COURIER.WRITE.NSNAME COURIER.NSNAME.LENGTH))
                                (COMS (* Finding Clearinghouse)
                                      (FNS GETCLEARINGHOUSE \CH.CHECK.CLEARINGHOUSE 
                                           START.CLEARINGHOUSE SHOW.CLEARINGHOUSE CH.FINDSERVER 
                                           \CH.FIND.ORG.SERVER \CH.LOCATE.SERVERS \CH.PRINT.BLURB 
                                           \CH.UPDATE.CACHE EQUAL.CH.NAMES PARSE.NSNAME 
                                           CH.NAME.TO.STRING CANONICAL.CH.NAME CH.PROPERTY 
                                           CH.GETAUTHENTICATOR)
                                      (FNS CH.SERVERS \CH.GUESS.NEW.PROPERTIES))
                                (COMS (* Clearinghouse calls)
                                      (FNS CH.DOMAINS.SERVED CH.CREATE.OBJECT CH.DELETE.OBJECT 
                                           CH.CANONICAL.NAME CH.CREATE.ALIAS CH.DELETE.ALIAS 
                                           CH.LOOKUP.OBJECT CH.DELETE.PROPERTY LOOKUP.NS.SERVER 
                                           \CANONICAL.NSHOSTNAME)
                                      (FNS CH.LIST.ALIASES CH.LIST.ALIASES.OF CH.LIST.DOMAINS 
                                           CH.LIST.ORGANIZATIONS CH.LIST.OBJECTS CH.LIST.PROPERTIES)
                                      (FNS CH.ADD.GROUP.PROPERTY CH.ADD.MEMBER CH.RETRIEVE.MEMBERS 
                                           CH.DELETE.MEMBER CH.ISMEMBER)
                                      (FNS CH.RETRIEVE.ITEM CH.ADD.ITEM.PROPERTY CH.CHANGE.ITEM)))
                          (VARS AS.WELL.KNOWN.NAME)))



(* Authentication Protocol)


(COURIERPROGRAM AUTHENTICATION (14 2)
    TYPES
      [(KEY (ARRAY 4 UNSPECIFIED))
       (BLOCK (ARRAY 4 UNSPECIFIED))
       (CREDENTIALS.TYPE (ENUMERATION (SIMPLE 0)
                                (STRONG 1)))
       [CREDENTIALS (RECORD (TYPE CREDENTIALS.TYPE)
                           (VALUE (SEQUENCE UNSPECIFIED]
       (credentials.package (SEQUENCE UNSPECIFIED))
       (CREDENTIALS.PACKAGE (RECORD (CREDENTIALS CREDENTIALS)
                                   (NONCE LONGCARDINAL)
                                   (RECIPIENT (CLEARINGHOUSE . NAME))
                                   (CONVERSATION.KEY KEY)))
       [STRONG.CREDENTIALS (RECORD (CONVERSATION.KEY KEY)
                                  (EXPIRATION.TIME TIME)
                                  (INITIATOR (CLEARINGHOUSE . NAME]
       (SIMPLE.CREDENTIALS (CLEARINGHOUSE . NAME))
       (VERIFIER (SEQUENCE UNSPECIFIED))
       (STRONG.VERIFIER (RECORD (TIMESTAMP TIME)
                               (TICKS LONGCARDINAL)))
       (SIMPLE.VERIFIER HASHED.PASSWORD)
       (HASHED.PASSWORD CARDINAL)
       (PROBLEM (ENUMERATION (CredentialsInvalid 0)
                       (VerifierInvalid 1)
                       (VerifierExpired 2)
                       (VerifierReused 3)
                       (CredentialsExpired 4)
                       (InappropriateCredentials 5)))
       (CALL.PROBLEM (ENUMERATION (TooBusy 0)
                            (AccessRightsInsufficient 1)
                            (KeysUnavailable 2)
                            (StrongKeyDoesNotExist 3)
                            (SimpleKeyDoesNotExist 4)
                            (StrongKeyAlreadyRegistered 5)
                            (SimpleKeyAlreadyRegistered 6)
                            (DomainForNewKeyUnavailable 7)
                            (DomainForNewKeyUnknown 8)
                            (BadKey 9)
                            (BadName 10)
                            (DatabaseFull 11)
                            (Other 12)))
       (WHICH (ENUMERATION (notApplicable 0)
                     (Initiator 1)
                     (Recipient 2)
                     (Client 3]
    PROCEDURES
      ((BROADCAST.FOR.SERVERS 0 NIL RETURNS ((CLEARINGHOUSE . NETWORK.ADDRESS.LIST)))
       (GET.STRONG.CREDENTIALS 1 ((CLEARINGHOUSE . NAME)
                                  (CLEARINGHOUSE . NAME)
                                  LONGCARDINAL)
              RETURNS
              (credentials.package)
              REPORTS
              (CALL.ERROR))
       (CHECK.SIMPLE.CREDENTIALS 2 (CREDENTIALS VERIFIER)
              RETURNS
              (BOOLEAN)
              REPORTS
              (AUTHENTICATION.ERROR CALL.ERROR))
       (CREATE.STRONG.KEY 3 (CREDENTIALS VERIFIER (CLEARINGHOUSE . NAME)
                                   KEY)
              RETURNS NIL REPORTS (AUTHENTICATION.ERROR CALL.ERROR))
       (CHANGE.STRONG.KEY 4 (CREDENTIALS VERIFIER KEY)
              RETURNS NIL REPORTS (AUTHENTICATION.ERROR CALL.ERROR))
       (DELETE.STRONG.KEY 5 (CREDENTIALS VERIFIER (CLEARINGHOUSE . NAME))
              RETURNS NIL REPORTS (AUTHENTICATION.ERROR CALL.ERROR))
       (CREATE.SIMPLE.KEY 6 (CREDENTIALS VERIFIER (CLEARINGHOUSE . NAME)
                                   HASHED.PASSWORD)
              RETURNS NIL REPORTS (AUTHENTICATION.ERROR CALL.ERROR))
       (CHANGE.SIMPLE.KEY 7 (CREDENTIALS VERIFIER HASHED.PASSWORD)
              RETURNS NIL REPORTS (AUTHENTICATION.ERROR CALL.ERROR))
       (DELETE.SIMPLE.KEY 8 (CREDENTIALS VERIFIER (CLEARINGHOUSE . NAME))
              RETURNS NIL REPORTS (AUTHENTICATION.ERROR CALL.ERROR)))
    ERRORS
      ((CALL.ERROR 1 (CALL.PROBLEM WHICH))
       (AUTHENTICATION.ERROR 2 (PROBLEM))))

(COURIERPROGRAM CHACCESSCONTROL (127 1)
    TYPES
      [(DOMAIN.NAME NSNAME2)
       (ORGANIZATION.NAME STRING)
       (WHICH.LIST (ENUMERATION (Readers 0)
                          (valueDONTUSE 1)
                          (Administrators 2)
                          (selfControllers 3)))
       (ELEMENT.NAME NSNAME)
       (DISTING.NAME NSNAME)
       (IS.MEMBER BOOLEAN)
       (PROPERTY (CLEARINGHOUSE . PROPERTY))
       (ACCESS.LIST (SEQUENCE ELEMENT.NAME))
       (CREDENTIALS (AUTHENTICATION . CREDENTIALS))
       (VERIFIER (AUTHENTICATION . VERIFIER))
       (CALL.PROBLEM (ENUMERATION (AccessRightsInsufficient 1)
                            (TooBusy 2)
                            (ServerDown 3)
                            (USE.COURIER 4)
                            (Other 5]
    PROCEDURES
      ((RETRIEVE.PROPERTY.ACL 30 (ELEMENT.NAME PROPERTY WHICH.LIST BULK.DATA.SINK CREDENTIALS 
                                        VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (ADD.MEMBER.TO.PROPERTY.ACL 31 (ELEMENT.NAME PROPERTY WHICH.LIST ELEMENT.NAME CREDENTIALS 
                                             VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (DELETE.MEMBER.FROM.PROPERTY.ACL 32 (ELEMENT.NAME PROPERTY WHICH.LIST ELEMENT.NAME CREDENTIALS 
                                                  VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (IS.IN.PROPERTY.ACL 33 (ELEMENT.NAME PROPERTY WHICH.LIST PROPERTY ELEMENT.NAME CREDENTIALS 
                                     VERIFIER)
              RETURNS
              (IS.MEMBER DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (RETRIEVE.DOMAIN.ACL 34 (DOMAIN.NAME WHICH.LIST BULK.DATA.SINK CREDENTIALS VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (ADD.MEMBER.TO.DOMAIN.ACL 35 (DOMAIN.NAME WHICH.LIST ELEMENT.NAME CREDENTIALS VERIFIER)
              RETURNS NIL REPORTS (CALL.ERROR))
       (DELETE.MEMBER.FROM.DOMAIN.ACL 36 (DOMAIN.NAME WHICH.LIST ELEMENT.NAME CREDENTIALS VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (IS.IN.DOMAIN.ACL 37 (DOMAIN.NAME WHICH.LIST PROPERTY ELEMENT.NAME CREDENTIALS VERIFIER)
              RETURNS
              (IS.MEMBER)
              REPORTS
              (CALL.ERROR))
       (RETRIEVE.ORGANIZATION.ACL 38 (ORGANIZATION.NAME WHICH.LIST BULK.DATA.SINK CREDENTIALS 
                                            VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (ADD.MEMBER.TO.ORGANIZATION.ACL 39 (ORGANIZATION.NAME WHICH.LIST ELEMENT.NAME CREDENTIALS 
                                                 VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (DELETE.MEMBER.FROM.ORGANIZATION.ACL 40 (ORGANIZATION.NAME WHICH.LIST ELEMENT.NAME CREDENTIALS 
                                                      VERIFIER)
              RETURNS
              (DISTING.NAME)
              REPORTS
              (CALL.ERROR))
       (IS.IN.ORGANIZATION.ACL 41 (ORGANIZATION.NAME WHICH.LIST PROPERTY ELEMENT.NAME CREDENTIALS 
                                         VERIFIER)
              RETURNS
              (IS.MEMBER DISTING.NAME)
              REPORTS
              (CALL.ERROR)))
    ERRORS
      ((CALL.ERROR 1 (CALL.PROBLEM))))
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \AUTHENTICATION.SIMPLE.CREDENTIALS 0)

(RPAQQ \AUTHENTICATION.SOCKET 21)

(CONSTANTS (\AUTHENTICATION.SIMPLE.CREDENTIALS 0)
       (\AUTHENTICATION.SOCKET 21))
)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS AUTHENTICATION.NET.HINT \AUTHENTICATION.SERVER.CACHE)
)
)

(RPAQ? AUTHENTICATION.NET.HINT )

(RPAQ? \AUTHENTICATION.SERVER.CACHE )

(ADDTOVAR \SYSTEMCACHEVARS \AUTHENTICATION.SERVER.CACHE)
(DEFINEQ

(AS.CHANGE.PASSWORDS

  [LAMBDA (PASSWORD)                                         (* jwo: " 9-Aug-85 02:00")


          (* * Because it is given to DES.PASSWORD.TO.KEY and HASH.PASSWORD, the argument PASSWORD must be in the 

	  \DECRYPT.PWD.CHAR format.)



    (DECLARE
 (
GLOBALVARS
 AS.WELL.KNOWN.NAME))
    (LET* ((ADDR (\AUTHENTICATION.FIND.SERVER
))
	   (CONVGOOK (AS.MAKE.CONVERSATION
 AS.WELL.KNOWN.NAME)))
          (if
 CONVGOOK
	      then
 (LET* [(CREDS (
CAR
 CONVGOOK))
			    (CONVKEY (
CDR
 CONVGOOK))
			    (VERIFIER (AS.NEXT.VERIFIER
 CONVKEY ADDR))
			    (RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
						    (
QUOTE
 CHANGE.STRONG.KEY)
						    CREDS VERIFIER [DES.BREAKOUT.BLOCKS
						      (
CONS
 (DES.ECB.ENCRYPT CONVKEY (
									      DES.PASSWORD.TO.KEY
										 PASSWORD]
						    (
QUOTE
 RETURNERRORS]
		           (if
 (
NEQ
 (
CAR
 RESULT)
					(
QUOTE
 ERROR))
			       then
 (
SETQ
 VERIFIER (AS.NEXT.VERIFIER
 CONVKEY ADDR))
				      (
SETQ
 RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
								     (
QUOTE
 CHANGE.SIMPLE.KEY)
								     CREDS VERIFIER (HASH.PASSWORD

								       PASSWORD)
								     (
QUOTE
 RETURNERRORS)))
				      (
NEQ
 (
CAR
 RESULT)
					     (
QUOTE
 ERROR])

(AS.CREATE.PASSWORDS

  [LAMBDA (NAME PASSWORD)                                    (* jwo: " 9-Aug-85 11:49")


          (* * Because it is given to DES.PASSWORD.TO.KEY and HASH.PASSWORD, the argument PASSWORD must be in the 

	  \DECRYPT.PWD.CHAR format.)



    (DECLARE
 (
GLOBALVARS
 AS.WELL.KNOWN.NAME))
    (
SETQ
 NAME (PARSE.NSNAME
 NAME))
    (LET* ((ADDR (\AUTHENTICATION.FIND.SERVER
))
	   (CONVGOOK (AS.MAKE.CONVERSATION
 AS.WELL.KNOWN.NAME)))
          (if
 CONVGOOK
	      then
 (LET* [(CREDS (
CAR
 CONVGOOK))
			    (CONVKEY (
CDR
 CONVGOOK))
			    (VERIFIER (AS.NEXT.VERIFIER
 CONVKEY ADDR))
			    (RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
						    (
QUOTE
 CREATE.STRONG.KEY)
						    CREDS VERIFIER NAME
						    [DES.BREAKOUT.BLOCKS (
CONS
 (DES.ECB.ENCRYPT
										   CONVKEY
										   (
DES.PASSWORD.TO.KEY PASSWORD]
						    (
QUOTE
 RETURNERRORS]
		           (if
 (
NEQ
 (
CAR
 RESULT)
					(
QUOTE
 ERROR))
			       then
 (
SETQ
 VERIFIER (AS.NEXT.VERIFIER
 CONVKEY ADDR))
				      (
SETQ
 RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
								     (
QUOTE
 CREATE.SIMPLE.KEY)
								     CREDS VERIFIER NAME
								     (HASH.PASSWORD
 PASSWORD)
								     (
QUOTE
 RETURNERRORS)))
				      (
NEQ
 (
CAR
 RESULT)
					     (
QUOTE
 ERROR])

(AS.DELETE.PASSWORDS

  [LAMBDA (NAME)                                             (* jwo: " 9-Aug-85 11:49")

    (DECLARE
 (
GLOBALVARS
 AS.WELL.KNOWN.NAME))
    (
SETQ
 NAME (PARSE.NSNAME
 NAME))
    (LET* ((ADDR (\AUTHENTICATION.FIND.SERVER
))
	   (CONVGOOK (AS.MAKE.CONVERSATION
 AS.WELL.KNOWN.NAME)))
          (if
 CONVGOOK
	      then
 (LET* [(CREDS (
CAR
 CONVGOOK))
			    (CONVKEY (
CDR
 CONVGOOK))
			    (VERIFIER (AS.NEXT.VERIFIER
 CONVKEY ADDR))
			    (RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
						    (
QUOTE
 DELETE.STRONG.KEY)
						    CREDS VERIFIER NAME (
QUOTE
 RETURNERRORS]
		           (if
 (
NEQ
 (
CAR
 RESULT)
					(
QUOTE
 ERROR))
			       then
 (
SETQ
 VERIFIER (AS.NEXT.VERIFIER
 CONVKEY ADDR))
				      (
SETQ
 RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
								     (
QUOTE
 DELETE.SIMPLE.KEY)
								     CREDS VERIFIER NAME
								     (
QUOTE
 RETURNERRORS)))
				      (
NEQ
 (
CAR
 RESULT)
					     (
QUOTE
 ERROR])

(AS.MAKE.CONVERSATION

  [LAMBDA (RECIPIENT)                                        (* jwo: " 9-Aug-85 22:39")

    (LET ((ADDR (\AUTHENTICATION.FIND.SERVER
)))
         (
COND

	   ((
NULL
 ADDR)
	     NIL)
	   (T (LET* [(NONCE (
RAND
))
		     (INFO (
\INTERNAL/GETPASSWORD
 (
QUOTE
 NS::)))
		     CRED.PACK
		     (cred.pack (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
						(
QUOTE
 GET.STRONG.CREDENTIALS)
						(PARSE.NSNAME
 USERNAME)
						(PARSE.NSNAME
 RECIPIENT)
						NONCE
						(
QUOTE
 RETURNERRORS]
		    (
COND

		      ((
EQ
 (
CAR
 cred.pack)
			     (
QUOTE
 ERROR))
			NIL)
		      (T (
SETQ
 CRED.PACK (
COURIER.READ.REP
 (DES.BREAKOUT.BLOCKS
								 (DES.CBCC.DECRYPT
								   (DES.PASSWORD.TO.KEY (
CDR
 INFO))
								   (DES.MAKE.BLOCKS cred.pack)))
							       (
QUOTE
 AUTHENTICATION)
							       (
QUOTE
 CREDENTIALS.PACKAGE)))
			 (if
 (
NOT
 (
IEQP
 (COURIER.FETCH (AUTHENTICATION . CREDENTIALS.PACKAGE)
							     NONCE of CRED.PACK)
					      NONCE))
			     then
 NIL
			   else
 (
CONS
 (COURIER.FETCH (AUTHENTICATION . CREDENTIALS.PACKAGE)
							 CREDENTIALS of CRED.PACK)
					  (DES.MAKE.KEY (COURIER.FETCH (AUTHENTICATION . 
									 CREDENTIALS.PACKAGE)
								       CONVERSATION.KEY of CRED.PACK])

(AS.NEXT.VERIFIER

  [LAMBDA (CONVKEY ADDR)                                     (* jwo: " 9-Aug-85 01:50")


          (* * The long garbage in the IF is and attempt to XOR the recipients "processor id" with the courier data 

	  representation, before encrypting.)



    (DES.BREAKOUT.BLOCKS
      (LET [(BL (DES.MAKE.BLOCKS (LET [(L (
COURIER.WRITE.REP
 (COURIER.CREATE (AUTHENTICATION . 
										 STRONG.VERIFIER)
									       TIMESTAMP _(
IDATE
)
									       TICKS _(
RAND
))
							       (
QUOTE
 AUTHENTICATION)
							       (
QUOTE
 STRONG.VERIFIER]
				      [if
 (
CAR
 L)
					  then
 (
RPLACA
 L (
LOGXOR
 (
CAR
 L)
								       (fetch
 (NSADDRESS NSHNM0)
									  of
 ADDR)))
						 (if
 (
CADR
 L)
						     then
 (
RPLACA
 (
CDR
 L)
								      (
LOGXOR
 (
CADR
 L)
										(fetch

										  (NSADDRESS NSHNM1)
										   of
 ADDR)))
							    (if
 (
CADDR
 L)
								then

								 (
RPLACA

								   (
CDDR
 L)
								   (
LOGXOR
 (
CADDR
 L)
									     (fetch
 (NSADDRESS
											NSHNM2)
										of
 ADDR]
				  L]
           (for
 E in
 BL collect
 (DES.ECB.ENCRYPT CONVKEY E])

(CH.ADD.MEMBER.TO.DOMAIN.ACL

  [LAMBDA (DOMAIN WHICH.LIST NEWMEMBER)                      (* jwo: "13-Jun-85 16:00")

    (
SETQ
 NEWMEMBER (CH.CANONICAL.NAME
 NEWMEMBER))
    (LET ((AUTH (CH.GETAUTHENTICATOR
 T)))
         (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 DOMAIN (PARSE.NSNAME
 DOMAIN 2)))
				   \CH.BROADCAST.SOCKET
				   (
QUOTE
 CHACCESSCONTROL)
				   (
QUOTE
 ADD.MEMBER.TO.DOMAIN.ACL)
				   DOMAIN WHICH.LIST NEWMEMBER (COURIER.FETCH (CLEARINGHOUSE . 
										AUTHENTICATOR)
									      CREDENTIALS of AUTH)
				   (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
						  VERIFIER of AUTH)
				   (
QUOTE
 RETURNERRORS])

(CH.ADD.MEMBER.TO.PROPERTY.ACL

  [LAMBDA (OBJECT PROPERTY WHICH.LIST NEWMEMBER STREAM)      (* jwo: " 8-Jul-85 14:28")

    (
SETQ
 OBJECT (PARSE.NSNAME
 OBJECT))
    (LET ((AUTH (CH.GETAUTHENTICATOR
 T)))
         (
COURIER.CALL
 (CH.FINDSERVER
 OBJECT)
			 (
QUOTE
 CHACCESSCONTROL)
			 (
QUOTE
 ADD.MEMBER.TO.PROPERTY.ACL)
			 OBJECT
			 (
OR
 (CH.PROPERTY
 PROPERTY)
			       PROPERTY)
			 WHICH.LIST
			 (PARSE.NSNAME
 NEWMEMBER)
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					CREDENTIALS of AUTH)
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					VERIFIER of AUTH)
			 (
QUOTE
 RETURNERRORS])

(CH.ADD.SELF

  [LAMBDA (GROUPNAME PROPERTY STREAM)                        (* jwo: " 7-Jul-85 17:24")

    (
SETQ
 GROUPNAME (PARSE.NSNAME
 GROUPNAME))
    (
COURIER.CALL
 (
OR
 STREAM (CH.FINDSERVER
 GROUPNAME))
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 ADD.SELF)
		    GROUPNAME
		    (
OR
 (
FIXP
 PROPERTY)
			  (CH.PROPERTY
 PROPERTY))
		    (CH.GETAUTHENTICATOR
 T)
		    (
QUOTE
 RETURNERRORS])

(CH.DELETE.MEMBER.FROM.DOMAIN.ACL

  [LAMBDA (DOMAIN WHICH.LIST OLDMEMBER)                      (* jwo: "13-Jun-85 16:22")

    (
SETQ
 OLDMEMBER (CH.CANONICAL.NAME
 OLDMEMBER))
    (LET ((AUTH (CH.GETAUTHENTICATOR
 T)))
         (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 DOMAIN (PARSE.NSNAME
 DOMAIN 2)))
				   \CH.BROADCAST.SOCKET
				   (
QUOTE
 CHACCESSCONTROL)
				   (
QUOTE
 DELETE.MEMBER.FROM.DOMAIN.ACL)
				   DOMAIN WHICH.LIST OLDMEMBER (COURIER.FETCH (CLEARINGHOUSE . 
										AUTHENTICATOR)
									      CREDENTIALS of AUTH)
				   (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
						  VERIFIER of AUTH)
				   (
QUOTE
 RETURNERRORS])

(CH.DELETE.SELF

  [LAMBDA (GROUPNAME PROPERTY STREAM)                        (* jwo: " 7-Jul-85 17:24")

    (
SETQ
 GROUPNAME (PARSE.NSNAME
 GROUPNAME))
    (
COURIER.CALL
 (
OR
 STREAM (CH.FINDSERVER
 GROUPNAME))
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 DELETE.SELF)
		    GROUPNAME
		    (
OR
 (
FIXP
 PROPERTY)
			  (CH.PROPERTY
 PROPERTY))
		    (CH.GETAUTHENTICATOR
 T)
		    (
QUOTE
 RETURNERRORS])

(CH.IS.IN.DOMAIN.ACL

  [LAMBDA (DOMAIN WHICH PROPERTY NAME)                       (* jwo: " 9-Aug-85 18:55")

    (LET ((AUTH (CH.GETAUTHENTICATOR
 T)))
         (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 DOMAIN (PARSE.NSNAME
 DOMAIN 2))
					  T)
			 (
QUOTE
 CHACCESSCONTROL)
			 (
QUOTE
 IS.IN.DOMAIN.ACL)
			 DOMAIN WHICH (
OR
 (CH.PROPERTY
 PROPERTY)
					    PROPERTY)
			 (PARSE.NSNAME
 NAME)
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					CREDENTIALS of AUTH)
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					VERIFIER of AUTH)
			 (
QUOTE
 RETURNERRORS])

(CH.NUMBER.TO.PROPERTY

  [LAMBDA (PNUM)                                             (* ejs: "10-Jun-85 16:26")


          (* * reverse mapping to that of CH.PROPERTY)



    (
CAR
 (for
 M in
 CH.PROPERTIES thereis
 (
EQ
 PNUM (
CADR
 M])

(CH.RETRIEVE.DOMAIN.ACL

  [LAMBDA (DOMAIN WHICH.LIST)                                (* jwo: "24-Jun-85 14:54")

    (LET ((AUTH (CH.GETAUTHENTICATOR
 T)))
         (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 DOMAIN (PARSE.NSNAME
 DOMAIN 2)))
			 (
QUOTE
 CHACCESSCONTROL)
			 (
QUOTE
 RETRIEVE.DOMAIN.ACL)
			 DOMAIN WHICH.LIST (
QUOTE
 (CHACCESSCONTROL . ELEMENT.NAME))
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					CREDENTIALS of AUTH)
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					VERIFIER of AUTH)
			 (
QUOTE
 RETURNERRORS])

(CH.RETRIEVE.PROPERTY.ACL

  [LAMBDA (NAME PROPERTY WHICH.LIST)                         (* jwo: "24-Jun-85 14:37")

    (LET ((AUTH (CH.GETAUTHENTICATOR
 T)))
         (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 NAME (PARSE.NSNAME
 NAME))
					  T)
			 (
QUOTE
 CHACCESSCONTROL)
			 (
QUOTE
 RETRIEVE.PROPERTY.ACL)
			 NAME
			 (
OR
 (CH.PROPERTY
 PROPERTY)
			       PROPERTY)
			 WHICH.LIST
			 (
QUOTE
 (CHACCESSCONTROL . ELEMENT.NAME))
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					CREDENTIALS of AUTH)
			 (COURIER.FETCH (CLEARINGHOUSE . AUTHENTICATOR)
					VERIFIER of AUTH)
			 (
QUOTE
 RETURNERRORS])

(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)                                         (* bvm: "23-Aug-84 15:10")

    (
\INTERNAL/GETPASSWORD
 HOST T NIL MSG NIL (
QUOTE
 NS])

(NS.AUTHENTICATE

  [LAMBDA (SIMPLE.CREDENTIALS)                               (* bvm: "15-Aug-84 16:00")


          (* * Checks SIMPLE.CREDENTIALS -- For convenience, if SIMPLE.CREDENTIALS is not a list, creates credentials from 

	  the login for NS::)



    [
OR
 (
LISTP
 SIMPLE.CREDENTIALS)
	  (
SETQ
 SIMPLE.CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS
 (
\INTERNAL/GETPASSWORD

								     (
QUOTE
 NS::)
								     SIMPLE.CREDENTIALS]
    (
PROG
 ((ADDR (\AUTHENTICATION.FIND.SERVER
))
	     RESULT)
	    (
RETURN
 (
COND

			((
NULL
 ADDR)
			  (
QUOTE
 AllDown))
			(T (
SETQ
 RESULT (
COURIER.CALL
 ADDR (
QUOTE
 AUTHENTICATION)
							  (
QUOTE
 CHECK.SIMPLE.CREDENTIALS)
							  (
CAR
 SIMPLE.CREDENTIALS)
							  (
CDR
 SIMPLE.CREDENTIALS)
							  (
QUOTE
 RETURNERRORS)))
			   (
COND

			     ((
LISTP
 RESULT)
			       (
CADDR
 RESULT))
			     (RESULT)
			     (T (
QUOTE
 CredentialsInvalid])

(NS.MAKE.SIMPLE.CREDENTIALS

  [LAMBDA (NAME/PASS)                                        (* bvm: "15-Aug-84 15:30")

    (
CONS
 (COURIER.CREATE (AUTHENTICATION . CREDENTIALS)
			    TYPE _(
QUOTE
 SIMPLE)
			    VALUE _(
COURIER.WRITE.REP
 (PARSE.NSNAME
 (
CAR
 NAME/PASS))
							(
QUOTE
 AUTHENTICATION)
							(
QUOTE
 SIMPLE.CREDENTIALS)))
	    (
COURIER.WRITE.REP
 (HASH.PASSWORD
 (
CDR
 NAME/PASS))
				 (
QUOTE
 AUTHENTICATION)
				 (
QUOTE
 SIMPLE.VERIFIER])

(\AUTHENTICATION.FIND.SERVER

  [LAMBDA NIL                                                (* bvm: " 1-Jul-84 15:26")

                                                             (* Expanding ring broadcast, as defined in 

							     Clearinghouse Protocol spec.)

    (
PROG
 (INFO)
	    (
RETURN
 (
COND

			[(
AND
 \AUTHENTICATION.SERVER.CACHE
				(find
 ADDR in
 \AUTHENTICATION.SERVER.CACHE
				   suchthat
 (
SELECTQ
 [
CAR
 (
LISTP
 (
COURIER.EXPEDITED.CALL

									   ADDR 
									   \AUTHENTICATION.SOCKET
									   (
QUOTE
 AUTHENTICATION)
									   (
QUOTE
 
									    BROADCAST.FOR.SERVERS)
									   (
QUOTE
 RETURNERRORS]
							 ((NIL ERROR REJECT)
							   NIL)
							 T]
			((
SETQ
 INFO (
COURIER.BROADCAST.CALL
 \AUTHENTICATION.SOCKET (
QUOTE

								  AUTHENTICATION)
								(
QUOTE
 BROADCAST.FOR.SERVERS)
								NIL NIL AUTHENTICATION.NET.HINT 
								"Authentication servers"))
			  (
SETQ
 \AUTHENTICATION.SERVER.CACHE (
APPEND
 INFO 
								     \AUTHENTICATION.SERVER.CACHE))
			  (
CAR
 INFO])
)



(* Clearinghouse Protocol)


(COURIERPROGRAM CLEARINGHOUSE (2 3)
    TYPES
      [(ORGANIZATION STRING)
       (DOMAIN STRING)
       (OBJECT STRING)
       (ORGANIZATION.NAME ORGANIZATION)
       (DOMAIN.NAME NSNAME2)
       (OBJECT.NAME NSNAME)
       (NAME NSNAME)
       (ORGANIZATION.NAME.PATTERN ORGANIZATION)
       (DOMAIN.NAME.PATTERN NSNAME2)
       (OBJECT.NAME.PATTERN NSNAME)
       (PROPERTY LONGCARDINAL)
       (PROPERTIES (SEQUENCE PROPERTY))
       (ITEM (SEQUENCE UNSPECIFIED))
       (NETWORK.ADDRESS NSADDRESS)
       (NETWORK.ADDRESS.LIST (SEQUENCE NETWORK.ADDRESS))
       [AUTHENTICATOR (RECORD (CREDENTIALS (AUTHENTICATION . CREDENTIALS))
                             (VERIFIER (AUTHENTICATION . VERIFIER]
       [MAILBOX.VALUES (RECORD (TIME TIME)
                              (MAIL.SERVICE (SEQUENCE NAME]
       (USERDATA.VALUE (RECORD (LAST.NAME.INDEX CARDINAL)
                              (FILE.SERVICE NAME)))
       (WHICH.ARGUMENT (ENUMERATION (FIRST 1)
                              (SECOND 2)))
       (ARGUMENT.PROBLEM (ENUMERATION (IllegalProperty 10)
                                (IllegalOrganization 11)
                                (IllegalDomain 12)
                                (IllegalObject 13)
                                (NoSuchOrganization 14)
                                (NoSuchDomain 15)
                                (NoSuchObject 16)))
       (CALL.PROBLEM (ENUMERATION (AccessRightsInsufficient 1)
                            (TooBusy 2)
                            (ServerDown 3)
                            (USE.COURIER 4)
                            (Other 5)))
       (PROPERTY.PROBLEM (ENUMERATION (Missing 20)
                                (WrongType 21)))
       (UPDATE.PROBLEM (ENUMERATION (NoChange 30)
                              (OutOfDate 31)
                              (ObjectOverflow 32)
                              (DatabaseOverflow 33]
    PROCEDURES
      ((RETRIEVE.ADDRESSES 0 NIL RETURNS (NETWORK.ADDRESS.LIST)
              REPORTS
              (CALL.ERROR))
       (LIST.DOMAINS.SERVED 1 (BULK.DATA.SINK AUTHENTICATOR)
              RETURNS NIL REPORTS (CALL.ERROR))
       (CREATE.OBJECT 2 (OBJECT.NAME AUTHENTICATOR)
              RETURNS NIL REPORTS (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR 
                                         WRONG.SERVER))
       (DELETE.OBJECT 3 (OBJECT.NAME AUTHENTICATOR)
              RETURNS NIL REPORTS (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR 
                                         WRONG.SERVER))
       (LOOKUP.OBJECT 4 (OBJECT.NAME.PATTERN AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR CALL.ERROR WRONG.SERVER))
       (LIST.ORGANIZATIONS 5 (ORGANIZATION.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
              RETURNS NIL REPORTS (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER))
       (LIST.DOMAINS 6 (DOMAIN.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
              RETURNS NIL REPORTS (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER))
       (LIST.OBJECTS 7 (OBJECT.NAME.PATTERN PROPERTY BULK.DATA.SINK AUTHENTICATOR)
              RETURNS NIL REPORTS (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER))
       (LIST.ALIASES 8 (OBJECT.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
              RETURNS NIL REPORTS (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER))
       (LIST.ALIASES.OF 9 (OBJECT.NAME.PATTERN BULK.DATA.SINK AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER))
       (CREATE.ALIAS 10 (OBJECT.NAME OBJECT.NAME AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR WRONG.SERVER))
       (DELETE.ALIAS 11 (OBJECT.NAME AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR UPDATE.ERROR WRONG.SERVER))
       (ADD.GROUP.PROPERTY 12 (OBJECT.NAME PROPERTY BULK.DATA.SOURCE AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (ADD.ITEM.PROPERTY 13 (OBJECT.NAME PROPERTY ITEM AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (DELETE.PROPERTY 14 (OBJECT.NAME PROPERTY AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (LIST.PROPERTIES 15 (OBJECT.NAME.PATTERN AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME PROPERTIES)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR WRONG.SERVER))
       (RETRIEVE.ITEM 16 (OBJECT.NAME.PATTERN PROPERTY AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME ITEM)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR WRONG.SERVER))
       (CHANGE.ITEM 17 (OBJECT.NAME PROPERTY ITEM AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (RETRIEVE.MEMBERS 18 (OBJECT.NAME.PATTERN PROPERTY BULK.DATA.SINK AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR WRONG.SERVER))
       (ADD.MEMBER 19 (OBJECT.NAME PROPERTY NSNAME AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (ADD.SELF 20 (OBJECT.NAME PROPERTY AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (DELETE.MEMBER 21 (OBJECT.NAME PROPERTY NSNAME AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (DELETE.SELF 22 (OBJECT.NAME PROPERTY AUTHENTICATOR)
              RETURNS
              (OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR UPDATE.ERROR 
                     WRONG.SERVER))
       (IS.MEMBER 23 (OBJECT.NAME.PATTERN PROPERTY PROPERTY NSNAME AUTHENTICATOR)
              RETURNS
              (BOOLEAN OBJECT.NAME)
              REPORTS
              (ARGUMENT.ERROR AUTHENTICATION.ERROR CALL.ERROR PROPERTY.ERROR WRONG.SERVER)))
    ERRORS
      [(CALL.ERROR 1 (CALL.PROBLEM))
       (ARGUMENT.ERROR 2 (ARGUMENT.PROBLEM WHICH.ARGUMENT))
       (PROPERTY.ERROR 3 (PROPERTY.PROBLEM OBJECT.NAME))
       (UPDATE.ERROR 4 (UPDATE.PROBLEM BOOLEAN WHICH.ARGUMENT OBJECT.NAME))
       (WRONG.SERVER 5 (OBJECT.NAME))
       (AUTHENTICATION.ERROR 6 ((AUTHENTICATION . PROBLEM])
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \CH.BROADCAST.SOCKET 20)

(RPAQQ \CH.NULL.PROPERTY -1)

(CONSTANTS (\CH.BROADCAST.SOCKET 20)
       (\CH.NULL.PROPERTY -1))
)

[DECLARE: EVAL@COMPILE 

(ACCESSFNS CHBROADCAST ((CHBROADCASTBODY (fetch (PACKETEXCHANGEXIP PACKETEXCHANGEBODY) of DATUM)))
                       (BLOCKRECORD CHBROADCASTBODY ((LOW.VERSION WORD)
                                                     (HIGH.VERSION WORD)
                                                     (MSGTYPE WORD)
                                                     (ZERO2 WORD)
                                                     (PROGRAM# FIXP)
                                                     (VERSION# WORD)
                                                     (ZERO3 WORD))))

(RECORD DOMAINCACHE (DCDOMAIN DCKNOWNSERVERS DCHINTSERVERS DCCOMPLETE))
]

(SETTEMPLATE (QUOTE CH.PROPERTY)
       (QUOTE (PROP)))

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS LOCAL.CLEARINGHOUSE \CH.CACHE CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION CH.NET.HINT 
       \CH.MAINLOCK NS.SERVER.NAMES.TO.ADDRESSES CLEARINGHOUSE.STRUCTURE.WINDOW CH.PROPERTIES)
)
)

(RPAQ? CH.NET.HINT )

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

(RPAQ? \CH.MAINLOCK (CREATE.MONITORLOCK "Clearinghouse"))

(ADDTOVAR \SYSTEMCACHEVARS LOCAL.CLEARINGHOUSE \CH.CACHE NS.SERVER.NAMES.TO.ADDRESSES)

(ADDTOVAR CH.PROPERTIES (ALL 0)
                        (MEMBERS 3)
                        (ADDRESS.LIST 4)
                        (AUTHENTICATION.KEYS 6)
                        (AUTHENTICATION.LEVEL 8)
                        (MAILPRIMARY 30)
                        (MAILBOXES 31)
                        (MAILBOX.ACCESSCONTROL 32)
                        (SERVICES 51)
                        (FILE.SERVICE 10000)
                        (PRINT.SERVICE 10001)
                        (INTERNET.ROUTING.SERVICE 10002)
                        (USER 10003)
                        (MAIL.SERVICE 10004)
                        (WORKSTATION 10005)
                        (EXTERNAL.COMMUNICATION.SERVICE 10006)
                        (RS232CPORT 10007)
                        (INTERACTIVE.TERMINAL.SERVICE 10008)
                        (GATEWAY.SERVICE 10009)
                        (IBM3270.HOST 10010)
                        (MAIL.GATEWAY 10011)
                        (SIEMENS.9750.HOST 10012)
                        (ADOBE.SERVICE 10013)
                        (LIBRARIAN.SERVICE 10014)
                        (TTX.GATEWAY 10015)
                        (AUTHENTICATION.SERVICE 10016)
                        (REMOTE.BATCH.SERVICE 10017)
                        (NETWORK 10018)
                        (NETWORK.SERVERS 10019)
                        (CIU 10020)
                        (CLEARINGHOUSE.SERVICE 10021)
                        (USERGROUP 10022)
                        (FETCH.SERVICE 10023)
                        (USERDATA 20000)
                        (RS232CDATA 20001)
                        (IBM3270HOSTDATA 20002)
                        (SIEMENS9750HOSTDATA 20003)
                        (CANMAILTO 20005)
                        (MAILGATEWAYROUTEDATA 20006)
                        (FOREIGNMAILSYSTEMNAME 20007)
                        (USERPASSWORD 20101)
                        (FILESERVER 10)
                        (PRINTSERVER 11))



(* Clearinghouse names)

[DECLARE: EVAL@COMPILE 

(DATATYPE NSNAME ((NSOBJECT POINTER)
                  (NSDOMAIN POINTER)
                  (NSORGANIZATION POINTER))                                (* Canonical three-part 
                                                                           Clearinghouse name)
                 )
]
(/DECLAREDATATYPE (QUOTE NSNAME)
       (QUOTE (POINTER POINTER POINTER))
       (QUOTE ((NSNAME 0 POINTER)
               (NSNAME 2 POINTER)
               (NSNAME 4 POINTER)))
       (QUOTE 6))
(DEFPRINT (QUOTE NSNAME)
       (FUNCTION \NSNAME.DEFPRINT))

(PUTPROPS NSNAME COURIERDEF (COURIER.READ.NSNAME COURIER.WRITE.NSNAME COURIER.NSNAME.LENGTH))

(PUTPROPS NSNAME2 COURIERDEF (COURIER.READ.NSNAME COURIER.WRITE.NSNAME))
(DEFINEQ

(\NSNAME.DEFPRINT

  [LAMBDA (NAME STREAM)                                      (* bvm: "28-Jun-84 16:36")

    (
LIST
 (NSNAME.TO.STRING
 NAME])

(NSNAME.TO.STRING

  [LAMBDA (NSNAME FULLNAMEFLG)                               (* bvm: "26-Jul-85 12:41")

    (
PROG
 ([OBJ (ffetch
 NSOBJECT of
 (
SETQ
 NSNAME (
\DTEST
 NSNAME (
QUOTE
 NSNAME]
	     (DOM (ffetch
 NSDOMAIN of
 NSNAME))
	     (ORG (ffetch
 NSORGANIZATION of
 NSNAME))
	     (COLON ":"))
	    (
RETURN
 (
COND

			((
NOT
 OBJ)                         (* Two-part name)

			  (
CONCAT
 DOM COLON ORG))
			((
OR
 FULLNAMEFLG (
NOT
 (
STRING-EQUAL
 ORG CH.DEFAULT.ORGANIZATION)))
                                                             (* No defaults)

			  (
CONCAT
 OBJ COLON DOM COLON ORG))
			(T (
CONCAT
 OBJ COLON (
COND

				       ((
STRING-EQUAL
 DOM CH.DEFAULT.DOMAIN)
					 "")
				       (T DOM])

(COURIER.READ.NSNAME

  [LAMBDA (STREAM PROGRAM TYPE)                              (* bvm: "27-Jun-84 15:41")


          (* * Read a Clearinghouse name: 3 strings, or 2 strings if reading a 2-part name)



    (create
 NSNAME
	      NSORGANIZATION _(
COURIER.READ.STRING
 STREAM)
	      NSDOMAIN _(
COURIER.READ.STRING
 STREAM)
	      NSOBJECT _(
AND
 (
EQ
 TYPE (
QUOTE
 NSNAME))
			       (
COURIER.READ.STRING
 STREAM])

(COURIER.WRITE.NSNAME

  [LAMBDA (STREAM NAME PROGRAM TYPE)                         (* bvm: "27-Jun-84 15:43")

    [
COURIER.WRITE.STRING
 STREAM (ffetch
 NSORGANIZATION of
 (
\DTEST
 NAME (
QUOTE
 NSNAME]
    (
COURIER.WRITE.STRING
 STREAM (ffetch
 NSDOMAIN of
 NAME))
    (
COND

      ((
EQ
 TYPE (
QUOTE
 NSNAME))                          (* full 3-part name)

	(
COURIER.WRITE.STRING
 STREAM (ffetch
 NSOBJECT of
 NAME])

(COURIER.NSNAME.LENGTH

  [LAMBDA (NSNAME PROGRAM TYPE)                              (* bvm: " 3-Jul-84 17:35")

    (
IPLUS
 [
COND

	       ((
EQ
 TYPE (
QUOTE
 NSNAME2))
		 0)
	       (T (
COURIER.REP.LENGTH
 (fetch
 NSOBJECT of
 NSNAME)
					NIL
					(
QUOTE
 STRING]
	     (
COURIER.REP.LENGTH
 (fetch
 NSDOMAIN of
 NSNAME)
				   NIL
				   (
QUOTE
 STRING))
	     (
COURIER.REP.LENGTH
 (fetch
 NSORGANIZATION of
 NSNAME)
				   NIL
				   (
QUOTE
 STRING])
)



(* Finding Clearinghouse)

(DEFINEQ

(GETCLEARINGHOUSE
  [LAMBDA NIL                                                             (* bvm: 
                                                                          "21-Feb-86 14:22")
    (COND
       ((AND CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION LOCAL.CLEARINGHOUSE))
       (T (WITH.MONITOR \CH.MAINLOCK (repeatuntil (SETQ $$VAL (COURIER.BROADCAST.CALL
                                                               \CH.BROADCAST.SOCKET
                                                               (QUOTE CLEARINGHOUSE)
                                                               (QUOTE RETRIEVE.ADDRESSES)
                                                               NIL
                                                               (FUNCTION \CH.CHECK.CLEARINGHOUSE)
                                                               CH.NET.HINT "Clearinghouse servers"])

(\CH.CHECK.CLEARINGHOUSE

  [LAMBDA (ADDRESSES)                                        (* bvm: "15-Aug-84 12:49")

    (
PROG
 ((ADDR (
BESTNSADDRESS
 ADDRESSES T))
	     DOMAINS DEFAULT)
	    (
RETURN
 (
COND

			([
AND
 ADDR (
SETQ
 DOMAINS (CH.DOMAINS.SERVED
 ADDR))
				(find
 old
 DEFAULT in
 DOMAINS
				   suchthat
 (
PROGN
       (* Skip over the stupid ...:...

							     domain)

						       (
NOT
 (
STREQUAL
 (fetch
 NSORGANIZATION
									     of
 DEFAULT)
									  "..."]
			  (
COND

			    ((
OR
 (
NULL
 CH.DEFAULT.DOMAIN)
				   (
NULL
 CH.DEFAULT.ORGANIZATION))
                                                             (* Use the first domain that this server serves to set

							     the default domain and organization.)

                                                             (* Skip over the stupid ...:...

							     domain)

			      (printout PROMPTWINDOW T "[Default Clearinghouse domain set to "
					(
SETQ
 CH.DEFAULT.DOMAIN (fetch
 NSDOMAIN of
 DEFAULT))
					":"
					(
SETQ
 CH.DEFAULT.ORGANIZATION (fetch
 NSORGANIZATION
									   of
 DEFAULT))
					"]")))
			  (\CH.UPDATE.CACHE
 (create
 NSNAME
							NSOBJECT _(
MKSTRING
 ADDR)
							NSDOMAIN _ "CHServers"
							NSORGANIZATION _ "CHServers")
					      ADDR DOMAINS)
			  (
SETQ
 LOCAL.CLEARINGHOUSE ADDR])

(START.CLEARINGHOUSE

  [LAMBDA (RESTARTFLG)                                       (* bvm: "27-Jun-84 10:57")

    (
COND

      ((
OR
 RESTARTFLG (
NULL
 LOCAL.CLEARINGHOUSE))
	(
SETQ
 \NS.ROUTING.TABLE.RADIUS 5)
	(
SETQ
 NS.SERVER.NAMES.TO.ADDRESSES (
SETQ
 \CH.CACHE (
SETQ
 LOCAL.CLEARINGHOUSE NIL)))
	(GETCLEARINGHOUSE
)))
    LOCAL.CLEARINGHOUSE])

(SHOW.CLEARINGHOUSE

  [LAMBDA (ENTIRE.CLEARINGHOUSE? DONT.GRAPH)                 (* bvm: "23-Jun-84 16:11")

    (
PROG
 (SEXPR)
	    [
SETQ
 SEXPR (
CONS
 "" (
COND

				    [ENTIRE.CLEARINGHOUSE? 
                                                             (* Find all domains in all organizations.)

							   (for
 ORG in
 (CH.LIST.ORGANIZATIONS

									     "*")
							      collect
 (
CONS
 ORG
										(CH.LIST.DOMAINS

										  (
CONCAT
 "*:" ORG]
				    (T                       (* Use cached structure.)

				       (for
 ORG in
 \CH.CACHE
					  collect
 (
CONS
 (
CAR
 ORG)
							    (for
 DOM in
 (
CDR
 ORG)
							       collect
 (fetch
 DCDOMAIN
									    of
 DOM]
	    (
COND

	      (DONT.GRAPH (
RETURN
 SEXPR)))
	    (
FILESLOAD
 (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
			 GRAPHER)
	    (
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: "26-Jul-85 12:41")

                                                             (* Find a Clearinghouse which serves the specified 

							     domain and return its NS address.

							     If DONTPROBEFLG is T, just search the cache.)

    (
OR
 (type?
 NSNAME DOMAINPATTERN)
	  (
SETQ
 DOMAINPATTERN (PARSE.NSNAME
 DOMAINPATTERN 2)))
    (
PROG
 ((ORGANIZATION (fetch
 NSORGANIZATION of
 DOMAINPATTERN))
	     (DOMAIN (fetch
 NSDOMAIN of
 DOMAINPATTERN))
	     ORGANIZATION.INFO)
	    (
SETQ
 ORGANIZATION.INFO (\CH.FIND.ORG.SERVER
 ORGANIZATION NOERRORFLG DONTPROBEFLG))
	    (
RETURN
 (
COND

			[(for
 DOMAIN.INFO in
 ORGANIZATION.INFO
			    when
 (
STRING-EQUAL
 (fetch
 DCDOMAIN of
 DOMAIN.INFO)
						   DOMAIN)
			    do
 (
RETURN
 (
CAR
 (
CAR
 (fetch
 DCKNOWNSERVERS of
 DOMAIN.INFO]
			(DONTPROBEFLG (
AND
 (
NOT
 NOERRORFLG)
					     (
ERROR
 "Couldn't find Clearinghouse server for domain" 
						      DOMAINPATTERN T)))
			(T 

          (* Ask a clearinghouse in ORGANIZATION to find servers for this domain. For simplicity, assume the first one will 

	  tell us. This should be "Local Clearinghouse" if it serves ORGANIZATION)



			   (\CH.LOCATE.SERVERS
 [
CAR
 (
CAR
 (fetch
 DCKNOWNSERVERS
								  of
 (
CAR
 ORGANIZATION.INFO]
						 (create
 NSNAME
							   NSOBJECT _ DOMAIN
							   NSDOMAIN _ ORGANIZATION
							   NSORGANIZATION _ "CHServers")
						 NOERRORFLG ORGANIZATION DOMAIN)
			   (CH.FINDSERVER
 DOMAINPATTERN NOERRORFLG T])

(\CH.FIND.ORG.SERVER

  [LAMBDA (ORGANIZATION NOERRORFLG DONTPROBEFLG)             (* bvm: "26-Jul-85 12:42")

    (
COND

      [(
CDR
 (find
 ORGINFO in
 \CH.CACHE suchthat
 (
STRING-EQUAL
 (
CAR
 ORGINFO)
									ORGANIZATION]
      (DONTPROBEFLG (
AND
 (
NOT
 NOERRORFLG)
			   (
ERROR
 "Couldn't find Clearinghouse server for organization" 
				    ORGANIZATION T)))
      ((
STRING-EQUAL
 ORGANIZATION "CHServers")             (* Everyone handles this org)

	(GETCLEARINGHOUSE
)
	[
SETQ
 \CH.CACHE (
NCONC1
 \CH.CACHE (
CONS
 ORGANIZATION
						      (
LIST*
 [create
 DOMAINCACHE
									 DCDOMAIN _ ORGANIZATION
									 DCKNOWNSERVERS _(fetch

									   DCKNOWNSERVERS
											    of

											     (
CADR

											       (
CAR

												 
											\CH.CACHE]
							       (for
 ORG in
 \CH.CACHE
								  collect

								   (create
 DOMAINCACHE
									     DCDOMAIN _(
CAR
 ORG)
									     DCKNOWNSERVERS _(fetch

									       DCKNOWNSERVERS
												of

												 (


											     
CADR

												   
											      ORG]
	(\CH.FIND.ORG.SERVER
 ORGANIZATION NOERRORFLG T))
      (T (\CH.LOCATE.SERVERS
 (GETCLEARINGHOUSE
)
			       (create
 NSNAME
					 NSOBJECT _ ORGANIZATION
					 NSDOMAIN _ "CHServers"
					 NSORGANIZATION _ "CHServers")
			       NOERRORFLG ORGANIZATION)
	 (\CH.FIND.ORG.SERVER
 ORGANIZATION NOERRORFLG T])

(\CH.LOCATE.SERVERS

  [LAMBDA (CHSERVER SERVERGROUP NOERRORFLG ORGANIZATION DOMAIN)
                                                             (* bvm: "26-Jul-85 12:42")


          (* * Talks to clearinghouse CHSERVER asking it to enumerate the class of servers SERVERGROUP.

	  We then locate each server and update the cache)



    (
PROG
 (STREAM CHLIST CHNAMES NOROUTE)
	    (\CH.PRINT.BLURB
 "Finding Clearinghouse server for " DOMAIN ORGANIZATION)
	    (
OR
 [
COND

		    ((
SETQ
 STREAM (
COURIER.OPEN
 CHSERVER NIL NOERRORFLG (
QUOTE
 CLEARINGHOUSE)))
		      [
RESETLST
 (
RESETSAVE
 NIL (
LIST
 (
FUNCTION
 \SPP.RESETCLOSE)
							   STREAM))
				  (
COND

				    ((
AND
 (
SETQ
 CHNAMES (CH.RETRIEVE.MEMBERS

						SERVERGROUP
						(CH.PROPERTY
 (
QUOTE
 MEMBERS))
						STREAM))
					    (
NEQ
 (
CAR
 CHNAMES)
						   (
QUOTE
 ERROR)))
				      (
SETQ
 CHLIST (
SORT.NSADDRESSES.BY.DISTANCE

					  (for
 CH in
 CHNAMES bind
 INFO
					     when
 (
SETQ
 INFO (
COURIER.CALL
 STREAM (
QUOTE

										   CLEARINGHOUSE)
										 (
QUOTE
 
										    RETRIEVE.ITEM)
										 CH
										 (CH.PROPERTY

										   (
QUOTE
 
										     ADDRESS.LIST))
										 (

									      CH.GETAUTHENTICATOR
)
										 (
QUOTE
 NOERROR)))
					     collect
 (
LIST
 (
CAR
 (
COURIER.READ.REP

									(
CADR
 INFO)
									(
QUOTE
 CLEARINGHOUSE)
									(
QUOTE
 NETWORK.ADDRESS.LIST)
									))
							       (
CAR
 INFO]

          (* Now have a list of all servers for the desired domain in hop order. Find the first one that's up, and make sure 

	  it serves the domain that the hint claimed. Could update cache with all domains it serves, but then we would be in 

	  danger of picking a distant server we know about in preference to a close server we haven't discovered yet)



		      (for
 PAIR in
 CHLIST bind
 CHDOMAINS DOM
			 when
 [
COND

				  ([
NOT
 (
\LOCATE.NSNET
 (fetch
 NSNET of
 (
CAR
 PAIR]
                                                             (* Give up when we get to inaccessible hosts)

				    (
SETQ
 NOROUTE T)
				    (
RETURN
))
				  ((
SETQ
 CHDOMAINS (CH.DOMAINS.SERVED
 (
CAR
 PAIR)))
				    (for
 old
 DOM in
 CHDOMAINS
				       thereis
 (
AND
 (
OR
 (
NULL
 DOMAIN)
							      (
STRING-EQUAL
 (fetch
 NSDOMAIN
										 of
 DOM)
									      DOMAIN))
							(
STRING-EQUAL
 (fetch
 NSORGANIZATION
									   of
 DOM)
									ORGANIZATION]
			 do
 (\CH.UPDATE.CACHE
 (
CADR
 PAIR)
						  (
CAR
 PAIR)
						  (
LIST
 DOM))
			      (
RETURN
 T]
		  (\CH.PRINT.BLURB
 (
COND

				       ((
EQ
 (
CAR
 CHNAMES)
					      (
QUOTE
 ERROR))
					 "Unknown domain: ")
				       (NOROUTE "No network route to Clearinghouse for ")
				       (T "Unable to contact Clearinghouse for "))
				     DOMAIN ORGANIZATION])

(\CH.PRINT.BLURB

  [LAMBDA (MSG DOMAIN ORGANIZATION)                          (* bvm: "29-Jul-84 22:40")

    (printout PROMPTWINDOW T "[" MSG)
    [
COND

      (DOMAIN (printout PROMPTWINDOW DOMAIN (
QUOTE
 :]
    (printout PROMPTWINDOW ORGANIZATION "]"])

(\CH.UPDATE.CACHE

  [LAMBDA (OBJECT ADDRESS DOMAINS.SERVED)                    (* bvm: "26-Jul-85 12:42")

    (
PROG
 (NAME.AND.ADDRESS ORGANIZATION DOMAINSTRING ORGANIZATION.INFO)
	    (printout PROMPTWINDOW .TAB0 0 "[Noting Clearinghouse " (fetch
 NSOBJECT of
 OBJECT)
		      "]")
	    (
SETQ
 NAME.AND.ADDRESS (
LIST
 ADDRESS OBJECT))
	    [for
 DOMAIN in
 DOMAINS.SERVED
	       do
 (
SETQ
 ORGANIZATION (fetch
 NSORGANIZATION of
 DOMAIN))
		    (
SETQ
 DOMAINSTRING (fetch
 NSDOMAIN of
 DOMAIN))
		    [
COND

		      ([
NOT
 (
SETQ
 ORGANIZATION.INFO (find
 X in
 \CH.CACHE
							   suchthat
 (
STRING-EQUAL
 (
CAR
 X)
										      ORGANIZATION]
			(
SETQ
 \CH.CACHE (
NCONC1
 \CH.CACHE (
SETQ
 ORGANIZATION.INFO (
CONS

							ORGANIZATION]
		    (for
 DOMAIN.INFO in
 (
CDR
 ORGANIZATION.INFO)
		       when
 (
STRING-EQUAL
 (fetch
 DCDOMAIN of
 DOMAIN.INFO)
					      DOMAINSTRING)
		       do
 (push
 (fetch
 DCKNOWNSERVERS of
 DOMAIN.INFO)
				    NAME.AND.ADDRESS)
			    (
RETURN
 (
SORT.NSADDRESSES.BY.DISTANCE
 (fetch
 DCKNOWNSERVERS
									 of
 DOMAIN.INFO)))
		       finally
 (
NCONC1
 ORGANIZATION.INFO (create
 DOMAINCACHE
								       DCDOMAIN _ DOMAINSTRING
								       DCKNOWNSERVERS _(
LIST
 
										 NAME.AND.ADDRESS]
	    (
COND

	      (CLEARINGHOUSE.STRUCTURE.WINDOW (SHOW.CLEARINGHOUSE
])

(EQUAL.CH.NAMES

  [LAMBDA (NAME1 NAME2)                                      (* bvm: "26-Jul-85 12:42")

                                                             (* Check if two Clearinghouse names are the same.)

    (
AND
 (
STRING-EQUAL
 (fetch
 NSOBJECT of
 NAME1)
			   (fetch
 NSOBJECT of
 NAME2))
	   (
STRING-EQUAL
 (fetch
 NSDOMAIN of
 NAME1)
			   (fetch
 NSDOMAIN of
 NAME2))
	   (
STRING-EQUAL
 (fetch
 NSORGANIZATION of
 NAME1)
			   (fetch
 NSORGANIZATION of
 NAME2])

(PARSE.NSNAME

  [LAMBDA (NAME #PARTS DEFAULTDOMAIN)                        (* bvm: " 3-Jul-84 16:26")


          (* * Coerces NAME to a 3-part NS name. If #PARTS is 1 or 2 then interprets NAME as 1 or 2-part name, discarding the

	  object and/or domain name if supplied. 3-part names are objects of type NSNAME -

	  2-part names are objects of type NSNAME with an OBJECT field of NIL -

	  A 1 part name is simply the organization string. -

	  DEFAULTDOMAIN is the default to supply for missing parts, which in turn default to CH.DEFAULT.DOMAIN and 

	  CH.DEFAULT.ORGANIZATION -

	  If NAME is already an NSNAME, returns it or a copy if #PARTS implies coercion.)



    (
COND

      ((type?
 NSNAME NAME)
	(
SELECTQ
 #PARTS
		   ((NIL 3)
		     NAME)
		   (2 (
COND

			((fetch
 NSOBJECT of
 NAME)
			  (create
 NSNAME using
 NAME NSOBJECT _ NIL))
			(T NAME)))
		   (1 (fetch
 NSORGANIZATION of
 NAME))
		   (
LISPERROR
 "ILLEGAL ARG" #PARTS)))
      [[
OR
 (
STRINGP
 NAME)
	     (
AND
 (
NULL
 NAME)
		    (
SETQ
 NAME "*"))
	     (
AND
 (
LITATOM
 NAME)
		    (
SETQ
 NAME (
MKSTRING
 NAME]
	(
PROG
 (FIRSTPART SECONDPART THIRDPART I J)
	        (GETCLEARINGHOUSE
)
	        (
COND

		  [(
SETQ
 I (
STRPOS
 ":" NAME))
		    (
SETQ
 FIRSTPART (
SUBSTRING
 NAME 1 (
SUB1
 I)))
		    (
SETQ
 SECONDPART (
SUBSTRING
 NAME (
ADD1
 I)
						    (
COND

						      ((
SETQ
 J (
STRPOS
 ":" NAME (
ADD1
 I)))
							(
SETQ
 THIRDPART (
SUBSTRING
 NAME
										       (
ADD1
 J)
										       NIL))
							(
SUB1
 J]
		  (T (
SETQ
 FIRSTPART NAME)))
	        (
RETURN
 (
SELECTQ
 #PARTS
				     [(NIL 3)
				       (create
 NSNAME
						 NSOBJECT _ FIRSTPART
						 NSDOMAIN _(
COND

						   (SECONDPART)
						   (DEFAULTDOMAIN (fetch
 NSDOMAIN of
 
										    DEFAULTDOMAIN))
						   (T CH.DEFAULT.DOMAIN))
						 NSORGANIZATION _(
COND

						   (THIRDPART)
						   (DEFAULTDOMAIN (fetch
 NSORGANIZATION
								     of
 DEFAULTDOMAIN))
						   (T CH.DEFAULT.ORGANIZATION]
				     [2 (create
 NSNAME
						  NSDOMAIN _(
OR
 (
AND
 THIRDPART SECONDPART)
								  FIRSTPART)
						  NSORGANIZATION _(
COND

						    (THIRDPART)
						    (SECONDPART)
						    (DEFAULTDOMAIN (fetch
 NSORGANIZATION
								      of
 DEFAULTDOMAIN))
						    (T CH.DEFAULT.ORGANIZATION]
				     (1 (
OR
 THIRDPART SECONDPART FIRSTPART))
				     (
LISPERROR
 "ILLEGAL ARG" #PARTS]
      (T (
LISPERROR
 "ILLEGAL ARG" NAME])

(CH.NAME.TO.STRING

  [LAMBDA (NSNAME FULLNAMEFLG)                               (* bvm: "28-Jun-84 16:37")

                                                             (* Return a string for a Clearinghouse name.

							     Leaves off default components unless FULLNAMEFLG is 

							     set.)

    (NSNAME.TO.STRING
 (
COND

			  ((type?
 NSNAME NSNAME)
			    NSNAME)
			  (T (PARSE.NSNAME
 NSNAME)))
			FULLNAMEFLG])

(CANONICAL.CH.NAME

  [LAMBDA (NAME)                                             (* bvm: "28-Jun-84 16:37")

    (
MKATOM
 (NSNAME.TO.STRING
 (PARSE.NSNAME
 NAME])

(CH.PROPERTY

  [LAMBDA (PROP)                                             (* bvm: "15-Aug-84 15:44")

                                                             (* Return the official Clearinghouse property ID for 

							     the specified property.)

    (
COND

      ((
LITATOM
 PROP)
	(for
 PAIR in
 CH.PROPERTIES when
 (
EQ
 (
CAR
 PAIR)
						    PROP)
	   do
 (
RETURN
 (
CADR
 PAIR)) finally
 (
ERROR
 "Unknown Clearinghouse property" PROP)))
      (T PROP])

(CH.GETAUTHENTICATOR

  [LAMBDA (NONTRIVIAL)                                       (* bvm: " 3-Jul-84 21:51")

    (
COND

      [NONTRIVIAL (
PROG
 [(INFO (
\INTERNAL/GETPASSWORD
 (
QUOTE
 NS::]
		          (
RETURN
 (
COND

				      (INFO (
SETQ
 INFO (NS.MAKE.SIMPLE.CREDENTIALS
 INFO))
					    (COURIER.CREATE (CLEARINGHOUSE . AUTHENTICATOR)
							    CREDENTIALS _(
CAR
 INFO)
							    VERIFIER _(
CDR
 INFO)))
				      (T (
ERROR!
]
      (T (COURIER.CREATE (CLEARINGHOUSE . AUTHENTICATOR)
			 CREDENTIALS _(COURIER.CREATE (AUTHENTICATION . CREDENTIALS)
						      TYPE _(
QUOTE
 SIMPLE)
						      VALUE _ NIL)
			 VERIFIER _(
QUOTE
 (0])
)
(DEFINEQ

(CH.SERVERS

  [LAMBDA NIL                                                (* bvm: " 3-Jul-84 14:10")

                                                             (* Return a list of the names of all Clearinghouse 

							     servers.)

    (
COURIER.CALL
 (GETCLEARINGHOUSE
)
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 RETRIEVE.MEMBERS)
		    (create
 NSNAME
			      NSOBJECT _ "CHServers"
			      NSDOMAIN _ "CHServers"
			      NSORGANIZATION _ "CHServers")
		    (CH.PROPERTY
 (
QUOTE
 MEMBERS))
		    (
QUOTE
 (CLEARINGHOUSE . OBJECT.NAME))
		    (CH.GETAUTHENTICATOR
])

(\CH.GUESS.NEW.PROPERTIES

  [LAMBDA (DOMAIN MINPROPERTYID MAXPROPERTYID)               (* bvm: " 4-Jul-84 14:25")


          (* 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.NSNAME
 DOMAIN 2))
	     OBJECTS)
	    (
SETQ
 PATTERN (create
 NSNAME using
 PATTERN NSOBJECT _ "*"))
	    (
SETQ
 MINPROPERTYID (
OR
 MINPROPERTYID 1))
	    (
SETQ
 MAXPROPERTYID (
OR
 MAXPROPERTYID 25))
	    (
RETURN
 (for
 ID from
 MINPROPERTYID to
 MAXPROPERTYID when
 (
SETQ
 OBJECTS
										 (CH.LIST.OBJECTS

										   PATTERN ID))
			 collect
 (
CONS
 ID OBJECTS])
)



(* Clearinghouse calls)

(DEFINEQ

(CH.DOMAINS.SERVED

  [LAMBDA (CHADDRESS)                                        (* bvm: " 3-Jul-84 14:12")


          (* 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.)



    (
CAR
 (
NLSETQ
 (
COURIER.CALL
 CHADDRESS (
QUOTE
 CLEARINGHOUSE)
				     (
QUOTE
 LIST.DOMAINS.SERVED)
				     (
QUOTE
 (CLEARINGHOUSE . DOMAIN.NAME))
				     (CH.GETAUTHENTICATOR
])

(CH.CREATE.OBJECT

  [LAMBDA (OBJECTNAME STREAM)                                (* jwo: " 8-Jul-85 14:13")


          (* * Creates an object with given name, no properties)



    (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME))
    (
OR
 (
COURIER.CALL
 (
OR
 STREAM (CH.FINDSERVER
 OBJECTNAME))
			  (
QUOTE
 CLEARINGHOUSE)
			  (
QUOTE
 CREATE.OBJECT)
			  OBJECTNAME
			  (CH.GETAUTHENTICATOR
 T)
			  (
QUOTE
 RETURNERRORS))
	  OBJECTNAME])

(CH.DELETE.OBJECT

  [LAMBDA (OBJECTNAME STREAM)                                (* jwo: " 8-Jul-85 14:06")


          (* * Deletes specified object from Clearinghouse database)



    (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME))
    (
OR
 (
COURIER.CALL
 (
OR
 STREAM (CH.FINDSERVER
 OBJECTNAME))
			  (
QUOTE
 CLEARINGHOUSE)
			  (
QUOTE
 DELETE.OBJECT)
			  OBJECTNAME
			  (CH.GETAUTHENTICATOR
 T)
			  (
QUOTE
 RETURNERRORS))
	  OBJECTNAME])

(CH.CANONICAL.NAME

  [LAMBDA (NAME)                                             (* bvm: " 4-Jul-84 14:46")


          (* * Canonicalizes name, unless it is a pattern. Result is a standard 3-part name. Name is not required to be a 

	  valid Clearinghouse name, but if it is, it is dereferenced to its distinguished name)



    (
PROG
 ((PARSED (PARSE.NSNAME
 NAME)))
	    (
RETURN
 (
OR
 (
AND
 (
NOT
 (
STRPOS
 (
QUOTE
 *)
						    NAME))
				   (CH.LOOKUP.OBJECT
 PARSED))
			    PARSED])

(CH.CREATE.ALIAS

  [LAMBDA (ALIAS OBJECTNAME)                                 (* jwo: "10-Jun-85 21:02")


          (* * Makes ALIAS be an alias of OBJECTNAME in the Clearinghouse database)



    (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME)))
			      \CH.BROADCAST.SOCKET
			      (
QUOTE
 CLEARINGHOUSE)
			      (
QUOTE
 CREATE.ALIAS)
			      (PARSE.NSNAME
 ALIAS)
			      OBJECTNAME
			      (CH.GETAUTHENTICATOR
 T)
			      (
QUOTE
 RETURNERRORS])

(CH.DELETE.ALIAS

  [LAMBDA (ALIAS)                                            (* jwo: "10-Jun-85 21:03")


          (* * Deletes specified alias from Clearinghouse database)



    (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 ALIAS (PARSE.NSNAME
 ALIAS)))
			      \CH.BROADCAST.SOCKET
			      (
QUOTE
 CLEARINGHOUSE)
			      (
QUOTE
 DELETE.ALIAS)
			      ALIAS
			      (CH.GETAUTHENTICATOR
 T)
			      (
QUOTE
 RETURNERRORS])

(CH.LOOKUP.OBJECT

  [LAMBDA (OBJECTPATTERN)                                    (* bvm: "28-Jun-84 16:37")


          (* * Returns the canonical name of the specified object. If object contains wildcards, result is the first match)



    (
SETQ
 OBJECTPATTERN (PARSE.NSNAME
 OBJECTPATTERN))
    (
PROG
 ((ADDRESS (CH.FINDSERVER
 OBJECTPATTERN T)))
	    (
RETURN
 (
AND
 ADDRESS (
COURIER.EXPEDITED.CALL
 ADDRESS \CH.BROADCAST.SOCKET
							       (
QUOTE
 CLEARINGHOUSE)
							       (
QUOTE
 LOOKUP.OBJECT)
							       OBJECTPATTERN
							       (CH.GETAUTHENTICATOR
)
							       (
QUOTE
 NOERROR])

(CH.DELETE.PROPERTY

  [LAMBDA (OBJECTNAME PROPERTY)                              (* jwo: "10-Jun-85 21:04")

    (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME)))
			      \CH.BROADCAST.SOCKET
			      (
QUOTE
 CLEARINGHOUSE)
			      (
QUOTE
 DELETE.PROPERTY)
			      OBJECTNAME
			      (
OR
 (
FIXP
 PROPERTY)
				    (CH.PROPERTY
 PROPERTY))
			      (CH.GETAUTHENTICATOR
 T)
			      (
QUOTE
 RETURNERRORS])

(LOOKUP.NS.SERVER

  [LAMBDA (NAME TYPE FULLFLG)                                (* bvm: "14-Sep-84 18:08")

                                                             (* Return the NS address of the specified server.

							     If a type is given, use the Clearinghouse if the 

							     address isn't in the cache.)

    (
SETQ
 NAME (PARSE.NSNAME
 NAME))
    (
PROG
 (ADDRESSES NAME&VALUE ENTRY)
	    (
COND

	      ((find
 old
 ENTRY in
 NS.SERVER.NAMES.TO.ADDRESSES suchthat
 (EQUAL.CH.NAMES

										  (
CAR
 ENTRY)
										  NAME)))
	      [[
SETQ
 NAME&VALUE (
COND

		    (TYPE (CH.RETRIEVE.ITEM
 NAME TYPE (
QUOTE
 NETWORK.ADDRESS)))
		    (T (CH.RETRIEVE.ITEM
 NAME (CH.PROPERTY
 (
QUOTE
 ADDRESS.LIST))
					   (
QUOTE
 NETWORK.ADDRESS.LIST]
		(push
 NS.SERVER.NAMES.TO.ADDRESSES (
SETQ
 ENTRY
			  (
CONS
 (
CAR
 NAME&VALUE)
				  (
SETQ
 ADDRESSES (
COND

				      (TYPE                  (* Old way)

					    (replace
 NSSOCKET of
 (
CADR
 NAME&VALUE)
					       with
 0)     (* Stupidity. Old clearinghouses sometimes give a 

							     nonzero socket here. Why?)

					    (
LIST
 (
CADR
 NAME&VALUE)))
				      (T (
CADR
 NAME&VALUE]
	      (T (
RETURN
)))
	    (
RETURN
 (
COND

			(FULLFLG ENTRY)
			(T (
CADR
 ENTRY])

(\CANONICAL.NSHOSTNAME

  [LAMBDA (HOST)                                             (* bvm: " 5-Feb-85 18:37")

    (
PROG
 [(INFO (
OR
 (LOOKUP.NS.SERVER
 HOST NIL T)
			 (LOOKUP.NS.SERVER
 HOST (
QUOTE
 FILESERVER)
					     T]
	    (
RETURN
 (
AND
 INFO (
MKATOM
 (NSNAME.TO.STRING
 (
CAR
 INFO)
								T])
)
(DEFINEQ

(CH.LIST.ALIASES

  [LAMBDA (OBJECTNAMEPATTERN)                                (* bvm: " 3-Jul-84 21:58")

    (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTNAMEPATTERN (PARSE.NSNAME
 OBJECTNAMEPATTERN)))
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 LIST.ALIASES)
		    OBJECTNAMEPATTERN
		    (
QUOTE
 (CLEARINGHOUSE . OBJECT))
		    (CH.GETAUTHENTICATOR
])

(CH.LIST.ALIASES.OF

  [LAMBDA (OBJECTPATTERN)                                    (* lmm "12-Jun-85 10:26")

    (LET [(VAL (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTPATTERN (PARSE.NSNAME
 OBJECTPATTERN)))
			       (
QUOTE
 CLEARINGHOUSE)
			       (
QUOTE
 LIST.ALIASES.OF)
			       OBJECTPATTERN
			       (
QUOTE
 (CLEARINGHOUSE . OBJECT.NAME))
			       (CH.GETAUTHENTICATOR
)
			       (
QUOTE
 RETURNERRORS]
         (
AND
 (
NEQ
 (
CAR
 VAL)
		       (
QUOTE
 ERROR))
		VAL])

(CH.LIST.DOMAINS

  [LAMBDA (DOMAINPATTERN)                                    (* bvm: " 3-Jul-84 14:33")

    (
SETQ
 DOMAINPATTERN (PARSE.NSNAME
 DOMAINPATTERN 2))
    (
COURIER.CALL
 [
CAR
 (
CAR
 (fetch
 DCKNOWNSERVERS of
 (
CAR
 (\CH.FIND.ORG.SERVER

									(FETCH
 NSORGANIZATION
									   OF
 DOMAINPATTERN)
									T]
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 LIST.DOMAINS)
		    DOMAINPATTERN
		    (
QUOTE
 (CLEARINGHOUSE . DOMAIN))
		    (CH.GETAUTHENTICATOR
)
		    (
QUOTE
 NOERROR])

(CH.LIST.ORGANIZATIONS

  [LAMBDA (ORGANIZATIONPATTERN)                              (* bvm: " 3-Jul-84 14:14")

    (
COURIER.CALL
 (GETCLEARINGHOUSE
)
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 LIST.ORGANIZATIONS)
		    (PARSE.NSNAME
 ORGANIZATIONPATTERN 1)
		    (
QUOTE
 (CLEARINGHOUSE . ORGANIZATION))
		    (CH.GETAUTHENTICATOR
])

(CH.LIST.OBJECTS

  [LAMBDA (OBJECTPATTERN PROPERTY)                           (* bvm: " 3-Jul-84 14:17")

    (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTPATTERN (PARSE.NSNAME
 OBJECTPATTERN))
				     T)
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 LIST.OBJECTS)
		    OBJECTPATTERN
		    (CH.PROPERTY
 (
OR
 PROPERTY (
QUOTE
 ALL)))
		    (
QUOTE
 (CLEARINGHOUSE . OBJECT))
		    (CH.GETAUTHENTICATOR
)
		    (
QUOTE
 NOERROR])

(CH.LIST.PROPERTIES

  [LAMBDA (OBJECTNAMEPATTERN)                                (* jwo: "13-Jun-85 14:39")

    (
PROG
 [(RESULT (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTNAMEPATTERN
								  (PARSE.NSNAME
 OBJECTNAMEPATTERN)))
					       \CH.BROADCAST.SOCKET
					       (
QUOTE
 CLEARINGHOUSE)
					       (
QUOTE
 LIST.PROPERTIES)
					       OBJECTNAMEPATTERN
					       (CH.GETAUTHENTICATOR
]
	    (
RETURN
 RESULT])
)
(DEFINEQ

(CH.ADD.GROUP.PROPERTY

  [LAMBDA (OBJECTNAME PROPERTY MEMBERS)                      (* jwo: "10-Jun-85 21:05")

    (
SETQ
 MEMBERS (for
 X in
 MEMBERS collect
 (CH.CANONICAL.NAME
 X)))
    (
COURIER.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME)))
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 ADD.GROUP.PROPERTY)
		    OBJECTNAME
		    (
OR
 (
FIXP
 PROPERTY)
			  (CH.PROPERTY
 PROPERTY))
		    [
FUNCTION
 (LAMBDA (DATASTREAM)         (* Function to write the membership onto the bulk data

							     stream)

			(
COURIER.WRITE.BULKDATA
 DATASTREAM MEMBERS NIL (
QUOTE
 NSNAME]
		    (CH.GETAUTHENTICATOR
 T)
		    (
QUOTE
 RETURNERRORS])

(CH.ADD.MEMBER

  [LAMBDA (GROUPNAME PROPERTY NEWMEMBER)                     (* jwo: "10-Jun-85 20:59")

    (
SETQ
 NEWMEMBER (CH.CANONICAL.NAME
 NEWMEMBER))
    (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 GROUPNAME (PARSE.NSNAME
 GROUPNAME)))
			      \CH.BROADCAST.SOCKET
			      (
QUOTE
 CLEARINGHOUSE)
			      (
QUOTE
 ADD.MEMBER)
			      GROUPNAME
			      (
OR
 (
FIXP
 PROPERTY)
				    (CH.PROPERTY
 PROPERTY))
			      NEWMEMBER
			      (CH.GETAUTHENTICATOR
 T)
			      (
QUOTE
 RETURNERRORS])

(CH.RETRIEVE.MEMBERS
  [LAMBDA (OBJECTPATTERN PROPERTY STREAM)                                 (* bvm: 
                                                                          "21-Feb-86 14:33")
    (SETQ OBJECTPATTERN (PARSE.NSNAME OBJECTPATTERN))
    (COURIER.CALL (OR STREAM (CH.FINDSERVER OBJECTPATTERN))
           (QUOTE CLEARINGHOUSE)
           (QUOTE RETRIEVE.MEMBERS)
           OBJECTPATTERN
           [COND
              (PROPERTY (OR (FIXP PROPERTY)
                            (CH.PROPERTY PROPERTY)))
              (T (CH.PROPERTY (QUOTE MEMBERS]
           (QUOTE (CLEARINGHOUSE . OBJECT.NAME))
           (CH.GETAUTHENTICATOR)
           (QUOTE RETURNERRORS])

(CH.DELETE.MEMBER

  [LAMBDA (GROUPNAME PROPERTY OLDMEMBER)                     (* jwo: "10-Jun-85 20:58")

    (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 GROUPNAME (PARSE.NSNAME
 GROUPNAME)))
			      \CH.BROADCAST.SOCKET
			      (
QUOTE
 CLEARINGHOUSE)
			      (
QUOTE
 DELETE.MEMBER)
			      GROUPNAME
			      (
OR
 (
FIXP
 PROPERTY)
				    (CH.PROPERTY
 PROPERTY))
			      (PARSE.NSNAME
 OLDMEMBER)
			      (CH.GETAUTHENTICATOR
 T])

(CH.ISMEMBER

  [LAMBDA (GROUPNAME PROPERTY SECONDARYPROPERTY NAME)        (* bvm: " 4-Jul-84 14:21")

    (
CAR
 (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 GROUPNAME (PARSE.NSNAME
 GROUPNAME)))
				     \CH.BROADCAST.SOCKET
				     (
QUOTE
 CLEARINGHOUSE)
				     (
QUOTE
 IS.MEMBER)
				     GROUPNAME
				     (
OR
 (
FIXP
 PROPERTY)
					   (CH.PROPERTY
 PROPERTY))
				     (
COND

				       ((
NULL
 SECONDARYPROPERTY)
					 \CH.NULL.PROPERTY)
				       ((
FIXP
 SECONDARYPROPERTY))
				       (T (CH.PROPERTY
 SECONDARYPROPERTY)))
				     (PARSE.NSNAME
 NAME)
				     (CH.GETAUTHENTICATOR
)
				     (
QUOTE
 RETURNERRORS])
)
(DEFINEQ

(CH.RETRIEVE.ITEM

  [LAMBDA (OBJECTPATTERN PROPERTY INTERPRETATION)            (* bvm: "28-Jun-84 16:37")


          (* * Retrieves item property PROPERTY of object OBJECTPATTERN, returning (CanonicalName Value); If INTERPRETATION 

	  is given, then Value is interpreted via it, otherwise Value is just a SEQUENCE of UNSPECIFIED)



    (
SETQ
 OBJECTPATTERN (PARSE.NSNAME
 OBJECTPATTERN))
    (
PROG
 ((ADDRESS (CH.FINDSERVER
 OBJECTPATTERN T))
	     NAME&VALUE)
	    [
COND

	      ((
AND
 ADDRESS (
SETQ
 NAME&VALUE (
COURIER.EXPEDITED.CALL
 ADDRESS 
									   \CH.BROADCAST.SOCKET
									   (
QUOTE
 CLEARINGHOUSE)
									   (
QUOTE
 RETRIEVE.ITEM)
									   OBJECTPATTERN
									   (CH.PROPERTY
 PROPERTY)
									   (CH.GETAUTHENTICATOR
)
									   (
QUOTE
 NOERROR)))
		      INTERPRETATION)
		(
RPLACA
 (
CDR
 NAME&VALUE)
			  (
COURIER.READ.REP
 (
CADR
 NAME&VALUE)
					      (
QUOTE
 CLEARINGHOUSE)
					      INTERPRETATION]
	    (
RETURN
 NAME&VALUE])

(CH.ADD.ITEM.PROPERTY

  [LAMBDA (OBJECTNAME PROPERTY VALUE INTERPRETATION STREAM)
                                                             (* lmm " 9-Jan-86 02:12")

    (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME))
    (
COURIER.CALL
 (
OR
 STREAM (CH.FINDSERVER
 OBJECTNAME))
		    (
QUOTE
 CLEARINGHOUSE)
		    (
QUOTE
 ADD.ITEM.PROPERTY)
		    OBJECTNAME
		    (
OR
 (
FIXP
 PROPERTY)
			  (CH.PROPERTY
 PROPERTY))
		    (
COND

		      (INTERPRETATION (
COURIER.WRITE.REP
 VALUE (
QUOTE
 CLEARINGHOUSE)
							   INTERPRETATION))
		      (T VALUE))
		    (CH.GETAUTHENTICATOR
 T)
		    (
QUOTE
 RETURNERRORS])

(CH.CHANGE.ITEM

  [LAMBDA (OBJECTNAME PROPERTY NEWVALUE INTERPRETATION)      (* jwo: "10-Jun-85 21:07")

    (
COURIER.EXPEDITED.CALL
 (CH.FINDSERVER
 (
SETQ
 OBJECTNAME (PARSE.NSNAME
 OBJECTNAME)))
			      \CH.BROADCAST.SOCKET
			      (
QUOTE
 CLEARINGHOUSE)
			      (
QUOTE
 CHANGE.ITEM)
			      OBJECTNAME
			      (
OR
 (
FIXP
 PROPERTY)
				    (CH.PROPERTY
 PROPERTY))
			      (
COND

				(INTERPRETATION (
COURIER.WRITE.REP
 NEWVALUE NIL INTERPRETATION))
				(T NEWVALUE))
			      (CH.GETAUTHENTICATOR
 T)
			      (
QUOTE
 RETURNERRORS])
)

(RPAQQ AS.WELL.KNOWN.NAME "Authentication Service:CHServers:CHServers")
(PUTPROPS CLEARINGHOUSE COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (16223 31046 (AS.CHANGE.PASSWORDS 16233 . 17574) (AS.CREATE.PASSWORDS 17576 . 18967) (
AS.DELETE.PASSWORDS 18969 . 20028) (AS.MAKE.CONVERSATION 20030 . 21350) (AS.NEXT.VERIFIER 21352 . 
22580) (CH.ADD.MEMBER.TO.DOMAIN.ACL 22582 . 23263) (CH.ADD.MEMBER.TO.PROPERTY.ACL 23265 . 23913) (
CH.ADD.SELF 23915 . 24353) (CH.DELETE.MEMBER.FROM.DOMAIN.ACL 24355 . 25046) (CH.DELETE.SELF 25048 . 
25492) (CH.IS.IN.DOMAIN.ACL 25494 . 26103) (CH.NUMBER.TO.PROPERTY 26105 . 26369) (
CH.RETRIEVE.DOMAIN.ACL 26371 . 26945) (CH.RETRIEVE.PROPERTY.ACL 26947 . 27593) (HASH.PASSWORD 27595 . 
28291) (NSLOGIN 28293 . 28463) (NS.AUTHENTICATE 28465 . 29440) (NS.MAKE.SIMPLE.CREDENTIALS 29442 . 
29942) (\AUTHENTICATION.FIND.SERVER 29944 . 31044)) (42907 45294 (\NSNAME.DEFPRINT 42917 . 43073) (
NSNAME.TO.STRING 43075 . 43863) (COURIER.READ.NSNAME 43865 . 44312) (COURIER.WRITE.NSNAME 44314 . 
44783) (COURIER.NSNAME.LENGTH 44785 . 45292)) (45325 62299 (GETCLEARINGHOUSE 45335 . 46226) (
\CH.CHECK.CLEARINGHOUSE 46228 . 47644) (START.CLEARINGHOUSE 47646 . 48022) (SHOW.CLEARINGHOUSE 48024
 . 49426) (CH.FINDSERVER 49428 . 51098) (\CH.FIND.ORG.SERVER 51100 . 52580) (\CH.LOCATE.SERVERS 52582
 . 55599) (\CH.PRINT.BLURB 55601 . 55869) (\CH.UPDATE.CACHE 55871 . 57332) (EQUAL.CH.NAMES 57334 . 
57873) (PARSE.NSNAME 57875 . 60463) (CH.NAME.TO.STRING 60465 . 60916) (CANONICAL.CH.NAME 60918 . 61095
) (CH.PROPERTY 61097 . 61609) (CH.GETAUTHENTICATOR 61611 . 62297)) (62300 63692 (CH.SERVERS 62310 . 
62925) (\CH.GUESS.NEW.PROPERTIES 62927 . 63690)) (63721 69548 (CH.DOMAINS.SERVED 63731 . 64219) (
CH.CREATE.OBJECT 64221 . 64697) (CH.DELETE.OBJECT 64699 . 65179) (CH.CANONICAL.NAME 65181 . 65707) (
CH.CREATE.ALIAS 65709 . 66241) (CH.DELETE.ALIAS 66243 . 66710) (CH.LOOKUP.OBJECT 66712 . 67354) (
CH.DELETE.PROPERTY 67356 . 67842) (LOOKUP.NS.SERVER 67844 . 69204) (\CANONICAL.NSHOSTNAME 69206 . 
69546)) (69549 72320 (CH.LIST.ALIASES 69559 . 69942) (CH.LIST.ALIASES.OF 69944 . 70467) (
CH.LIST.DOMAINS 70469 . 71018) (CH.LIST.ORGANIZATIONS 71020 . 71381) (CH.LIST.OBJECTS 71383 . 71849) (
CH.LIST.PROPERTIES 71851 . 72318)) (72321 75467 (CH.ADD.GROUP.PROPERTY 72331 . 73055) (CH.ADD.MEMBER 
73057 . 73608) (CH.RETRIEVE.MEMBERS 73610 . 74289) (CH.DELETE.MEMBER 74291 . 74774) (CH.ISMEMBER 74776
 . 75465)) (75468 77766 (CH.RETRIEVE.ITEM 75478 . 76512) (CH.ADD.ITEM.PROPERTY 76514 . 77174) (
CH.CHANGE.ITEM 77176 . 77764)))))
STOP