{ -*-Fundamental-*- }
{ Phil Budne @ DEC / LCG }
{ Rutgers-PASCAL program to crawl out over a DECnet and map it !! }

PROGRAM crawl(input,output);

CONST
    HASHSIZE = 101;
    NODESIZE = 6;
    EMPTYNODE = '      ';
    CIRCSIZE = 10;
    EMPTYCIRC = '          ';
    DATASIZE = 4000;
    SHIFT = 5;
    DUMPINTERVAL = 25;

TYPE
    nodeindex = 1 .. NODESIZE;
    nodename = PACKED ARRAY [ nodeindex ] OF char;
    nodenum = integer;

    refnode = ^node;
    refcircuit = ^circuit;
    refnlist = ^nlist;

    node =
	PACKED RECORD
	 vnext : refnode;		{ next in visit chain }
	 hnext : refnode;		{ next in hash chain }
	 name : nodename;
	 visited : boolean;		{ visit attempted }
	 failed : boolean;		{ connect failed }
	 none : boolean;		{ no circuits found }
	 clist : refcircuit;
	END;

    circindex = 1 .. CIRCSIZE;
    circname = PACKED ARRAY [ circindex ] OF char;

    circuit =
	RECORD
	 next : refcircuit;
	 id : circname;
	 nodelist : refnlist;
	 owner : refnode
	END;

    nlist =
	RECORD
	 next : refnlist;
	 nptr : refnode
	END;

    byte = 0 .. 255;
    bindex = 1 .. DATASIZE;
    bdata = PACKED ARRAY [ bindex ] OF byte;

    hashindex = 1 .. HASHSIZE;

VAR
    hashtab : ARRAY [ hashindex ] OF refnode;
    visitlist : refnode;
    knowncount, visitcount : integer;

{ state vars for nextcircuit }
    domult : boolean;
    bufcnt : integer;
    bufpnt : bindex;

{****************************************************************}

{ ROUTINES FROM CREEP.MAC }

{ external procedure to return local node name }
PROCEDURE getlocal( VAR name : nodename );
EXTERN;


{ external procedure to open a data connection to a node }
FUNCTION opencon( name : nodename ) : boolean;
EXTERN;


{ external procedure to send a data record on connection }
FUNCTION putdata( cnt : integer; data : bdata ) : boolean;
EXTERN;


{ external procedure to get a data record from connection }
FUNCTION getdata( max : integer; VAR data : bdata ) : integer;
EXTERN;


{ external procedure to close data connection }
PROCEDURE closecon;
EXTERN;
{****************************************************************}

FUNCTION hash(name : nodename) : hashindex;
VAR
    hval : integer;
    i : nodeindex;

BEGIN
    hval := 0;
    FOR i := 1 TO NODESIZE DO
	hval := hval * SHIFT + ord(name[i]);

    hash := (hval MOD HASHSIZE) + 1
END;

{****************************************************************}

FUNCTION newnode(name : nodename) : refnode;
VAR
    np, hp : refnode;
    hval : hashindex;

BEGIN {newnode}
    new(np);
    np^.vnext := visitlist;
    np^.name := name;
    np^.clist := nil;
    np^.visited := false;
    visitlist := np;
    knowncount := knowncount + 1;

    hval := hash( name );
    np^.hnext := hashtab[hval];
    hashtab[hval] := np;
    newnode := np
END; {newnode}
{****************************************************************}

FUNCTION findnode( name : nodename ) : refnode;
VAR
    hval : hashindex;
    tp, np : refnode;
    
BEGIN
    hval := hash( name );

    tp := hashtab[ hval ];
    np := nil;
    WHILE (tp <> nil) AND (np = nil) DO BEGIN
	IF tp^.name = name THEN
	    np := tp;
	tp := tp^.hnext
    END; {while}

    IF np = nil THEN
	np := newnode( name );

    findnode := np

END; {findnode}
{****************************************************************}

FUNCTION showcircuits : boolean;
VAR
    arr : bdata;
BEGIN
    arr[1] := 20;		{ show function }
    arr[2] := 3;		{ dynamic, circuits }
    arr[3] := 255;		{ active }
    arr[4] := 0;
    showcircuits := putdata( 4, arr )
END;
{****************************************************************}

{ This routine reads NICE messages from the show circuits command.
  it should be a co-routine.  It uses the much dreaded GOTO.
  Label 999 is a RETURN statement.
  Label 111 enters the next iteration of the main loop (CONTINUE).

  The following are state variables that should be OWN/STATIC,
  but must belong to the global context;

	domult : boolean;
	bufcnt : integer;
	bufpnt : bindex;
}

FUNCTION nextcircuit( VAR cname : circname; VAR nname : nodename ) : boolean;
VAR
    buf : bdata;
    i, j : integer;
    loop1, loop2 : boolean;
    state, substate, nodenum : integer;

