(FILECREATED "10-Aug-85 13:28:20" {ERIS}<LISPCORE>LIBRARY>TCPCONFIG.;8 21424
changes to: (RECORDS IPINIT)
(FNS TCP.CONFIGURE TCPCONF.DIALOGUE TCPCONF.GET.LOCAL.MASKS)
(VARS TCPCONFIGCOMS)
previous date: "21-Jun-85 19:19:58" {ERIS}<LISPCORE>LIBRARY>TCPCONFIG.;7)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPCONFIGCOMS)
(RPAQQ TCPCONFIGCOMS ((COMS (* TCP configuration module)
(RECORDS IPINIT)
(INITVARS (\IP.DEFAULT.CONFIGURATION (create IPINIT)))
(FNS TCP.CONFIGURE TCP.CONFIGURE.WINDOW TCPCONF.DIALOGUE
TCPCONF.GET.LOCAL.ADDRESSES TCPCONF.GET.LOCAL.MASKS
TCPCONF.PRINT.CONFIGURATION \IPNETADDRESS \IP.READ.STRING.ADDRESS
TCPCONF.GET.LOCAL.NETWORKS TCPCONF.SET.PROPERTY
TCPCONF.TITLECOMMANDFN))))
(* TCP configuration module)
[DECLARE: EVAL@COMPILE
(RECORD IPINIT (LOCAL.ADDRESSES LOCAL.NETWORKS DEFAULT.GATEWAY HTE.FILE HOSTNAME SUBNETMASK))
]
(RPAQ? \IP.DEFAULT.CONFIGURATION (create IPINIT))
(DEFINEQ
(TCP.CONFIGURE
(LAMBDA NIL (* ejs: "10-Aug-85 13:08")
(* * Creates an inspect window to hold a configuration dialogue with the user)
(DECLARE (GLOBALVARS \IP.DEFAULT.CONFIGURATION))
(COND
((INFILEP (QUOTE {DSK}IP.INIT))
(LET ((STREAM (OPENSTREAM (QUOTE {DSK}IP.INIT)
(QUOTE INPUT)
(QUOTE OLD)))
(PROPERLENGTH (LENGTH (create IPINIT))))
(SETQ \IP.DEFAULT.CONFIGURATION (READ STREAM))
(CLOSEF STREAM)
(until (EQLENGTH \IP.DEFAULT.CONFIGURATION PROPERLENGTH) do (SETQ
\IP.DEFAULT.CONFIGURATION
(NCONC1
\IP.DEFAULT.CONFIGURATION NIL)
)))))
(COND
((TCPCONF.DIALOGUE)
(LET ((STREAM (OPENSTREAM (QUOTE {DSK}IP.INIT)
(QUOTE OUTPUT)
(QUOTE NEW))))
(PRIN2 \IP.DEFAULT.CONFIGURATION STREAM)
(CLOSEF STREAM))))))
(TCP.CONFIGURE.WINDOW
(LAMBDA NIL (* MPL " 2-Jun-85 23:15")
(* * Creates an inspect window to hold a configuration dialogue with the user)
(DECLARE (GLOBALVARS \IP.DEFAULT.CONFIGURATION))
(LET* ((HEIGHT (HEIGHTIFWINDOW (ITIMES (LENGTH (RECORDFIELDNAMES (QUOTE IPINIT)))
(FONTHEIGHT (fetch (FONTCLASS DISPLAYFD) of DEFAULTFONT)))
T))
(POS (GETBOXPOSITION 600 HEIGHT))
(INSPECTW (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of POS)
(fetch (POSITION YCOORD) of POS)
600 HEIGHT)
"TCP/IP Configuration Window")))
(INSPECT (COND
((AND (BOUNDP (QUOTE \IP.DEFAULT.CONFIGURATION))
\IP.DEFAULT.CONFIGURATION))
(T (SETQ \IP.DEFAULT.CONFIGURATION (create IPINIT))))
(QUOTE IPINIT)
INSPECTW)
(WINDOWPROP INSPECTW (QUOTE TITLE)
"TCP/IP Configuration Window")
(for ITEM in (WINDOWPROP INSPECTW (QUOTE SELECTABLEITEMS)) by (CDDR ITEM)
do (RPLACA (CDR ITEM)
(FUNCTION TCPCONF.SET.PROPERTY)))
(for ITEM in (CDR (WINDOWPROP INSPECTW (QUOTE SELECTABLEITEMS))) by (CDDR ITEM)
do (RPLACA (CDR ITEM)
(FUNCTION NILL)))
(WINDOWPROP INSPECTW (QUOTE TITLECOMMANDFN)
(FUNCTION TCPCONF.TITLECOMMANDFN)))))
(TCPCONF.DIALOGUE
(LAMBDA NIL (* ejs: "10-Aug-85 13:01")
(bind SATISFIED? CHANGEDFLG (OLDCONFIGURATION ←(COPYALL \IP.DEFAULT.CONFIGURATION)) repeatuntil
SATISFIED?
do
(NLSETQ
(PROGN (printout T "Here is the current configuration:" T)
(TCPCONF.PRINT.CONFIGURATION)
(COND
((EQ (ASKUSER NIL NIL "Are you satisfied with the current configuration? ")
(QUOTE N))
(printout T .PARA 0 0
(QUOTE (In the following dialogue, you will be presented with the
current value for a configuration parameter, and then be
given a chance to enter a new value. Simply type <CR> to
default to the current value.))
T)
(for PROPERTY in (QUOTE (HOSTNAME HTE.FILE DEFAULT.GATEWAY LOCAL.NETWORKS
SUBNETMASK LOCAL.ADDRESSES))
do (COND
((LISTP (RECORDACCESS PROPERTY \IP.DEFAULT.CONFIGURATION
(RECLOOK (QUOTE IPINIT))
(QUOTE FETCH)))
(printout T T PROPERTY 20 .PPVTL (RECORDACCESS PROPERTY
\IP.DEFAULT.CONFIGURATION
(RECLOOK (QUOTE IPINIT))
(QUOTE FETCH))
T))
(T (printout T T PROPERTY 20 (RECORDACCESS PROPERTY
\IP.DEFAULT.CONFIGURATION
(RECLOOK (QUOTE IPINIT))
(QUOTE FETCH))
T)))
(RESETLST (SELECTQ
PROPERTY
(HOSTNAME (LET ((NAME (MKATOM (U-CASE (TTYIN
"Please enter this host's name: "
NIL
"Enter a name to call this host by"
(QUOTE STRING)))))
)
(replace (IPINIT HOSTNAME) of
\IP.DEFAULT.CONFIGURATION
with (OR NAME (fetch (IPINIT HOSTNAME)
of
\IP.DEFAULT.CONFIGURATION)))))
(HTE.FILE (replace (IPINIT HTE.FILE) of
\IP.DEFAULT.CONFIGURATION
with (OR (TTYIN
"Please enter the name of a HOSTS.TXT file. If you have no HOSTS.TXT file, type a carriage return."
NIL
"Enter the name of a file to be used in translating IP host names to IP host addresses."
(QUOTE STRING))
(fetch (IPINIT HTE.FILE) of
\IP.DEFAULT.CONFIGURATION))))
(DEFAULT.GATEWAY (bind ADDRESS.STRING DEFAULT.GATEWAY
until DEFAULT.GATEWAY
do (SETQ ADDRESS.STRING
(TTYIN
"Please enter the IP address of the default gateway for this host. If you have no gateway, just type a carriage return: "
NIL
"Enter an IP address, in the form 192.10.200.1"
(QUOTE STRING)))
(COND
((NULL ADDRESS.STRING)
(SETQ DEFAULT.GATEWAY NIL)
(GO $$OUT))
(T (SETQ DEFAULT.GATEWAY
(\IP.READ.STRING.ADDRESS
ADDRESS.STRING))))
finally (replace (IPINIT DEFAULT.GATEWAY)
of \IP.DEFAULT.CONFIGURATION
with
(OR ADDRESS.STRING
(fetch (IPINIT
DEFAULT.GATEWAY)
of
\IP.DEFAULT.CONFIGURATION)))))
(LOCAL.NETWORKS
(LET ((LOCAL.NETWORKS (TCPCONF.GET.LOCAL.NETWORKS)))
(COND
(LOCAL.NETWORKS (replace (IPINIT LOCAL.NETWORKS)
of \IP.DEFAULT.CONFIGURATION
with (OR LOCAL.NETWORKS
(fetch (IPINIT
LOCAL.NETWORKS)
of
\IP.DEFAULT.CONFIGURATION)))))
))
(SUBNETMASK (* Have to have asked for local.networks before this
question)
(LET ((LOCAL.MASKS (TCPCONF.GET.LOCAL.MASKS)))
(COND
(LOCAL.MASKS
(replace (IPINIT SUBNETMASK)
of \IP.DEFAULT.CONFIGURATION
with (OR LOCAL.MASKS
(fetch (IPINIT SUBNETMASK)
of
\IP.DEFAULT.CONFIGURATION)))))
))
(LOCAL.ADDRESSES (* Have to have asked for local.networks before this
question)
(LET ((LOCAL.ADDRESSES (TCPCONF.GET.LOCAL.ADDRESSES)))
(COND
(LOCAL.ADDRESSES (replace (IPINIT LOCAL.ADDRESSES)
of \IP.DEFAULT.CONFIGURATION
with (OR LOCAL.ADDRESSES
(fetch (IPINIT
LOCAL.ADDRESSES)
of
\IP.DEFAULT.CONFIGURATION)))))
))
NIL))))
(T (SETQ SATISFIED? T)))))
finally (RETURN (NOT (EQUAL OLDCONFIGURATION \IP.DEFAULT.CONFIGURATION))))))
(TCPCONF.GET.LOCAL.ADDRESSES
(LAMBDA NIL (* ejs: " 5-Jun-85 12:27")
(* * Return the local network list for this host. The list is an alist keyed by network address, and containing
otherwise the atom 10 or 3 indicating the kind of network)
(LET ((ADDRESSES (fetch (IPINIT LOCAL.ADDRESSES) of \IP.DEFAULT.CONFIGURATION)))
(LET ((10MBADDRESS (COND
(\10MBLOCALNDB (bind STRING ADDRESS until ADDRESS
do (SETQ STRING (TTYIN
"Please enter this host's IP address on the 10MB network, in the form 36.9.0.9: "
NIL
"Enter an IP address. Leave the host number portion of the address 0."
(QUOTE STRING)))
(COND
((AND STRING (SETQ ADDRESS (\IP.READ.STRING.ADDRESS
STRING))
(ZEROP (\IPNETADDRESS ADDRESS)))
(SETQ ADDRESS NIL)
(printout T
"The network address you have entered is in an incorrect form. Please try again."
T))
((NULL STRING)
(SETQ STRING (pop ADDRESSES))
(SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING))))
finally (RETURN (LIST STRING))))))
(3MBADDRESS (COND
(\3MBLOCALNDB (bind STRING ADDRESS until ADDRESS
do (SETQ STRING (TTYIN
"Please enter this host's IP address on the 3MB network, in the form 36.9.0.9: "
NIL
"Enter an IP address. Leave the host number portion of the address 0."
(QUOTE STRING)))
(COND
((AND STRING (SETQ ADDRESS (\IP.READ.STRING.ADDRESS
STRING))
(ZEROP (\IPNETADDRESS ADDRESS)))
(SETQ ADDRESS NIL)
(printout T
"The network address you have entered is in an incorrect form. Please try again."
T))
((NULL STRING)
(SETQ STRING (pop ADDRESSES))
(SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING))))
finally (RETURN (LIST STRING)))))))
(APPEND 10MBADDRESS 3MBADDRESS)))))
(TCPCONF.GET.LOCAL.MASKS
(LAMBDA NIL (* ejs: "10-Aug-85 13:04")
(* * Return the local network list for this host. The list is an alist keyed by network address, and containing
otherwise the atom 10 or 3 indicating the kind of network)
(LET ((ADDRESSES (fetch (IPINIT LOCAL.ADDRESSES) of \IP.DEFAULT.CONFIGURATION)))
(LET ((10MBADDRESS (COND
(\10MBLOCALNDB (bind STRING ADDRESS until ADDRESS
do (SETQ STRING (TTYIN
"Please enter the subnet address mask for this host's 10MB network, in the form 39.9.0.0: "
NIL
"Enter an IP address. The bitwise-AND of this address and any destination IP address is not equal to the bitwise-AND of this address and the host's local IP address, the destination IP address will be considered to be on another (sub)network"
(QUOTE STRING)))
(COND
((AND STRING (SETQ ADDRESS (
\IP.READ.STRING.ADDRESS STRING))
(ZEROP (\IPNETADDRESS ADDRESS)))
(SETQ ADDRESS NIL)
(printout T
"The network address you have entered is in an incorrect form. Please try again."
T))
((NULL STRING)
(SETQ STRING (pop ADDRESSES))
(SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING))
))
finally (RETURN (LIST STRING))))))
(3MBADDRESS (COND
(\3MBLOCALNDB (bind STRING ADDRESS until ADDRESS
do (SETQ STRING (TTYIN
"Please enter the subnet address mask for this host's 3MB network, in the form 36.9.0.0: "
NIL
"Enter an IP address. The bitwise-AND of this address and any destination IP address is not equal to the bitwise-AND of this address and the host's local IP address, the destination IP address will be considered to be on another (sub)network"
(QUOTE STRING)))
(COND
((AND STRING (SETQ ADDRESS (
\IP.READ.STRING.ADDRESS STRING))
(ZEROP (\IPNETADDRESS ADDRESS)))
(SETQ ADDRESS NIL)
(printout T
"The network address you have entered is in an incorrect form. Please try again."
T))
((NULL STRING)
(SETQ STRING (pop ADDRESSES))
(SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING))))
finally (RETURN (LIST STRING)))))))
(APPEND 10MBADDRESS 3MBADDRESS)))))
(TCPCONF.PRINT.CONFIGURATION
(LAMBDA NIL (* ejs: " 5-Jun-85 12:32")
(bind (DEC ←(RECLOOK (QUOTE IPINIT))) for FIELD in (RECORDFIELDNAMES (QUOTE IPINIT))
do (COND
((LISTP (RECORDACCESS FIELD \IP.DEFAULT.CONFIGURATION DEC (QUOTE FETCH)))
(printout T FIELD 20 .PPVTL (RECORDACCESS FIELD \IP.DEFAULT.CONFIGURATION DEC
(QUOTE FETCH))
T))
(T (printout T FIELD 20 (RECORDACCESS FIELD \IP.DEFAULT.CONFIGURATION DEC (QUOTE FETCH))
T))))))
(\IPNETADDRESS
(LAMBDA (IPADDRESS) (* ejs: "22-Apr-85 17:38")
(COND
((EQ \IP.CLASS.A (LDB \IP.CLASS.A.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.A.NET.BYTESPEC IPADDRESS))
((EQ \IP.CLASS.B (LDB \IP.CLASS.B.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.B.NET.BYTESPEC IPADDRESS))
((EQ \IP.CLASS.C (LDB \IP.CLASS.C.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.C.NET.BYTESPEC IPADDRESS))
(T (ERROR "Illegal address class" IPADDRESS)))))
(\IP.READ.STRING.ADDRESS
(LAMBDA (STRING.OR.ATOM) (* ejs: "27-Dec-84 15:42")
(* * Convert a dotted notation -- 36.9.0.9 -- to an internal notation)
(bind (CELL ←(ARRAY 4 (QUOTE BYTE)
0 0))
(INDEX ← 0)
(TEMP ← 0) for CHAR instring (MKSTRING STRING.OR.ATOM)
while (AND (ILEQ INDEX 3)
(ILEQ TEMP (MASK.1'S 0 8)))
do (COND
((EQ CHAR (CHARCODE %.))
(\BYTESETA CELL INDEX TEMP)
(SETQ TEMP 0)
(add INDEX 1))
((AND (IGEQ CHAR (CHARCODE 0))
(ILEQ CHAR (CHARCODE 9)))
(SETQ TEMP (IPLUS (ITIMES TEMP 10)
(IDIFFERENCE CHAR (CHARCODE 0))))))
finally (COND
((ILEQ TEMP (MASK.1'S 0 8))
(\BYTESETA CELL INDEX TEMP)))
(RETURN (COND
((EQ INDEX 3)
(create FIXP
HINUM ←(create WORD
HIBYTE ←(\BYTELT CELL 0)
LOBYTE ←(\BYTELT CELL 1))
LONUM ←(create WORD
HIBYTE ←(\BYTELT CELL 2)
LOBYTE ←(\BYTELT CELL 3)))))))))
(TCPCONF.GET.LOCAL.NETWORKS
(LAMBDA NIL (* ejs: " 5-Jun-85 12:27")
(* * Return the local network list for this host. The list is an alist keyed by network address, and containing
otherwise the atom 10 or 3 indicating the kind of network)
(LET ((10MBADDRESS (COND
(\10MBLOCALNDB (bind STRING ADDRESS until ADDRESS
do (SETQ STRING (TTYIN
"Please enter the network number for this host's 10MB network, in the form 36.0.0.0: "
NIL
"Enter an IP address. Leave the host number portion of the address 0."
(QUOTE STRING)))
(COND
((AND STRING (SETQ ADDRESS (\IP.READ.STRING.ADDRESS
STRING))
(ZEROP (\IPNETADDRESS ADDRESS)))
(SETQ ADDRESS NIL)
(printout T
"The network address you have entered is in an incorrect form. Please try again."
T))
((NULL STRING)
(SETQ STRING (CAAR (SOME (fetch (IPINIT
LOCAL.NETWORKS)
of
\IP.DEFAULT.CONFIGURATION)
(FUNCTION (LAMBDA (ENTRY)
(EQ (CDR ENTRY)
(QUOTE 10)))))))
(SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING))))
finally (RETURN (LIST (CONS STRING 10)))))))
(3MBADDRESS (COND
(\3MBLOCALNDB (bind STRING ADDRESS until ADDRESS
do (SETQ STRING (TTYIN
"Please enter the network number for this host's 3MB network, in the form 36.0.0.0: "
NIL
"Enter an IP address. Leave the host number portion of the address 0."
(QUOTE STRING)))
(COND
((AND STRING (SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING)
)
(ZEROP (\IPNETADDRESS ADDRESS)))
(SETQ ADDRESS NIL)
(printout T
"The network address you have entered is in an incorrect form. Please try again."
T))
((NULL STRING)
(SETQ STRING (CAAR (SOME (fetch (IPINIT LOCAL.NETWORKS)
of \IP.DEFAULT.CONFIGURATION)
(FUNCTION (LAMBDA (ENTRY)
(EQ (CDR ENTRY)
(QUOTE 3)))))))
(SETQ ADDRESS (\IP.READ.STRING.ADDRESS STRING))))
finally (RETURN (LIST (CONS STRING 3))))))))
(APPEND 10MBADDRESS 3MBADDRESS))))
(TCPCONF.SET.PROPERTY
(LAMBDA (PROPERTY DATUM INSPECTW) (* MPL " 2-Jun-85 22:32")
(COND
((MOUSESTATE (NOT UP))
(UNTILMOUSESTATE UP)
(RESETLST (RESETSAVE (TTYDISPLAYSTREAM (GETPROMPTWINDOW INSPECTW 5)))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM)))))))
(SELECTQ PROPERTY
(HOSTNAME (bind NAME until NAME
do (SETQ NAME (MKATOM (U-CASE (TTYIN
"Please enter this host's name: "
NIL
"Enter a name to call this host by"
(QUOTE STRING)))))
finally (INSPECTW.REPLACE INSPECTW PROPERTY NAME)))
(HTE.FILE (INSPECTW.REPLACE INSPECTW PROPERTY (TTYIN
"Please enter the name of a HOSTS.TXT file. If you have no HOSTS.TXT file, type a carriage return."
NIL
"Enter the name of a file to be used in translating IP host names to IP host addresses."
(QUOTE STRING))))
(DEFAULT.GATEWAY (bind ADDRESS.STRING DEFAULT.GATEWAY until
DEFAULT.GATEWAY
do (SETQ ADDRESS.STRING (TTYIN
"Please enter the IP address of the default gateway for this host. If you have no gateway, just type a carriage return: "
NIL
"Enter an IP address, in the form 192.10.200.1"
(QUOTE STRING)))
(COND
((NULL ADDRESS.STRING)
(SETQ DEFAULT.GATEWAY NIL)
(GO $$OUT))
(T (SETQ DEFAULT.GATEWAY (\IP.READ.STRING.ADDRESS
ADDRESS.STRING))))
finally (INSPECTW.REPLACE INSPECTW PROPERTY
ADDRESS.STRING)))
(LOCAL.NETWORKS (LET ((LOCAL.NETWORKS (TCPCONF.GET.LOCAL.NETWORKS)))
(COND
(LOCAL.NETWORKS (INSPECTW.REPLACE INSPECTW PROPERTY
LOCAL.NETWORKS)))))
(LOCAL.ADDRESSES (LET ((LOCAL.ADDRESSES (TCPCONF.GET.LOCAL.ADDRESSES)))
(COND
(LOCAL.ADDRESSES (INSPECTW.REPLACE INSPECTW PROPERTY
LOCAL.ADDRESSES)))))
(DEFAULT.INSPECTW.PROPCOMMANDFN PROPERTY DATUM INSPECTW)))))))
(TCPCONF.TITLECOMMANDFN
(LAMBDA (INSPECTW DATUM) (* MPL " 2-Jun-85 22:43")
(* * Called when middle button goes down in title bar)
(COND
((MOUSESTATE (NOT UP))
(SELECTQ (MENU (create MENU
ITEMS ←(QUOTE (ReFetch Create% Init))))
(ReFetch (INSPECTW.REDISPLAY INSPECTW))
(Create% Init (RESETLST (RESETSAVE (TTYDISPLAYSTREAM (GETPROMPTWINDOW INSPECTW 5)))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM))
)))))
(LET ((FILE (TTYIN
"Please specify the name for the new IP init file: "
NIL
"Enter a filename. Carriage return defaults to {DSK}IP.INIT"
(QUOTE STRING))))
(SETQ FILE (OPENSTREAM FILE (QUOTE OUTPUT)
(QUOTE NEW)))
(PRIN2 DATUM FILE)
(CLOSEF FILE))))
NIL)))))
)
(PUTPROPS TCPCONFIG COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1041 21344 (TCP.CONFIGURE 1051 . 2064) (TCP.CONFIGURE.WINDOW 2066 . 3572) (
TCPCONF.DIALOGUE 3574 . 8444) (TCPCONF.GET.LOCAL.ADDRESSES 8446 . 10651) (TCPCONF.GET.LOCAL.MASKS
10653 . 13285) (TCPCONF.PRINT.CONFIGURATION 13287 . 13879) (\IPNETADDRESS 13881 . 14388) (
\IP.READ.STRING.ADDRESS 14390 . 15561) (TCPCONF.GET.LOCAL.NETWORKS 15563 . 18111) (
TCPCONF.SET.PROPERTY 18113 . 20346) (TCPCONF.TITLECOMMANDFN 20348 . 21342)))))
STOP