HostAndTerminalImpl:
CEDAR
MONITOR
LOCKS rm USING rm: RefLock
IMPORTS Atom, Commander, CommanderOps, Convert, IO, NetworkName, Rope, RopeHash, SymTab
EXPORTS HostAndTerminalOps, NetAddressing
=
Exports to NetAddressing (& Extras)
Error: PUBLIC ERROR [codes: LIST OF ATOM, msg: ROPE] ~ CODE;
FormatError:
PUBLIC
PROC [codes:
LIST
OF
ATOM, msg:
ROPE]
RETURNS [
ROPE] ~ {
to: IO.STREAM ~ IO.ROS[];
FOR codes ¬ codes, codes.rest
WHILE codes#
NIL
DO
to.PutRope[Atom.GetPName[codes.first]];
IF codes.rest#NIL THEN to.PutChar['/];
ENDLOOP;
to.PutChar['[];
to.PutRope[msg];
to.PutChar[']];
RETURN to.RopeFromROS[]};
FormatAddress:
PUBLIC
PROC [addr:
NA.Address, socket:
BOOL]
RETURNS [
ROPE] ~ {
IF addr.protocolFamily=NIL THEN RETURN ["null"];
{to: IO.STREAM ~ IO.ROS[];
pfName: ROPE ~ IF addr.protocolFamily#NIL THEN Atom.GetPName[addr.protocolFamily] ELSE "NIL";
to.PutRope[addr.host];
to.PutChar['-];
to.PutRope[pfName];
IF socket
THEN to.PutF1[
IF addr.socket.Length>0
AND addr.socket.Fetch[0]=':
THEN "%g"
ELSE ":%g",
A grotesque, unjustifiable hack that makes FormatAddress invertible by ParseAddress when the addr comes from the case of FromNnAddress wherein NetworkName.AddressFromName is used (and produces sockets that begin with colons).
[rope[addr.socket]] ]
ELSE IF addr.host.Find[":"]>=0 OR pfName.Find[":"]>=0 THEN to.PutChar[':];
RETURN to.RopeFromROS[]}};
ParseAddress:
PUBLIC
PROC [rope:
ROPE]
RETURNS [
NA.Address] ~ {
cp: INT ~ rope.FindBackward[":"];
dp: INT ~ rope.FindBackward["-", IF cp>=0 THEN cp ELSE INT.LAST];
socket: ROPE ¬ NIL;
pf: ATOM ¬ $ARPA;
IF rope.Equal["null"] THEN RETURN [NA.nullAddress];
IF cp >=0
THEN {
socket ¬ rope.Substr[start: cp+1];
rope ¬ rope.Substr[len: cp]};
IF dp>=0
THEN {
pf ¬ Atom.MakeAtom[rope.Substr[start: dp+1]];
rope ¬ rope.Substr[len: dp]};
RETURN [[pf, rope, socket]]};
EncodeAddress:
PUBLIC
PROC [addr:
NA.Address]
RETURNS [
ROPE] ~ {
IF addr.protocolFamily=NIL THEN RETURN ["null"];
RETURN IO.PutFR["\"%q\" \"%q\" \"%q\"", [atom[addr.protocolFamily]], [rope[addr.host]], [rope[addr.socket]] ]};
DecodeAddress:
PUBLIC
PROC [rope:
ROPE]
RETURNS [
NA.Address] ~ {
IF rope.Equal["null"] THEN RETURN [NA.nullAddress];
{in: IO.STREAM ~ IO.RIS[rope];
host: ROPE ~ in.GetRopeLiteral[!IO.Error => PassIoErr[$InvalidAddress, ec]];
pf: ATOM ~ Atom.MakeAtom[in.GetRopeLiteral[!IO.Error => PassIoErr[$InvalidAddress, ec]]];
socket: ROPE ~ in.GetRopeLiteral[!IO.Error => PassIoErr[$InvalidAddress, ec]];
RETURN [[pf, host, socket]]}};
Canonicalize:
PUBLIC
PROC [a:
NA.Address]
RETURNS [
NA.Address] ~ {
nna1, nna2: ROPE;
nnf1, nnf2: ATOM;
b: NA.Address;
[nna1, nnf1] ¬ ToNnAddress[a];
b ¬ FromNnAddress[nna1, nnf1];
[nna2, nnf2] ¬ ToNnAddress[b];
IF nnf1#nnf2 OR NOT nna1.Equal[nna2] THEN Error[LIST[$CantCanonicalize], IO.PutFLR["Canonicalize fails: %g (%g) -> %g -> %g (%g)", LIST[[rope[nna1]], [atom[nnf1]], [rope[FormatAddress[b, TRUE]]], [rope[nna2]], [atom[nnf2]] ]]];
RETURN [b]};
EqualAddrs:
PUBLIC
PROC [a1, a2:
NA.Address]
RETURNS [
BOOL]
~ {RETURN [a1.protocolFamily=a2.protocolFamily AND a1.host.Equal[a2.host, FALSE] AND a1.socket.Equal[a2.socket, FALSE]]};
HashAddr:
PUBLIC
PROC [a:
NA.Address]
RETURNS [
CARDINAL] ~
TRUSTED {
h1: CARDINAL ~ LOOPHOLE[a.protocolFamily, CARD] MOD 65535;
h2: CARDINAL ~ RopeHash.FromRope[rope: a.socket, case: FALSE, seed: h1];
RETURN [RopeHash.FromRope[rope: a.host, case: FALSE, seed: h2]]};
EqualModSocket:
PUBLIC
PROC [a1, a2:
NA.Address]
RETURNS [
BOOL]
~ {RETURN [a1.protocolFamily=a2.protocolFamily AND a1.host.Equal[a2.host, FALSE]]};
SetSocket:
PUBLIC
PROC [addr:
NA.Address, socket:
ROPE]
RETURNS [
NA.Address]
~ {addr.socket ¬ socket; RETURN [addr]};
ExtractSocket:
PUBLIC
PROC [addr:
NA.Address]
RETURNS [
ROPE]
~ {RETURN [addr.socket]};
EqualAddrReferents:
PUBLIC
PROC [key1, key2:
REF
ANY]
RETURNS [
BOOL] ~ {
ra1: REF NA.Address ~ NARROW[key1];
ra2: REF NA.Address ~ NARROW[key2];
RETURN EqualAddrs[ra1, ra2]};
HashAddrReferent:
PUBLIC
PROC [key:
REF
ANY]
RETURNS [
CARDINAL] ~ {
ra: REF NA.Address ~ NARROW[key]; RETURN HashAddr[ra]};
FromNnAddress:
PUBLIC
PROC [addr:
ROPE, family:
ATOM]
RETURNS [
NA.Address] ~ {
host, socket: ROPE;
host ¬ NetworkName.NameFromAddress[family: family, addr: addr, components: host
!NetworkName.Error =>
IF codes#
NIL
AND codes.first=$notFound
THEN host ¬ NetworkName.AddressFromName[family: family, name: addr, components: host !NetworkName.Error => Error[codes, msg] ].addr
ELSE Error[codes, msg]].name;
socket ¬ NetworkName.NameFromAddress[family: family, addr: addr, components: port
!NetworkName.Error => Error[codes, msg]].name;
RETURN [[family, host, socket]]};
ToNnAddress:
PUBLIC
PROC [na:
NA.Address]
RETURNS [addr:
ROPE, family:
ATOM] ~ {
addr ¬ NetworkName.AddressFromName[family: na.protocolFamily, name: na.host, portHint: na.socket, components: hostAndPort !NetworkName.Error => Error[CONS[$InvalidAddress, codes], msg]].addr;
family ¬ na.protocolFamily;
RETURN};
PassConvertErr:
PROC [reason: Convert.ErrorType, subCode:
ATOM, index:
INT, rope, parent:
ROPE] ~ {
codes: LIST OF ATOM ¬ LIST[Convert.AtomFromErrorType[reason]];
IF subCode#NIL THEN codes ¬ CONS[subCode, codes];
Error[
CONS[$InvalidAddress, codes],
IF rope#
NIL
THEN IO.PutFR["at %g in \"%q\" from \"%q\"", [integer[index]], [rope[rope]], [rope[parent]] ]
ELSE NIL]};
PassIoErr:
PROC [pre:
ATOM, ec:
IO.ErrorCode] ~ {
ioc: ATOM ~ IO.AtomFromErrorCode[ec];
Error[LIST[pre, ioc], NIL]};
Exports to HostAndTerminalOps
pvrs: ARRAY HAT.Side OF SymTab.Ref ¬ [SymTab.Create[], SymTab.Create[]];
SetProtocolVersionRangeForSide:
PUBLIC
PROC [side:
HAT.Side, protocol:
ROPE, pvr:
HAT.ProtocolVersionRange] ~ {
[] ¬ pvrs[side].Store[protocol, NEW [HAT.ProtocolVersionRange ¬ pvr]];
RETURN};
GetProtocolVersionRangeForSide:
PUBLIC
PROC [side:
HAT.Side, protocol:
ROPE]
RETURNS [
HAT.ProtocolVersionRange] ~ {
rpvr: REF HAT.ProtocolVersionRange ~ NARROW[pvrs[side].Fetch[protocol].val];
RETURN [IF rpvr#NIL THEN rpvr ELSE []]};
EnumerateProtocolVersionsOfSide:
PUBLIC
PROC [side:
HAT.Side,
Consume:
PROC [
ROPE,
HAT.ProtocolVersionRange]] ~ {
PassPVR:
PROC [key:
ROPE, val:
REF
ANY]
RETURNS [
BOOL] ~ {
rpvr: REF HAT.ProtocolVersionRange ~ NARROW[val];
Consume[key, rpvr];
RETURN [FALSE]};
IF pvrs[side].Pairs[PassPVR] THEN ERROR;
RETURN};
GetChannel: PUBLIC PROC RETURNS [NAT] ~ {RETURN [0]};
Debugging Commands
NameFromAddressCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
family: ATOM;
name, addr: ROPE;
components: NetworkName.Components ¬ hostAndPort;
serviceFlavor: ATOM ¬ NIL;
responderFlavor: ATOM;
IF argv.argc
NOT
IN [3..5]
THEN {
cmd.err.PutF1["Usage: %g family addr [components [serviceFlavor]]\n", [rope[argv[0]]] ];
RETURN [$Warning]};
family ¬ Atom.MakeAtom[argv[1]];
addr ¬ argv[2];
IF argv.argc>3
THEN
SELECT
TRUE
FROM
argv[3].Equal["host", FALSE] => components ¬ host;
argv[3].Equal["port", FALSE] => components ¬ port;
argv[3].Equal["hostAndPort", FALSE] => components ¬ hostAndPort;
ENDCASE => RETURN [$Failure, "components: {host, port, hostAndPort}"];
IF argv.argc>4 THEN serviceFlavor ¬ Atom.MakeAtom[argv[4]];
cmd.out.PutFL["NetworkName.NameFromAddress[%g, %g, %g, %g] => ", LIST[[atom[family]], [rope[addr]], [rope[SELECT components FROM host => "host", port => "port", hostAndPort => "hostAndPort", ENDCASE => ERROR]], IF serviceFlavor#NIL THEN [atom[serviceFlavor]] ELSE [rope[NIL]] ]];
[name, responderFlavor] ¬ NetworkName.NameFromAddress[family, addr, components, serviceFlavor !NetworkName.Error => {
cmd.out.PutF1[" ERROR %g.\n", [rope[FormatError[codes, msg]]] ];
ERROR CommanderOps.Failed["NetworkName.Error"]}];
cmd.out.PutF[" [name: %g, responderFlavor: %g].\n", [rope[name]], [atom[responderFlavor]] ];
RETURN};
AddressFromNameCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
family: ATOM;
name: ROPE;
portHint: ROPE ¬ NIL;
components: NetworkName.Components ¬ hostAndPort;
serviceFlavor: ATOM ¬ NIL;
addr: ROPE;
responderFlavor: ATOM;
IF argv.argc
NOT
IN [3..6]
THEN {
cmd.err.PutF1["Usage: %g family name [portHint [components [serviceFlavor]]]\n", [rope[argv[0]]] ];
RETURN [$Warning]};
family ¬ Atom.MakeAtom[argv[1]];
name ¬ argv[2];
IF argv.argc>3 THEN portHint ¬ argv[3];
IF argv.argc>4
THEN
SELECT
TRUE
FROM
argv[4].Equal["host", FALSE] => components ¬ host;
argv[4].Equal["port", FALSE] => components ¬ port;
argv[4].Equal["hostAndPort", FALSE] => components ¬ hostAndPort;
ENDCASE => RETURN [$Failure, "components: {host, port, hostAndPort}"];
IF argv.argc>5 THEN serviceFlavor ¬ Atom.MakeAtom[argv[5]];
cmd.out.PutFL["NetworkName.AddressFromName[%g, %g, %g, %g, %g] => ", LIST[[atom[family]], [rope[name]], [rope[IF portHint#NIL THEN portHint ELSE "NIL"]], [rope[SELECT components FROM host => "host", port => "port", hostAndPort => "hostAndPort", ENDCASE => ERROR]], IF serviceFlavor#NIL THEN [atom[serviceFlavor]] ELSE [rope[NIL]] ]];
[addr, responderFlavor] ¬ NetworkName.AddressFromName[family, name, portHint, components, serviceFlavor !NetworkName.Error => {
cmd.out.PutF1[" ERROR %g.\n", [rope[FormatError[codes, msg]]] ];
ERROR CommanderOps.Failed["NetworkName.Error"]}];
cmd.out.PutF[" [addr: %g, responderFlavor: %g].\n", [rope[addr]], [atom[responderFlavor]] ];
RETURN};
ParseCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
IF argv.argc < 2
THEN {
cmd.err.PutF1["Usage: %g addr ...\n", [rope[argv[0]]] ];
RETURN [$Warning]};
FOR i:
INT
IN [1 .. argv.argc)
DO
raw: ROPE ~ argv[i];
na: NA.Address;
nna: ROPE;
nnp: ATOM;
na ¬ ParseAddress[raw !Error => {
cmd.err.PutF["NetAddressing.ParseAddress[%g] => ERROR %g.\n", [rope[raw]], [rope[FormatError[codes, msg]]] ];
LOOP}];
cmd.out.PutFL["NetAddressing.ParseAddress[%g] => [%g, %g, %g].\n", LIST[[rope[raw]], [atom[na.protocolFamily]], [rope[na.host]], [rope[na.socket]] ]];
[nna, nnp] ¬ ToNnAddress[na !Error => {
cmd.err.PutF1["NetAddressing.ToNnAddress => ERROR %g.\n", [rope[FormatError[codes, msg]]] ];
LOOP}];
cmd.out.PutF["NetAddressing.ToNnAddress => %g %g.\n", [rope[nna]], [atom[nnp]] ];
ENDLOOP;
RETURN};
FormatCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
IF argv.argc < 2
OR (argv.argc
MOD 2) # 1
THEN {
cmd.err.PutF1["Usage: %g NetworkName.addr .family ...\n", [rope[argv[0]]] ];
RETURN [$Warning]};
FOR i:
INT
IN [0 .. argv.argc.
PRED/2)
DO
j: INT ~ i*2+1;
nna: ROPE ~ argv[j];
nnp: ATOM ~ Atom.MakeAtom[argv[j+1]];
na: NA.Address;
rope: ROPE;
na ¬ FromNnAddress[nna, nnp !Error => {
cmd.err.PutF["NetAddressing.FromNnAddress[%g, %g] => ERROR %g.\n", [rope[nna]], [atom[nnp]], [rope[FormatError[codes, msg]]] ];
LOOP}];
cmd.out.PutFL["NetAddressing.FromNnAddress[%g, %g] => [%g, %g, %g].\n", LIST[[rope[nna]], [atom[nnp]], [atom[na.protocolFamily]], [rope[na.host]], [rope[na.socket]] ]];
rope ¬ FormatAddress[na,
TRUE !Error => {
cmd.err.PutF1["NetAddressing.FormatAddress[, TRUE] => ERROR %g.\n", [rope[FormatError[codes, msg]]] ];
LOOP}];
cmd.out.PutF1["NetAddressing.FormatAddress[, TRUE] => %g.\n", [rope[rope]] ];
ENDLOOP;
RETURN};
Commander.Register["NetworkName.NameFromAddress", NameFromAddressCmd, "family addr [components [serviceFlavor]] --- test NetworkName.AddressFromName"];
Commander.Register["NetworkName.AddressFromName", AddressFromNameCmd, "family name [portHint [components [serviceFlavor]]] --- test NetworkName.AddressFromName"];
Commander.Register["NetAddressing.Parse", ParseCmd, "addr ... --- test NetAddressing.ParseAddress and .ToNnAddress"];
Commander.Register["NetAddressing.Format", FormatCmd, "NetworkName.addr .family --- test NetAddressing.FromNnAddress and .FormatAddress"];