(FILECREATED " 8-Apr-86 09:09:30" {ERIS}<LISPUSERS>KOTO>NSTHASIZE.;3 16851
changes to: (FNS NSTHASIZE CONVERT.GV.TO.NS)
(VARS NSTHASIZECOMS)
previous date: " 7-Apr-86 08:55:46" {ERIS}<LISPUSERS>KOTO>NSTHASIZE.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NSTHASIZECOMS)
(RPAQQ NSTHASIZECOMS ((VARS GV.TO.NS.REG)
(FNS CONVERT.GV.TO.NS GV.READFORWARDING READ-GV-NS-MAPPING NSTHASIZE \GETSTRING
\GV.COLLECT.ENTRY \GV.COLLECT.ENTRY.1 \GV.COLLECT.ENTRY.LIST)
(FILES (LOADCOMP)
MAINTAIN)))
(RPAQQ GV.TO.NS.REG ((ZURICHRXCH . "Zurich:RXCH")
(ZTISOFSIEMENS . "ZTISOF:Siemens")
(XSISHQ . "XSISHQ:XSIS-HQ:Xerox")
(XSIS . "XSIS:Xerox")
(XRCC-NS . "XRCC:Xerox")
(WGCERX . "WGC-E:RX")
(WBSTAREA . "WBST Area:Xerox")
(WBST311 . "WBST311:Xerox")
(WBST147 . "WBST147:Xerox")
(WBST129UL . "WBST129UL:Xerox")
(WBST129 . "WBST129:Xerox")
(WBST128 . "WBST128:Xerox")
(WBST114 . "WBST114:Xerox")
(WBST105B . "WBST105b:Xerox")
(WBST105 . "WBST105:Xerox")
(WBST102A . "WBST102a:Xerox")
(VISTA . "Vista:Xerox")
(VEN1RX . "VEN1:RX")
(TSC . "TSC:Xerox")
(TORHO . "TOR HO:XCI")
(TESTLABORPNIDSIEMENS . "Testlabor PN ID:Siemens")
(SUNNYVALE . "Sunnyvale:Xerox")
(SOLNAMORXS . "SOLNA-MO:RXS")
(SHINJUKUMIZUNOFX . "Shinjuku Mizuno:Fuji Xerox")
(SBDRXN . "SBD:RXN")
(SBDERX . "SBD-E:RX")
(SANDIEGOXCSS . "San Diego:XCSS")
(RXHRX . "RXH:RX")
(RXH . "RXH:RX")
(ROCH888 . "ROCH888:Xerox")
(ROCH805 . "ROCH805:Xerox")
(ROCH . "ROCH:Xerox")
(PQANET3 . "PQAnet3:Xerox")
(PQANET2 . "PQAnet2:Xerox")
(PQANET1 . "PQAnet1:Xerox")
(PAVISITORS . "Visitors PA:Xerox Visitors")
(PARC-MES . "PARC-MES:Xerox")
(PARC . "PARC:Xerox")
(PAAREA . "PA Area:Xerox")
(OSSERVICE . "OS Service:Xerox")
(OSDASSOCIATES . "OSD Associates:Xerox")
(OSBUSOUTH . "OSBU South:Xerox")
(OSBURX . "OSBU:RX")
(OSBUNORTH . "OSBU North:Xerox")
(OSBUBAYSHORE . "OSBU Bayshore:Xerox")
(NSC-50 . "NSC-5.0:Xerox")
(NSC . "NSC:Xerox")
(IWAFX . "IWA:Fuji Xerox")
(IHAIL . "IH:AIL")
(HKRXS . "HK:RXS")
(ESXCOST . "ES XC OST:Xerox")
(ESXC16 . "ES XC16:Xerox")
(ESXC15 . "ES XC15:Xerox")
(ESPOORXSF . "Espoo:RXSF")
(ESM4RED . "ES M4 RED:Xerox")
(ESGSDWCO . "ES GSD/WCO:Xerox")
(ESCP8 . "ES CP8:Xerox")
(ESAREA . "ES Area:Xerox")
(ELSEGUNDO . "El Segundo:Xerox")
(EIS . "EIS:Versatec")
(DTSSIEMENS . "DTS:Siemens")
(DLOSNSC . "DlosNSC:Xerox")
(DLOSLV-COMM . "DlosLV-Comm:Xerox")
(DLOSLV . "DlosLV:Xerox")
(DLOSLC . "DlosLC:Xerox")
(DLOSL300 . "DlosL300:Xerox")
(DLOSETRON . "DlosETRON:Xerox")
(DLOSCSS . "DlosCSS:Xerox")
(DLOSCE . "DlosCE:Xerox")
(CINOPS . "CIN OPS:Xerox")
(CB19RXF . "CB19:RXF")
(BUSRX . "BUS:RX")
(BROOKRIVER . "Brookriver:Xerox")
(BRIDGEHOUSERXUK . "Bridge House:RXUK")
(AYLTSDRX . "AYLTSD:RX")
(AYLRX . "AYL:RX")
(ALLAREAS . "All Areas:Xerox")
(TLSIEMENS . "TESTLABOR PN ID:SIEMENS")))
(DEFINEQ
(CONVERT.GV.TO.NS
[LAMBDA (X) (* lmm " 7-Apr-86 16:23")
(COND
((SETQ X (\CHECKNAME X))
(PROG ([REG (MKATOM (U-CASE (CDR X]
NSREG)
(RETURN (if (EQ REG (QUOTE NS))
then (OR (CH.LOOKUP.OBJECT (SUBSTRING (CAR X)
2 -2))
(PROGN (PRINTOUT T "[Unable to check " X
" in clearinghouse, assuming correct]")
(SUBSTRING (CAR X)
2 -2)))
else (OR (SETQ NSREG (ASSOC REG GV.TO.NS.REG))
(RETURN))
(LET (NAME)
(OR [CH.LOOKUP.OBJECT (SETQ NAME (CONCAT (CAR X)
":"
(CDR NSREG]
(PROGN (PRINTOUT T "[Unable to check " NAME
" in clearinghouse, assuming correct]")
NAME])
(GV.READFORWARDING
[LAMBDA (X) (* lmm "19-Nov-85 11:20")
(CDR (ASSOC (QUOTE Forwarding)
(GV.READENTRY X NIL (QUOTE \GV.COLLECT.ENTRY])
(READ-GV-NS-MAPPING
[LAMBDA NIL (* lmm " 4-Apr-86 16:56")
(SETQ GV.TO.NS.REG
(RESETLST
(PROG ((STREAM (OPENSTREAM (QUOTE {INDIGO}<REGISTRAR>GV>GV-NS-MAPPING.TXT)
(QUOTE INPUT)
(QUOTE OLD)))
(RT (COPYREADTABLE (QUOTE ORIG)))
LINES)
RESTART
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
STREAM))
(SETSEPR NIL NIL RT)
(SETBRK (CHARCODE (CR))
NIL RT)
(OR (FFILEPOS "GV-to-NS Mappings:" STREAM 0 NIL NIL T)
(ERROR "Couldn't find string GV-to-NS Mappings in " (FULLNAME STREAM)))
(FILEPOS " " STREAM)
[RETURN
(do (SELCHARQ (BIN STREAM)
(TAB)
(CR (RETURN LINES))
(%. [LET ((LINE (RSTRING STREAM RT)))
(PRINTOUT T LINE T)
(push LINES (LET ((POS (STRPOS " -> " LINE)))
(OR POS (GO BADFORMAT))
(CONS [MKATOM (U-CASE (SUBSTRING LINE 1 (SUB1 POS]
(SUBSTRING LINE (PLUS POS 4)
-1]
(BIN STREAM))
(GO BADFORMAT]
BADFORMAT
(ERROR "bad format on {INDIGO}<Registrar>GV>GV-NS-MAPPING.TXT"])
(NSTHASIZE
[LAMBDA (GVDL NSDL NODELETE) (* lmm " 8-Apr-86 09:03")
(SETQ GVDL (OR (\CHECKNAME GVDL)
(ERROR "Invalid grapevine group" GVDL)))
(SETQ NSDL (OR (CH.LOOKUP.OBJECT NSDL)
(ERROR "Invalid NS distribution list" NSDL)))
(LET (FORWARDING NSADDRESS)
(for X in (CDR (GV.READMEMBERS GVDL))
do (if (OR (COND
((SETQ NSADDRESS (CONVERT.GV.TO.NS X))
(PRINTOUT T X)
T))
(AND (SETQ FORWARDING (GV.READFORWARDING X))
(PROGN (PRINTOUT T X " => " FORWARDING)
(if (CDR FORWARDING)
then (PRINTOUT T " -- more than one address." T)
NIL
else T))
(if [NOT (SETQ NSADDRESS (CONVERT.GV.TO.NS (CAR FORWARDING]
then (PRINTOUT T " not an NS equivalent address." T)
NIL
else T)))
then (PRINTOUT T " => " NSADDRESS "...")
(PROG (VALUE)
LP (if (OR (type? NSNAME (SETQ VALUE (CH.ADD.MEMBER NSDL (QUOTE MEMBERS)
NSADDRESS)))
(MATCH VALUE WITH ('ERROR 'UPDATE.ERROR 'NoChange --)))
then (IF (AND NODELETE (OR (NEQ NODELETE (QUOTE FIRST))
(NLISTP VALUE)))
THEN (PRINTOUT T "ok." T)
ELSE (PRINTOUT T "ok, delete: " (GV.REMOVEMEMBER GVDL X)
T))
elseif (COND
((AND (EQ (CAR VALUE)
(QUOTE ERROR))
(SELECTQ (CAR (CDR VALUE))
(CALL.ERROR (SELECTQ (CADDR VALUE)
(TooBusy (PRINTOUT T " error:"
VALUE
" ... retrying"
" ..."))
(AccessRightsInsufficient
(PRINTOUT T " error:" VALUE
" will not move..." T
)
(RETURN))
(HELP VALUE))
(GO LP))
(HELP VALUE)))
T))
then (TERPRI T)
NIL
else (HELP VALUE])
(\GETSTRING
[LAMBDA (STREAM LENGTH) (* lmm "19-Nov-85 10:21")
(COND
((IGREATERP LENGTH \MAXGVSTRING)
(ERROR "stream must be confused - string too long" LENGTH))
(T (LET ((STRING (ALLOCSTRING LENGTH)))
(AIN STRING 1 LENGTH STREAM)
(COND
((ODDP LENGTH)
(BIN STREAM)))
STRING])
(\GV.COLLECT.ENTRY
[LAMBDA (INSTREAM) (* lmm " 4-Apr-86 16:53")
(* * Called by GV.READENTRY to parse and display some of what Grapevine sends
back as "the entire database entry" for NAME.
The contents are different for groups, individuals, and dead folk)
(LET (NAMETYPE (RESULTS))
(\RECEIVESTAMP INSTREAM T) (* Skip stamp)
(BIN16 INSTREAM) (* Skip component count)
(* First component is the "prefix" ,
which contains, among other things,
the name's type and its "official"
name)
(BIN16 INSTREAM) (* Length of this component)
(\RECEIVESTAMP INSTREAM T) (* Skip stamp)
(SETQ NAMETYPE (BIN16 INSTREAM))
(\RECEIVERNAME INSTREAM)
(SELECTC NAMETYPE
(\NAMETYPE.INDIVIDUAL
(\SKIPCOMPONENT INSTREAM) (* Skip password)
(SETQ RESULTS (\GV.COLLECT.ENTRY.1 INSTREAM (QUOTE ConnectSite)
RESULTS))
(SETQ RESULTS (\GV.COLLECT.ENTRY.LIST INSTREAM (QUOTE Forwarding)
RESULTS))
(SETQ RESULTS (\GV.COLLECT.ENTRY.LIST INSTREAM (QUOTE MailboxSites)
RESULTS)))
(\NAMETYPE.GROUP
(\GV.COLLECT.ENTRY.1 INSTREAM (QUOTE Remark)
RESULTS)
(\MT.SKIPSTRINGLIST INSTREAM)
(\SKIPCOMPONENT INSTREAM) (* Skip stamp list)
(\SKIPCOMPONENT INSTREAM) (* Skip DelMembers)
(\SKIPCOMPONENT INSTREAM) (* Skip stamp list)
(PROGN (* owners)
(\MT.SKIPSTRINGLIST INSTREAM)
(\SKIPCOMPONENT INSTREAM)
(\SKIPCOMPONENT INSTREAM)
(\SKIPCOMPONENT INSTREAM))
(PROGN (* friends)
(\MT.SKIPSTRINGLIST INSTREAM)
(\SKIPCOMPONENT INSTREAM)
(\SKIPCOMPONENT INSTREAM)
(\SKIPCOMPONENT INSTREAM))
(QUOTE ((GROUP . T))))
(\NAMETYPE.DEAD
(QUOTE ((DEAD . T))))
NIL])
(\GV.COLLECT.ENTRY.1
[LAMBDA (INSTREAM HEADING RESULTS) (* lmm " 2-Apr-86 12:51")
(COND
((EQ (BIN16 INSTREAM)
0)
RESULTS)
(T (CONS (CONS HEADING (LET [(STRLEN (PROGN (\RECEIVESTAMP INSTREAM T)
(* Skip stamp)
(BIN16 INSTREAM]
(LET ((STRING (ALLOCSTRING STRLEN)))
(AIN STRING 1 STRLEN INSTREAM)
(COND
((ODDP STRLEN)
(BIN INSTREAM)))
STRING)))
RESULTS])
(\GV.COLLECT.ENTRY.LIST
[LAMBDA (INSTREAM HEADING RESULTS) (* lmm " 2-Apr-86 12:52")
(* * return a component consisting of an RList, a stamp list, a "removal" RList
(not interesting) and another stamp list)
(PROG1 (PROG ((CNT 0)
(NWORDS (BIN16 INSTREAM))
STRLEN RMAR VAL)
(COND
((EQ NWORDS 0)
(RETURN RESULTS)))
[do (add CNT 1)
(SETQ STRLEN (BIN16 INSTREAM))
(BIN16 INSTREAM) (* ignore maxLength)
(push VAL (\GETSTRING INSTREAM STRLEN))
(SETQ NWORDS (IDIFFERENCE NWORDS (IPLUS (QUOTIENT (ADD1 STRLEN)
2)
2)))
(COND
((ILEQ NWORDS 0)
(RETURN]
(RETURN (CONS (CONS HEADING VAL)
RESULTS)))
(\SKIPCOMPONENT INSTREAM)
(\SKIPCOMPONENT INSTREAM)
(\SKIPCOMPONENT INSTREAM])
)
(FILESLOAD (LOADCOMP)
MAINTAIN)
(PUTPROPS NSTHASIZE COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4539 16732 (CONVERT.GV.TO.NS 4549 . 5883) (GV.READFORWARDING 5885 . 6100) (
READ-GV-NS-MAPPING 6102 . 7698) (NSTHASIZE 7700 . 11352) (\GETSTRING 11354 . 11781) (\GV.COLLECT.ENTRY
11783 . 14667) (\GV.COLLECT.ENTRY.1 14669 . 15465) (\GV.COLLECT.ENTRY.LIST 15467 . 16730)))))
STOP