BEGIN
    nextcircuit := false;
    loop1 := true;

    WHILE loop1 DO BEGIN

	cname := EMPTYCIRC;
	nname := EMPTYNODE;

	IF bufcnt = 0 THEN BEGIN

	    bufcnt := getdata( DATASIZE, buf );	{ try to fetch a record }
	    bufpnt := 1;

	    IF bufcnt = 0 THEN			{ failed to refill }
		GOTO 999;

	    IF domult AND (buf[1] = 128) THEN BEGIN
		domult := false;		{ end of mult }
		bufcnt := 0;
		GOTO 999
	    END;

	    IF buf[1] > 128 THEN		{ negative return is an err }
		GOTO 999;

	    IF buf[1] = 2 THEN BEGIN		{ start of mult }
		domult := true;			 { set flag}
		bufcnt := 0;			 { force refil }
		goto 111			 { start all over }
	    END;

	    IF buf[1] <> 1 THEN			{ mult data? }
		GOTO 999;			 { boy are we dumb! }

	    bufcnt := bufcnt - 4;		{ eat resp, and err bytes }
	    bufpnt := bufpnt + 4

	END; {if bufcnt = 0}

	IF bufcnt < 1 THEN			{ expecting entity id }
	    GOTO 999;

	i := buf[bufpnt];			{ get entity leng. }
	bufpnt := bufpnt + 1;
	bufcnt := bufcnt - 1;

	FOR j := 1 TO i DO BEGIN		{ copy entity id }
	    IF bufcnt <= 0 THEN
		GOTO 999;			{ *RAN OUT* }
	    IF j <= CIRCSIZE THEN
		cname[j] := chr( buf[bufpnt] MOD 128 );
	    bufpnt := bufpnt + 1
	END;

	bufcnt := bufcnt - i;

	state := -1;
	substate := -1;
	nodenum := -1;
	loop2 := true;

	WHILE loop2 DO BEGIN			{ loop for parameters }
	    if bufcnt = 0 THEN BEGIN
		loop1 := false;
		GOTO 111
	    END
	    ELSE IF bufcnt < 2 THEN
		GOTO 999;

	    i := buf[bufpnt+1] * 256 + buf[bufpnt];
	    bufpnt := bufpnt + 2;
	    bufcnt := bufcnt - 2;

	    IF i = 0 THEN BEGIN
		IF bufcnt < 2 THEN GOTO 999;
		IF buf[bufpnt] <> 129 THEN GOTO 999; { 0201 coded single}
		state := buf[bufpnt+1];
{		writeln('state: ',state);	}
		bufpnt := bufpnt + 2;
		bufcnt := bufcnt - 2
	    END
	    ELSE IF i = 1 THEN BEGIN
		IF bufcnt < 2 THEN GOTO 999;
		IF buf[bufpnt] <> 129 THEN GOTO 999; { 0201 coded single }
		substate := buf[bufpnt+1];
{		writeln('substate: ',substate);	}
		bufpnt := bufpnt + 2;
		bufcnt := bufcnt - 2
	    END
	    ELSE IF i = 800 THEN BEGIN
		IF bufcnt < 4 THEN GOTO 999;
		IF buf[bufpnt] <> 194 THEN GOTO 999; { 0302 coded mult, 2 rec }

		IF buf[bufpnt+1] <> 2 THEN GOTO 999; { uns dec, len 2 }
		bufpnt := bufpnt + 2;
		nodenum := buf[bufpnt+1] * 256 + buf[bufpnt];
{		writeln('nodenum: ',nodenum);	}
		bufcnt := bufcnt - 4;
		bufpnt := bufpnt + 2;

		IF bufcnt < 1 THEN GOTO 999;
		IF buf[bufpnt] <> 64 THEN GOTO 999; { 0100 = coded ascii }
		bufcnt := bufcnt - 1;
		bufpnt := bufpnt + 1;

		IF bufcnt < 1 THEN GOTO 999;
		i := buf[bufpnt];
		bufcnt := bufcnt - 1;
		IF (bufcnt < i) OR (i > NODESIZE) THEN GOTO 999;
		FOR j := 1 to I DO
		    nname[j] := chr( buf[bufpnt+j] MOD 128 );
{		writeln('nname: ',nname);	}
		bufpnt := bufpnt + i;
		bufcnt := bufcnt - i
	    END
	    ELSE BEGIN
		writeln('?Unknown parameter type ',i);
		GOTO 999
	    END;

{	    writeln('bufcnt: ',bufcnt);	}
	    IF bufcnt = 0 THEN loop2 := false;
	END; {while}

	IF (state <> 0) AND (state <> -1) THEN
	    GOTO 111				{ not on }
	ELSE IF substate <> -1 THEN
	    GOTO 111				{ funny substate set ? }
	ELSE BEGIN
	    nextcircuit := true;
	    bufcnt := 0;
	    GOTO 999
	END;

111:
    END; {while loop1}

999:
END; {nextcircuit}

{****************************************************************}

FUNCTION findcircuit( exec : refnode; cname : circname ) : refcircuit;
VAR
    cp, it : refcircuit;

BEGIN
    cp := exec^.clist;
    it := nil;
    WHILE (cp <> nil) AND (it = nil) DO BEGIN
	IF cname = cp^.id THEN
	    it := cp
	ELSE
	    cp := cp^.next
    END; {while}

    IF it = nil THEN BEGIN		{ no such circuit found? }
	new(it);			{ create new circuit block }
	it^.id := cname;		{ set its id }
	it^.nodelist := nil;		{ no node list yet }
	it^.owner := exec;		{ set owner }
	it^.next := exec^.clist;	{ link into executor's list }
	exec^.clist := it		{ of circuits }
    END;

    findcircuit := it
END; {findcircuit}

{****************************************************************}

FUNCTION docircuits( exec : refnode) : integer;
VAR
    cname : circname;
    nname : nodename;
    cp : refcircuit;
    np : refnode;
    lp : refnlist;
    count : integer;

BEGIN
    count := 0;
    WHILE nextcircuit( cname, nname ) DO BEGIN
	IF (cname <> EMPTYCIRC) AND (nname <> EMPTYNODE) THEN BEGIN
	    count := count + 1;
	    writeln('  ',cname,' to ',nname);
	    cp := findcircuit( exec, cname );
	    new(lp);
            lp^.next := cp^.nodelist;
	    lp^.nptr := findnode( nname );
            cp^.nodelist := lp
	END {if}
    END; {while}
    docircuits := count;
END; {docircuits}

{****************************************************************}

PROCEDURE visit( np : refnode );
VAR
    i : integer;
    darr : bdata;
    dptr : bindex;
    done : boolean;

BEGIN
    visitcount := visitcount + 1;

    writeln(np^.name,'... ');

    IF opencon(np^.name) THEN BEGIN
	domult := false;
	bufcnt := 0;
	writeln(' connected');
	np^.failed := false;
	IF showcircuits THEN
	    IF docircuits(np) = 0 THEN
		np^.none := true
	    ELSE
		np^.none := false;
	closecon
    END {if opencon}
    ELSE BEGIN
	writeln(' failed');
	np^.failed := true
    END;

    np^.visited := true

END; {visit}

{****************************************************************}
PROCEDURE dumptable;
VAR
    index : hashindex;
    np : refnode;
    cp : refcircuit;
    lp : refnlist;
    dumpfile : text;

BEGIN
    rewrite(dumpfile,'CRAWL.DMP');
    FOR index := 1 to HASHSIZE DO BEGIN
	np := hashtab[ index ];
	WHILE np <> nil DO BEGIN
	    cp := np^.clist;
	    IF cp = nil THEN
		IF np^.visited THEN
		    IF np^.failed THEN
			writeln(dumpfile,np^.name,' (FAILED)')
		    ELSE IF np^.none THEN
			writeln(dumpfile,np^.name,' (NONE)')
		    ELSE
			writeln(dumpfile,np^.name,' (VISITED?)')
		ELSE
		    writeln(dumpfile,np^.name,' (UNVISTED)');
	    WHILE cp <> nil DO BEGIN
		lp := cp^.nodelist;
		IF lp = nil THEN
		    writeln(dumpfile,np^.name,'/',cp^.id);
		WHILE lp <> nil DO BEGIN
		    writeln(dumpfile,np^.name,'/',cp^.id,'/',lp^.nptr^.name);
		    lp := lp^.next
		END; {while lp}
		cp := cp^.next
	    END; {while cp}
	    np := np^.hnext
	END {while np}
    END; {for}
    close(dumpfile)
END; {dumptable}

{****************************************************************}

PROCEDURE doit;
VAR
    local, start : nodename;
    current : refnode;
    timer : integer;

BEGIN {doit}
    getlocal(local);
    WRITE('Starting node [',local,'] :');
    READLN(start);
    IF start = EMPTYNODE THEN
	start := local;

    visitlist := newnode(start);
    timer := DUMPINTERVAL;

    WHILE visitlist <> nil DO BEGIN
	writeln('known:',knowncount:5,' visited:',visitcount:5);
	IF timer = 0 THEN BEGIN
	    timer := DUMPINTERVAL;
	    dumptable
	END
	ELSE
	    timer := timer - 1;

	current := visitlist;
	visitlist := current^.vnext;
	IF NOT current^.visited THEN
	    visit(current)
    END {while}

END; {doit}

BEGIN {crawl}
    doit;
    dumptable
END.