(* link with -lrt *)


<*+M2EXTENSIONS *>
<*-CHECKDIV *>
<*-CHECKRANGE *>
<*-COVERFLOW *>
<*-IOVERFLOW*>
<*-PROCINLINE*>
<*+NOPTRALIAS*>
<*-CHECKNIL *>
<*-CHECKINDEX*>
<*-CHECKSET*>
<*CPU="PENTIUM"*>
<* IF __GEN_C__ THEN *>
  <*+COMMENT*>
  <*+GENCTYPES*>
  <*-PROCINLINE*>
  <*-GENDEBUG*>
  <*-LINENO*>
  <*-GENHISTORY*>
  <*-GENDATE*>
  <*+NOHEADER*>
  <*+GENCDIV*>
  <*-GENKRC*>
<* ELSE *>
  <*-PROCINLINE*>
  <*-GENDEBUG*>
  <*-LINENO*>
  <*-GENHISTORY*>
<* END *>

<*+WWW*>


MODULE udprfnet; (* udp aprs grid network by OE5DXL *)

<* IF WWW THEN *>
IMPORT tcp;
<* END *>

IMPORT udp;
FROM osi IMPORT WrLn, WrStr, WrStrLn, WrInt, OpenRead, Close, RdBin, NextArg, time,
                ALLOCATE, DEALLOCATE;
(*
FROM FdSet IMPORT FdSet, FD_ZERO, FD_SET, FD_ISSET, TimeVal;
FROM mlib IMPORT select;
*)
FROM Select IMPORT fdclr, fdsetr, issetr, fdsetw, issetw, selectr;
FROM SYSTEM IMPORT CAST, SHIFT, ADR, CARD8, FILL;
FROM aprsstr IMPORT TIME, Assign, Append, Length, TimeToStr, CtrlHex, IntToStr;





CONST MAXLEN=256+7*10+10+2;
      MINLEN=7*2+1+2;
      POLYNOM=BITSET{3,10,15};
      CRCINIT=BITSET{0..15};
      CRCRESULT=BITSET(40715);
      CR=015C;
      LF=012C;
      MAXPATHLEN=80;                         (* header path size limit *)
      NOPORT=0;                              (* locked route udp port *)
      HTTPTIMEOUT=10;
<* IF __GEN_C__ THEN *>
      VERS="udprfnet(c) 0.1";
<* ELSE *>
      VERS="udprfnet 0.1";
<* END *>

TYPE  UDPPORT=CARDINAL;
      IPNUM=CARDINAL;
      SET8=SET OF [0..7];
      MONCALL=ARRAY[0..9] OF CHAR;
      FILENAME=ARRAY[0..1023] OF CHAR;

      pNEIGHBOUR=POINTER TO NEIGHBOUR;
      NEIGHBOUR=RECORD
                  next    :pNEIGHBOUR;
                  call    :MONCALL;
                  toport  :UDPPORT;
                  ipnum   :IPNUM;
                  pri     :CARDINAL;
                  uptime, 
                  heard,
                  pollrtp,
                  pollrtr :TIME;
                  pollcnt :CARDINAL;
                  pollns  :CARDINAL;
                  wantdata:BOOLEAN;
                  nsent, nrec, bsent, brec, medrtt:CARDINAL;
                END; 

      TIMEHR=RECORD
               sec, nsec:CARDINAL;
             END;

VAR CRCL, CRCH            : ARRAY[0..255] OF SET8;
    verb,
    localecho,
    autonode,
    localcheckip          : BOOLEAN;
    duptime, systime, 
    qtime, checktime,
    removetime,
    fastcheck, slowcheck  : TIME;
    localsock, netsock    : INTEGER;
    localfromport, 
    netport, tx2port      : UDPPORT;
    neibors               : pNEIGHBOUR;
    hashtab               : ARRAY[0..65535] OF TIME;
    starthead, netname    : ARRAY[0..63] OF CHAR;
    nodefile              : FILENAME;
    nlocal                : NEIGHBOUR;
<*IF WWW THEN*>
    wwwbindport           : ARRAY[0..5] OF CHAR;
    tbuf                  : ARRAY[0..511] OF CHAR;
    tlen                  : INTEGER;
    connt, upt            : TIME;
    httpcount             : CARDINAL;
<*END*>

PROCEDURE ["C"] / clock_gettime(typ:CARDINAL; VAR tv:TIMEHR):INTEGER;

PROCEDURE Err(text-:ARRAY OF CHAR);
BEGIN
  WrStr("udprfnet: "); WrStr(text); WrStrLn(" error abort");
  HALT
END Err;

PROCEDURE nsec():CARDINAL;
VAR t:TIMEHR; 
    res:INTEGER;
BEGIN
(*
  gettime(t);
*)
  res:=clock_gettime(1,t);
  RETURN t.nsec
END nsec;


PROCEDURE Gencrctab;
CONST POLINOM=08408H;
VAR i,crc,c:CARDINAL;
BEGIN
  FOR c:=0 TO 255 DO
    crc:=255-c;
    FOR i:=0 TO 7 DO
      IF ODD(crc) THEN crc:=CAST(CARDINAL, CAST(BITSET, ASH(crc, -1))/CAST(BITSET,POLINOM))
      ELSE crc:=ASH(crc, -1) END;
    END;
    CRCL[c]:=CAST(SET8, crc);
    CRCH[c]:=CAST(SET8, 255 - ASH(crc, -8));
  END;
END Gencrctab;




PROCEDURE getudp(fd:INTEGER; VAR buf:ARRAY OF CHAR; VAR fromip:IPNUM; VAR fromport:UDPPORT);
VAR len:INTEGER;
BEGIN
  len:=udp.udpreceive(fd, buf, SIZE(buf)-1, fromport, fromip);
  IF len<0 THEN len:=0 END;
  buf[len]:=0C;
END getudp; 

(*
PROCEDURE sendudp(b-:ARRAY OF CHAR);
VAR i:INTEGER;
BEGIN
  i:=udp.udpsend(udpsock, buf, len+2, toport, ipnum);
END sendudp;
*)


PROCEDURE Dup(b-:ARRAY OF CHAR):BOOLEAN;
VAR p, in, sum    :CARDINAL;
    hashl, hashh  :SET8;
    last          :CHAR;

  PROCEDURE hash(c:CHAR);
  VAR b:CARD8;
  BEGIN
(*
IO.WrStr("<");IO.WrChar(c);IO.WrStr(">");
*)
    IF c<>" " THEN
      b:=CAST(CARD8, CAST(SET8, c) / hashl);
      hashl:=CRCL[b] / hashh;
      hashh:=CRCH[b];
    END;
  END hash;

BEGIN
  hashl:=SET8{};
  hashh:=SET8{};
  p:=0;
  in:=0;
  last:=0C;
(*
  WHILE (b[p]<>0C) & ((last<>":") OR (b[p]="}")) DO last:=b[p]; INC(p) END;
*)
  LOOP
    IF b[p]=0C THEN EXIT END;
    IF last=":" THEN
      IF b[p]="}" THEN in:=p+1 ELSE EXIT END;
    END;
    last:=b[p]; 
    INC(p);
  END;
  WHILE (b[in]<>0C) & (b[in]<>">") DO hash(b[in]); INC(in) END;
  WHILE (b[in]<>0C) & (b[in]<>"-") & (b[in]<>",") & (b[in]<>":") DO hash(b[in]); INC(in) END;
  WHILE (b[p]<>0C) & (b[p]<>CR) DO hash(b[p]); INC(p) END;
  sum:=ORD(CAST(CHAR, hashl)) + ORD(CAST(CHAR, hashh))*256;
  IF hashtab[sum]>systime THEN RETURN TRUE END;
  hashtab[sum]:=systime+duptime;
  RETURN FALSE
END Dup;


PROCEDURE findneibor(chain:pNEIGHBOUR; ip:IPNUM):pNEIGHBOUR;
BEGIN
  WHILE (chain<>NIL) & (chain^.ipnum<>ip) DO chain:=chain^.next END;
  RETURN chain
END findneibor;

PROCEDURE unchain(VAR chain:pNEIGHBOUR; u:pNEIGHBOUR);
VAR n,last:pNEIGHBOUR;
BEGIN
  n:=chain;
  last:=NIL;
  WHILE (n<>NIL) & (n<>u) DO last:=n; n:=n^.next END;
  IF n<>NIL THEN
    IF last<>NIL THEN last^.next:=n^.next END;
    IF chain=n THEN chain:=n^.next END;
  END;
END unchain;

PROCEDURE chain(u:pNEIGHBOUR);
VAR n:pNEIGHBOUR;
BEGIN
  u^.next:=NIL;
  n:=neibors;
  IF n=NIL THEN neibors:=u ELSE
    WHILE n^.next<>NIL DO n:=n^.next END;
    n^.next:=u;
  END;
END chain;


PROCEDURE addneibor(ip:IPNUM; port:UDPPORT):pNEIGHBOUR;
VAR n:pNEIGHBOUR;
BEGIN
  n:=findneibor(neibors, ip);
  IF n=NIL THEN
    ALLOCATE(n, SIZE(n^));
    IF n=NIL THEN Err("out of memory") END;
    FILL(n, 0C, SIZE(n^));
    n^.ipnum:=ip;
    chain(n);
  END;
  n^.toport:=port;
  RETURN n
END addneibor;


PROCEDURE str2ip(h-:ARRAY OF CHAR; VAR p:CARDINAL; VAR ip:IPNUM; nolp:BOOLEAN; VAR dp, lp:UDPPORT; VAR check:BOOLEAN):INTEGER;
VAR i, n:CARDINAL;
    ok:BOOLEAN;
BEGIN
(*
i:=p;
WHILE h[i]>" " DO IO.WrChar(h[i]); INC(i) END; IO.WrLn;
*)
  ip:=0;
  FOR i:=0 TO 5 DO
    n:=0;
    ok:=FALSE;
    WHILE (p<HIGH(h)) & (h[p]>="0") & (h[p]<="9") DO
      ok:=TRUE;
      n:=n*10+ORD(h[p])-ORD("0");
      INC(p);
    END;
    IF NOT ok THEN RETURN -1 END;
    IF i<3 THEN
      IF (h[p]<>".") OR (n>255) THEN RETURN -1 END;
      ip:=ip*256+n;
    ELSIF i=3 THEN
      ip:=ip*256+n;
      IF (h[p]<>":") OR (n>255) THEN RETURN -1 END;
    ELSIF i=4 THEN
      dp:=n;
      IF n>65535 THEN RETURN -1 END;
      IF nolp THEN RETURN 0 END;

      check:=h[p]="/";
      IF (h[p]<>":") & (h[p]<>"/") THEN RETURN -1 END;
    ELSIF n>65535 THEN RETURN -1 END;
    lp:=n;
    INC(p);
  END;  
  RETURN 0
END str2ip;


PROCEDURE GetNum(h-:ARRAY OF CHAR; eot:CHAR; VAR p,n:CARDINAL):BOOLEAN;
BEGIN
  n:=0;
  WHILE (h[p]>="0") & (h[p]<="9") DO
    n:=n*10+ORD(h[p])-ORD("0");
    INC(p);
  END;
  INC(p);
  RETURN h[p-1]=eot
END GetNum;

(*
PROCEDURE GetSec(h:ARRAY OF CHAR; VAR p, n:CARDINAL):INTEGER;
VAR ok:BOOLEAN;
BEGIN
  h[HIGH(h)]:=0C;
  n:=0;
  ok:=FALSE;
  WHILE (h[p]>="0") & (h[p]<="9") DO
    ok:=TRUE;
    n:=n*10+ORD(h[p])-ORD("0");
    INC(p);
  END;
  IF NOT ok THEN RETURN -1 END;
(*
IO.WrCard(n,10); IO.WrLn;
*)
  RETURN 0
END GetSec;
*)



(*
PROCEDURE getfix(VAR x:REAL; s-:ARRAY OF CHAR; VAR p:CARDINAL):BOOLEAN;
VAR i:CARDINAL;
    h:ARRAY[0..255] OF CHAR;
BEGIN
  i:=0;
  WHILE (s[p]>" ") & (s[p]<>"/") & (i<HIGH(h)) DO h[i]:=s[p]; INC(i); INC(p) END;
  h[i]:=0C;
  IF StrToFix(x, h) THEN RETURN TRUE END;
  RETURN FALSE
END getfix;
*)

PROCEDURE parms;
VAR h      : ARRAY[0..4095] OF CHAR;
    err    : BOOLEAN;
    lasth  : CHAR;
    i, n   : CARDINAL;
BEGIN
  err:=FALSE;
  LOOP
    NextArg(h);
    IF h[0]=0C THEN EXIT END;
    IF (h[0]="-") & (h[1]<>0C) & (h[2]=0C) THEN
      lasth:=h[1];
      IF lasth="a" THEN autonode:=TRUE; 

      ELSIF lasth="c" THEN
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, ":", i, checktime) 
        OR NOT GetNum(h, 0C, i, n) THEN Err("-c s:s") END;
        qtime:=checktime+n;
         
      ELSIF lasth="i" THEN
        NextArg(nlocal.call);

      ELSIF lasth="d" THEN
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, duptime) THEN Err("-d number") END;

      ELSIF lasth="e" THEN localecho:=TRUE;

      ELSIF lasth="f" THEN
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, fastcheck) THEN Err("-f seconds") END;

      ELSIF lasth="n" THEN
        NextArg(netname);

      ELSIF lasth="h" THEN
        WrLn;
        WrStrLn(" -a                     accept new neighbours");
        WrStrLn(" -c <sec:sec>           check link time : stop transfer after no reply");
        WrStrLn(" -d <seconds>           dupe filter time (default 57s min 27s)");
        WrStrLn(" -e                     echo local received frames");
        WrStrLn(" -f <seconds>           poll intervall until reply (default 10s)");
        WrStrLn(" -h                     this");
        WrStrLn(" -i <mycall>");
        WrStrLn(" -p <portnum>           network udp listen port");
        WrStrLn(" -M <ipnum:dport:lport> tnc-2 format local udp link");
        WrStrLn(" -m <portnum>           send a copy in tnc-2 monitor to this port");
        WrStrLn(" -n <netname>");
        WrStrLn(" -r <filename>          static routes config file");
        WrStrLn(" -s <seconds>           poll intervall dead link (default 180s)");
        WrStrLn(" -v                     verbous to stdout");
<*IF WWW THEN*>
        WrStrLn(" -w <portnum>           www server listen port");
<*END*>
        WrStrLn("udprfnet -i OE0AAA -a -e -M 127.0.0.1:2010:2020 -r routes.txt");
        WrLn;

        HALT

      ELSIF lasth="M" THEN 
        NextArg(h);
        i:=0;
        IF str2ip(h, i, nlocal.ipnum, FALSE, nlocal.toport, localfromport, localcheckip)<0 
        THEN Err("need -M ipnum:dport:lport") END;
        localsock:=udp.openudp();
        IF (localsock<0) OR (udp.bindudp(localsock, localfromport)<0)
        THEN Err("cannot open udp socket") END;

      ELSIF lasth="p" THEN
        NextArg(h);
        i:=0; 
        IF NOT GetNum(h, 0C, i, netport) THEN Err("-p number") END;

      ELSIF lasth="m" THEN
        IF nlocal.toport=NOPORT THEN Err("need -M before -m secondport") END;
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, tx2port) THEN Err("-m number") END;

      ELSIF lasth="r" THEN
        NextArg(nodefile);

      ELSIF lasth="s" THEN
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, slowcheck) THEN Err("-s seconds") END;

      ELSIF lasth="v" THEN verb:=TRUE;

<*IF WWW THEN*>
      ELSIF lasth="w" THEN NextArg(wwwbindport);
<*END*>

      ELSE err:=TRUE END;
      h[0]:=0C;
    ELSE err:=TRUE END;
    IF err THEN EXIT END;
  END;
  IF err THEN WrStr(">"); WrStr(h); WrStrLn("< use -h"); HALT END;

END parms;

PROCEDURE showpip(ip:IPNUM; port:UDPPORT);
BEGIN
  WrInt(ip DIV 1000000H,1); WrStr(".");
  WrInt(ip DIV 10000H MOD 100H ,1); WrStr(".");
  WrInt(ip DIV 100H MOD 100H ,1); WrStr(".");
  WrInt(ip MOD 100H ,1); WrStr(":");
  WrInt(port, 1);
END showpip;

PROCEDURE ipp2str(ip:IPNUM; port:UDPPORT; VAR s:ARRAY OF CHAR);
VAR h:ARRAY[0..255] OF CHAR;
BEGIN
  IntToStr(ip DIV 1000000H,1,s); Append(s,".");
  IntToStr(ip DIV 10000H MOD 100H ,1,h); Append(s,h); Append(s,".");
  IntToStr(ip DIV 100H MOD 100H ,1,h); Append(s,h); Append(s,".");
  IntToStr(ip MOD 100H ,1, h); Append(s,h); Append(s,":");
  IntToStr(port, 1, h);Append(s,h);
END ipp2str;


PROCEDURE showdata(b:ARRAY OF CHAR; len:CARDINAL);
BEGIN
  IF len<=HIGH(b) THEN b[len]:=0C END;
  CtrlHex(b);
  WrStrLn(b);
(*
  IF len>70 THEN IO.WrLn END;
*)
END showdata;




PROCEDURE noloop(b-:ARRAY OF CHAR; w-:ARRAY OF CHAR):BOOLEAN;
VAR i, j:CARDINAL;
BEGIN
  i:=0;
  WHILE (b[i]<>0C) & (b[i]<>":") DO
    j:=0;
    WHILE b[i+j]=w[j] DO INC(j) END;
    IF w[j]=0C THEN RETURN FALSE END;
    INC(i);
  END;
  RETURN TRUE
END noloop;

PROCEDURE alive(n:pNEIGHBOUR; since:TIME):BOOLEAN;
BEGIN RETURN (n^.call[0]<>0C) & (n^.pollrtr+since>=systime) END alive; 


PROCEDURE sendall(b:ARRAY OF CHAR; local:BOOLEAN);
VAR ilen,mylen,hlen,len,j,lastpri:CARDINAL;
    best:BOOLEAN;
    res:INTEGER;
    n:pNEIGHBOUR;
BEGIN
  IF b[0]=0C THEN RETURN END;

  IF Dup(b) THEN 
    IF verb THEN WrStr("dup:"); showdata(b, Length(b)) END;
    RETURN
  ELSIF verb THEN WrLn; WrStr("rx: "); showdata(b, Length(b)) END;

  ilen:=0;
  WHILE b[ilen]<>":" DO                                           (* find end of transport head *)
    IF b[ilen]=0C THEN RETURN END;

    INC(ilen);
  END;
  hlen:=ilen;
  IF hlen>MAXPATHLEN THEN RETURN END;                          (* limit hopps *)

  WHILE b[ilen]<>0C DO INC(ilen) END;                          (* len of all *)
  INC(ilen);                                                   (* 0C at end will be sent *)
  mylen:=Length(nlocal.call)+1;
  IF mylen<2 THEN RETURN END;                                  (* no valid append call *)


  IF b[hlen+1]<>"}" THEN RETURN END;                           (* not a transport head *)

  IF local & (nlocal.toport<>NOPORT) THEN
    res:=udp.udpsend(localsock, b, ilen, nlocal.toport, nlocal.ipnum);
    IF tx2port<>NOPORT THEN res:=udp.udpsend(localsock, b, ilen, tx2port, nlocal.ipnum) END;

    INC(nlocal.nsent);
    INC(nlocal.bsent, ilen);

    IF verb THEN WrStr("tx: "); showpip(nlocal.ipnum, nlocal.toport); WrLn; END;

  END;

  len:=ilen+mylen;
  IF len>=HIGH(b) THEN RETURN END;                             (* result too long *)

  WHILE ilen>=hlen DO b[ilen+mylen]:=b[ilen]; DEC(ilen) END;
  INC(ilen);
  b[ilen]:=","; INC(ilen);
  FOR j:=0 TO mylen-2 DO b[ilen]:=nlocal.call[j]; INC(ilen) END;

  n:=neibors;
  lastpri:=MAX(CARDINAL);
  best:=TRUE;
  WHILE n<>NIL DO
    WITH n^ DO
      IF pri<=lastpri THEN best:=TRUE END;                     (* new routes line *)  
      lastpri:=pri;
      IF (toport<>NOPORT) & alive(n, qtime) THEN
        
        IF wantdata & best & noloop(b, call) THEN

          IF verb THEN WrStr("tx: "); showpip(ipnum, toport); WrLn; END;

          res:=udp.udpsend(netsock, b, len, toport, ipnum);
          INC(nsent);
          INC(bsent, len);
        END; 
        best:=FALSE;
      END;
    END;
    n:=n^.next;
  END;
 
(*
IO.WrStr("<"); IO.WrStr(b); IO.WrStrLn(">");
*)  
END sendall;


PROCEDURE pollstr(VAR b:ARRAY OF CHAR; VAR p:CARDINAL; pn:pNEIGHBOUR);
VAR i:CARDINAL;
BEGIN
  p:=0;
  WHILE (p<=HIGH(starthead)) & (starthead[p]<>":") DO b[p]:=starthead[p]; INC(p) END;
  b[p]:=","; INC(p);
  i:=0;
  IF pn^.call[0]<>0C THEN
    WHILE (i<=HIGH(pn^.call)) & (pn^.call[i]<>0C) DO b[p]:=pn^.call[i]; INC(p); INC(i) END;
  ELSE
    b[p]:="W"; INC(p);
    b[p]:="H"; INC(p);
    b[p]:="O"; INC(p);
    b[p]:="I"; INC(p);
    b[p]:="S"; INC(p);
  END;
  b[p]:=","; INC(p);
  b[p]:="R"; INC(p);
  b[p]:="T"; INC(p);
END pollstr;

PROCEDURE pollnr(VAR b:ARRAY OF CHAR; n:CARDINAL);
BEGIN
  b[0]:=CHR(n DIV 100 MOD 10+ORD("0"));
  b[1]:=CHR(n DIV 10 MOD 10+ORD("0"));
  b[2]:=CHR(n MOD 10+ORD("0"));
END pollnr;


PROCEDURE checksrc(b-:ARRAY OF CHAR; c-:ARRAY OF CHAR):BOOLEAN;
VAR i:CARDINAL;
BEGIN
  i:=0;
  WHILE (i<HIGH(c)) & (c[i]=b[i]) DO INC(i) END;
  RETURN (b[i]=">") & (c[i]=0C);
END checksrc;

PROCEDURE checkdest(b-:ARRAY OF CHAR; via:CARDINAL):BOOLEAN;
VAR i:CARDINAL;
BEGIN
  i:=0;
  WHILE (i<HIGH(nlocal.call)) & (nlocal.call[i]=b[via]) DO INC(i); INC(via) END;
  RETURN (b[via]=",") & (nlocal.call[i]=0C)
END checkdest;


PROCEDURE setcall(b-:ARRAY OF CHAR; VAR c:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
  i:=0;
  WHILE (i<HIGH(c)) & (b[i]<>">") DO c[i]:=b[i]; INC(i) END;
  c[i]:=0C;
END setcall;


PROCEDURE statneibor(b-:ARRAY OF CHAR; fromip:IPNUM; fromport:UDPPORT):BOOLEAN;
VAR n:pNEIGHBOUR;
    i, j, len, via, rtt:CARDINAL;
    pb,h: ARRAY[0..255] OF CHAR;
    res:INTEGER;
BEGIN
  len:=Length(b);
  n:=findneibor(neibors, fromip);
  IF (n<>NIL) & (n^.toport=NOPORT) THEN RETURN FALSE END;                  (* route locked *)

  IF n=NIL THEN 
    IF autonode THEN n:=addneibor(fromip, fromport) ELSE RETURN FALSE END;
    IF n=NIL THEN RETURN FALSE END;                           (* out of memory or locked *)
    n^.pri:=0;                                                (* mark as autonode *)
  END;

  n^.heard:=systime;

  i:=0;
  WHILE (i<len) & (b[i]<>">") DO INC(i) END;
  INC(i);
  j:=0;
  LOOP
    IF netname[j]=0C THEN EXIT END;
    IF netname[j]<>b[i] THEN 
      IF verb THEN showpip(n^.ipnum, n^.toport); WrStrLn(" got wrong netname"); END;
      RETURN FALSE
    END;                (* netname wrong *)  
    INC(i);
    INC(j);
  END;
  IF b[i]<>"," THEN RETURN FALSE END;                         (* from>netname, *)
  INC(i);
  via:=i;

  WHILE i<len DO
    IF (b[i]=",") & (b[i+1]="R") & (b[i+2]="T") THEN
      WITH n^ DO
        IF (b[i+3]="P") OR (b[i+3]="S") THEN                              (* got RT(P/S)nnn *)
          wantdata:=b[i+3]="P";
          IF (pri>1) & (pollrtp+qtime<systime) THEN RETURN FALSE END; (* sleeping 2nd link *)     

          IF NOT (checksrc(b, call) & checkdest(b, via)) THEN   (* get poll from unkown src *)
            pollrtr:=0;
            medrtt:=0;
            IF (b[via]="W")&(b[via+1]="H")&(b[via+2]="O")
            &(b[via+3]="I")&(b[via+4]="S")&(b[via+5]=",") THEN 
              pollrtp:=0; 
              setcall(b, call);

              IF verb THEN showpip(ipnum, toport); WrStr(" got WHOIS from "); WrStrLn(call) END;

            ELSE 
(*
              IF verb THEN showpip(ipnum, toport); WrStrLn(" sends wrong mycall ") END;
*)
              call[0]:=0C; 
              RETURN FALSE
            END;
          END;
          pollstr(pb, j, n);
          IF pri=0 THEN pb[j]:="A" ELSE pb[j]:="R" END; 
          INC(j);
          pb[j]:=b[i+4]; INC(j);
          pb[j]:=b[i+5]; INC(j);
          pb[j]:=b[i+6]; INC(j);
          pb[j]:=":"; INC(j);
          pb[j]:=0C; INC(j);
          res:=udp.udpsend(netsock, pb, j, toport, ipnum);  
          RETURN FALSE

        ELSIF (b[i+3]="R") OR (b[i+3]="A") THEN               (* got RT(R/A)nnn *)
          pollnr(h,pollcnt);
          IF (b[i+4]=h[0])&(b[i+5]=h[1])&(b[i+6]=h[2]) THEN   (* RTR num fits *)
            IF checkdest(b, via) THEN                         (* destination call fits *)
              IF uptime=0 THEN
                uptime:=systime;
                nsent:=0;
                bsent:=0;
                nrec:=0;
                brec:=0;
                medrtt:=0;
                call[0]:=0C;
              END;
              IF NOT checksrc(b, call) THEN 
                setcall(b, call);

                IF verb
                THEN showpip(ipnum, toport); WrStr(" got RTR and set call from "); WrStrLn(call) END;

              END; 
              IF (pri=0) & (b[i+3]="A") THEN pollrtr:=0       (* both sides autoroute *) 
              ELSE pollrtr:=systime END;
              rtt:=nsec();
              rtt:=(rtt-pollns) DIV 1000;
              IF medrtt=0 THEN medrtt:=rtt ELSE INC(medrtt, VAL(INTEGER, rtt-medrtt) DIV 10) END;

              IF verb
              THEN showpip(ipnum, toport); WrStr(" new rtt="); WrInt(medrtt, 1); WrStrLn("us") END;

            ELSE 

              IF verb THEN showpip(ipnum, toport); WrStrLn(" reply wrong mycall ") END;

              call[0]:=0C;
              pollrtr:=0;                                     (* reset link *)       
            END;
          ELSE 

            IF verb THEN showpip(ipnum, toport); WrStrLn(" got wrong RTR number") END;

            pollrtr:=systime-qtime;                           (* long delay, stop data tx *)
          END;
          RETURN FALSE
        END;
      END;
 
    END;
    INC(i);
  END;

  INC(n^.nrec);
  INC(n^.brec, len);
  RETURN TRUE
END statneibor;


PROCEDURE needdata(tn:pNEIGHBOUR):BOOLEAN;
VAR n:pNEIGHBOUR;
BEGIN
  IF nlocal.toport<>NOPORT THEN RETURN TRUE END;               (* local need data *)
  n:=neibors;                                                  (* look if other neibor needs data *)
  WHILE n<>NIL DO
    IF (n<>tn) & (n^.wantdata) THEN RETURN TRUE END;
    n:=n^.next;
  END;
  RETURN FALSE                                                 (* noone needs data *) 
END needdata;


PROCEDURE checklinks;
VAR n:pNEIGHBOUR;
    j, lastpri :CARDINAL;
    try                   :BOOLEAN;
    ct                    :TIME;
    pb, h                 :ARRAY[0..255] OF CHAR;
    res                   :INTEGER;
BEGIN 
  lastpri:=MAX(CARDINAL);
  try:=TRUE;
  n:=neibors;
  WHILE n<>NIL DO
    WITH n^ DO
(*
IO.WrCard(pollrtr,1);IO.WrStrLn("=pollrtr");
*)
      IF pri<=lastpri THEN try:=TRUE END;
      lastpri:=pri;
      ct:=slowcheck;
      IF alive(n, qtime) THEN ct:=fastcheck 
      ELSE uptime:=0 END;

      IF (toport<>NOPORT) & try & (pollrtr+checktime<systime) THEN
        IF pollrtp+ct<systime THEN        
          pollrtp:=systime;
          INC(pollcnt);
          pollns:=nsec();

          IF verb THEN showpip(ipnum, toport); WrStrLn(" send check poll") END;

          pollstr(pb, j, n);
          IF needdata(n) THEN pb[j]:="P" ELSE pb[j]:="S" END; 
          INC(j);
          pollnr(h, pollcnt);
          pb[j]:=h[0]; INC(j);
          pb[j]:=h[1]; INC(j);
          pb[j]:=h[2]; INC(j);
          pb[j]:=":"; INC(j);
          pb[j]:=0C; INC(j);
          res:=udp.udpsend(netsock, pb, j, n^.toport, n^.ipnum);
        END; 
      END;
      IF alive(n, qtime) THEN try:=FALSE END;

      n:=next;
    END;
  END;
END checklinks;

PROCEDURE readroutes;
VAR f, l:INTEGER;
    n, old:pNEIGHBOUR; 
    h:ARRAY[0..65535] OF CHAR;
    pr, p, len:CARDINAL;
    ok:BOOLEAN;
    ip:IPNUM;
    fromport, port:UDPPORT;
BEGIN
  len:=0;  
  IF nodefile[0]<>0C THEN   
    f:=OpenRead(nodefile);
    IF f<0 THEN 
      IF verb THEN WrStr("routefile not readable <"); WrStr(nodefile); WrStrLn(">"); END;
    ELSE 
      l:=RdBin(f, h, HIGH(h));  
      Close(f);
      IF l<0 THEN 
        IF verb THEN WrStr("routefile not read error <"); WrStr(nodefile); WrStrLn(">"); END;
      ELSE len:=l END;
    END;
  END;
  h[len]:=0C;
  old:=neibors;
  neibors:=NIL;
  p:=0;
  pr:=0;
  WHILE p<len DO
    IF h[p]="#" THEN 
      WHILE (p<len) & (h[p]>=" ") DO INC(p) END;
      WHILE (p<len) & (h[p]<" ") DO INC(p) END;
    ELSE  
      IF str2ip(h, p, ip, TRUE, port, fromport, ok)>=0 THEN
        n:=findneibor(old, ip);
        IF n<>NIL THEN
          unchain(old, n);
          n^.toport:=port;
          chain(n);
        ELSE n:=addneibor(ip, port) END;
        IF n<>NIL THEN n^.pri:=pr+1 END;
        INC(pr);
      ELSIF verb THEN WrStrLn("routefile wrong ip:port number") END;
      
      WHILE (p<len) & (h[p]=" ") DO INC(p) END;
      IF h[p]<" " THEN pr:=0 END;       
      WHILE (p<len) & (h[p]<" ") DO INC(p) END;
    END;
  END;
  WHILE old<>NIL DO
    n:=old;
    old:=old^.next;
    IF (n^.pri=0) & alive(n, removetime) THEN chain(n)
    ELSE 

      IF verb THEN showpip(n^.ipnum, n^.toport); WrStrLn(" dead autoroute removed") END;

      DEALLOCATE(n, SIZE(n));
    END; 
  END;    
END readroutes;


PROCEDURE showroutes;
VAR n:pNEIGHBOUR;
    h:ARRAY[0..255] OF CHAR;
BEGIN
  n:=neibors;
  WrStrLn("routing table:==============================");
  WHILE n<>NIL DO
    WITH n^ DO
      showpip(ipnum, toport); 
      WrStr(" pri="); WrInt(pri, 1);
      IF uptime>0 THEN TimeToStr(systime-uptime, h); WrStr(" up:"); WrStr(h); END;
      WrStr(" "); WrStr(call);
      IF heard>0 THEN WrStr(" heard:"); WrInt(systime-heard, 1) END;
      WrStr(" rtt:"); WrInt(medrtt, 1);
      WrStr(" tf:"); WrInt(nsent, 1);
      WrStr(" rf:"); WrInt(nrec, 1);
      WrLn;
      n:=next;
    END;
  END;
  WrStrLn("============================================");
END showroutes;

<*IF WWW THEN*>

PROCEDURE cmpfrom(a-:ARRAY OF CHAR; from:CARDINAL; b-:ARRAY OF CHAR):BOOLEAN;
VAR i:CARDINAL;
BEGIN
  i:=0;
  WHILE (from<=HIGH(a)) & (b[i]<>0C) DO
    IF a[from]<>b[i] THEN RETURN FALSE END;
    INC(i);
    INC(from);
  END;
  RETURN TRUE
END cmpfrom;



PROCEDURE Www(VAR sock:INTEGER);

CONST MAXRED=120;

VAR h      : ARRAY[0..1023] OF CHAR;
    h1     : ARRAY[0..255] OF CHAR;
    res, 
    maxbs  : INTEGER;
    tt     : TIME;
    i      : CARDINAL;
    n,ln   : pNEIGHBOUR;

  PROCEDURE hex(n:CARDINAL):CHAR;
  BEGIN
    IF n>9 THEN INC(n, ORD("A")-10-ORD("0")) END;
    RETURN CHR(n+ORD("0"))
  END hex;

  PROCEDURE wint(n, col:INTEGER; red:BOOLEAN);
  VAR h1:ARRAY[0..15] OF CHAR;
      a,b:CHAR;
  BEGIN    
    col:=0E0H-col;
    IF col<0 THEN col:=0 END;
    h1:="E0E0E0";
    a:=hex(col DIV 16);
    b:=hex(col MOD 16);

    h1[4]:=a; h1[5]:=b;
    IF red THEN h1[2]:=a; h1[3]:=b; ELSE h1[0]:=a; h1[1]:=b; END;
    Append(h, '<TD style="text-align:right" BGCOLOR="#'); 
    Append(h, h1);
    Append(h, '">');
    IntToStr(n,  1, h1); 
    Append(h, h1); Append(h, "</TD>");
  END wint;

BEGIN
  res:=tcp.readsock(sock, h, SIZE(h)-1);
  IF res<0 THEN
    Close(sock);
    sock:=-1;
    RETURN
  END;
  h[res]:=0C;
  i:=0;
  WHILE (i<=8) & NOT cmpfrom(h, i, " / ") DO INC(i) END;
  REPEAT UNTIL tcp.readsock(sock, h, SIZE(h))<=0;                (* clear iput buffer *)

  IF i>=8 THEN
    h:='HTTP/1.1 404'+CR+LF;
  ELSE

    INC(httpcount);
    h:='HTTP/1.0 200 OK'+CR+LF
    +'Content-Type: text/html; charset=iso-8859-1'+CR+LF+CR+LF;

    res:=tcp.sendsock(sock, h, Length(h));
    h:='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'+CR+LF
    +'"http://www.w3.org/TR/html4/loose.dtd">'+CR+LF
    +'<HTML><HEAD><TITLE>';

    Append(h, nlocal.call);
    Append(h, ' Status Report</TITLE></HEAD><BODY>'+CR+LF);
    res:=tcp.sendsock(sock, h, Length(h));

    h:="";

    h:='<TABLE BORDER="0" CELLPADDING="3" CELLSPACING="1" BGCOLOR="#000000" align="center" SUMMARY="Connection Table">'+CR+LF
      +'<TR VALIGN="BASELINE" BGCOLOR="#E0C0A0">'
      +'<TH COLSPAN=14 style="text-align:center">';

    IF nlocal.call[0]<>0C THEN Append(h, "Server "); Append(h, nlocal.call) END;
    Append(h, " ["+VERS+"] http#");
    IntToStr(httpcount, 1, h1); Append(h, h1);
    Append(h, " Netname ["); Append(h, netname);
    Append(h, "] Inport "); IntToStr(netport, 1, h1); Append(h, h1);
    IF upt<systime THEN TimeToStr(systime-upt, h1); Append(h, " Uptime "); Append(h, h1) END;
    Append(h,'</TH></TR>'+CR+LF
      +'<TR BGCOLOR="#CCCCFF">'+CR+LF+'<TH>Pri</TH><TH>IP</TH><TH>Call</TH><TH>Data</TH>'
      +'<TH>TxByte</TH><TH>TxFr</TH><TH>bit/s</TH>'
      +'<TH>RxByte</TH><TH>RxFr</TH><TH>bit/s</TH><TH>RTT(us)</TH><TH>Heard</TH><TH>Up</TH></TR>');

    res:=tcp.sendmore(sock, h, Length(h));

    nlocal.next:=neibors;
    maxbs:=1;
    ln:=ADR(nlocal);
    n:=ln;
    WHILE n<>NIL DO
      WITH n^ DO
        IF (uptime>0) & (uptime<systime) THEN 
          tt:=systime-uptime;
          res:=bsent*8 DIV tt;
          IF res>maxbs THEN maxbs:=res END;
          res:=brec*8 DIV tt;
          IF res>maxbs THEN maxbs:=res END;
        END;
        n:=next;  
      END;
    END;

    n:=ln;
    WHILE n<>NIL DO
      WITH n^ DO
        IF (uptime>0) & (uptime<systime) THEN tt:=systime-uptime ELSE tt:=0 END;
        h:='<TR style="text-align:center" BGCOLOR="#';
        IF uptime=0 THEN h1:="E0E0E0" ELSIF n=ln THEN h1:="E0E0B0" 
        ELSIF pri=0 THEN h1:="C0D0E0" ELSE h1:="C0E0C0" END;
        Append(h, h1); 
        Append(h,'"><TD>');
        IF pri=0 THEN h1:="auto" ELSE IntToStr(pri,  1, h1) END; Append(h, h1); 
        Append(h, '</TD><TD style="text-align:center">');
        ipp2str(ipnum, toport, h1); Append(h, h1); 
        Append(h, '</TD><TD style="text-align:left">');
        Append(h, call);
        Append(h, '</TD><TD style="text-align:center">');
        IF wantdata THEN Append(h, "yes") ELSE Append(h, "no") END;
        Append(h, "</TD>");
        IF tt>0 THEN res:=bsent*8 DIV tt ELSE res:=0 END;
        wint(bsent,res*MAXRED DIV maxbs,TRUE);
        wint(nsent,res*MAXRED DIV maxbs,TRUE);
        wint(res,  res*MAXRED DIV maxbs,TRUE);
        IF tt>0 THEN res:=brec*8 DIV tt ELSE res:=0 END;
        wint(brec,res*MAXRED DIV maxbs,FALSE);
        wint(nrec,res*MAXRED DIV maxbs,FALSE);
        wint(res, res*MAXRED DIV maxbs,FALSE);
        Append(h, '<TD style="text-align:right">');
        IntToStr(medrtt, 1, h1); Append(h, h1);
        Append(h, "</TD><TD>");
        IF (uptime>0) & (systime>=heard) THEN TimeToStr(systime-heard, h1); Append(h, h1) END; 
        Append(h, "</TD><TD>");
        IF uptime>0 THEN TimeToStr(tt, h1); Append(h, h1) END;
        Append(h, "</TD></TR>");
        res:=tcp.sendmore(sock, h, Length(h));
        n:=next;
      END;
    END;
    h:="</TABLE></BODY></HTML>"+CR+LF;
  END;
  res:=tcp.sendsock(sock, h, Length(h));
  Close(sock);
  sock:=-1;
END Www;
<*END*>


PROCEDURE addhead(VAR b:ARRAY OF CHAR);
VAR i,j,k:CARDINAL;
BEGIN
  j:=Length(b);

  WITH nlocal DO
    INC(nrec);
    INC(brec, j);
    IF (uptime=0) OR (heard+600<systime) THEN
      uptime:=systime;
      nsent:=0;
      bsent:=0;
      nrec:=0;
      brec:=0;
      medrtt:=0;
    END;
    heard:=systime;
  END;


  k:=Length(starthead);
  IF k=0 THEN RETURN END;
  IF j+k>=HIGH(b) THEN b[0]:=0C; RETURN END;
  FOR i:=j TO 0 BY -1 DO b[i+k]:=b[i] END;
  FOR i:=0 TO k-1 DO b[i]:=starthead[i] END; 
END addhead;

VAR (*maxsock,*) res, resi    : INTEGER;
    mbuf                  : ARRAY[0..511] OF CHAR;
(*
    rset, wset            : FdSet;
    tv                    : TimeVal;
*)
    fromip                : IPNUM;
    lasttime              : TIME;
    sport                 : UDPPORT;
<*IF WWW THEN*>
    wwwsock, tcpsock      : INTEGER;
<*END*>

PROCEDURE addsock(fd:INTEGER; wtoo:BOOLEAN);                (* insert socket in fdset for select *)
BEGIN
  IF fd>=0 THEN
    fdsetr(fd);
    IF wtoo THEN fdsetw(fd) END;
(*
    IF fd>maxsock THEN maxsock:=fd END;
*)
  END;
END addsock;



BEGIN
  Gencrctab;
  FILL(ADR(nlocal), 0C, SIZE(nlocal));
  nlocal.pri:=1;
  tx2port:=NOPORT;
  neibors:=NIL;
  duptime:=57;
  nlocal.call:="NOCALL";
  netname:="RFNET";
  autonode:=FALSE;
  nodefile[0]:=0C;

  netport:=9100;
  localecho:=FALSE;

  checktime:=60*2;                                            (* poll link fast *)
  qtime:=checktime+60;                                        (* stop data poll slow *)
  fastcheck:=10;                                              (* poll active link *)
  slowcheck:=qtime;                                           (* poll dead link *)

  verb:=FALSE; 

<*IF WWW THEN*>
  wwwbindport:="9080";
  upt:=systime;
<*END*>

  parms;
  removetime:=qtime+60;                                       (* delete autolink *) 
  IF nlocal.call[0]=0C THEN Err("need mycall") END;
  IF netname[0]=0C THEN Err("need netname") END;
  netname[HIGH(netname)]:=0C;
  nlocal.call[HIGH(nlocal.call)]:=0C;
  systime:=time();
<*IF WWW THEN*>
  upt:=systime;
  IF nlocal.toport<>NOPORT THEN 
    nlocal.uptime:=systime; 
    nlocal.heard:=systime;
    nlocal.wantdata:=TRUE;
  END;
  tcpsock:=-1;
  wwwsock:=-1;
  tlen:=0;
<*END*>

  Assign(starthead, nlocal.call);
  Append(starthead, ">");
  Append(starthead, netname);
  Append(starthead, ":}");

  netsock:=udp.openudp();
  IF (netsock>=0) & (udp.bindudp(netsock, netport)<0) THEN Err("cannot bind inport") END;

  readroutes; 
   
  LOOP
    systime:=time();
    IF lasttime<>systime THEN
      lasttime:=systime;
      checklinks;
      IF systime MOD 30=0 THEN readroutes; IF verb THEN showroutes END; END;    

<*IF WWW THEN*>
      IF (tcpsock<0) & (wwwbindport[0]<>0C) THEN               (* open listensocket www connects *)
        tcpsock:=tcp.waitconnect(wwwbindport,4);
        IF verb & (tcpsock<0) THEN WrStr("cant bind to port "); WrStrLn(wwwbindport) END;
      END;
      IF wwwsock>=0 THEN
        IF connt=0 THEN connt:=systime
        ELSIF connt+HTTPTIMEOUT<systime THEN
          tbuf:="timeout"+CR+LF; 
          res:=tcp.sendsock(wwwsock, tbuf, Length(tbuf));
          Close(wwwsock);
          wwwsock:=-1;
        END;
      END;
<*END*>

    END;

    fdclr;
(*    
    FD_ZERO(rset);
    FD_ZERO(wset);
    maxsock:=0;
*)
    addsock(localsock, FALSE);
    addsock(netsock, FALSE);


<*IF WWW THEN*>
    IF wwwsock<0 THEN addsock(tcpsock, FALSE);                 (* listen only if www is done *)
    ELSE addsock(wwwsock, tlen>0) END;
<*END*>

(*
    tv.tv_usec:=0;
    tv.tv_sec:=1;
    res:=select(maxsock+1, ADR(rset), ADR(wset), NIL, ADR(tv));
    IF FD_ISSET(localsock, rset) THEN
*)
    res:=selectr(1, 0);
    IF issetr(localsock) THEN


      getudp(localsock, mbuf, fromip, sport);
      IF NOT localcheckip OR (fromip=nlocal.ipnum) THEN 
        addhead(mbuf);
        sendall(mbuf, localecho);
      END;
    END;
    IF issetr(netsock) THEN
      getudp(netsock, mbuf, fromip, sport);
      IF statneibor(mbuf, fromip, sport) & noloop(mbuf, nlocal.call) THEN
        sendall(mbuf, TRUE);
      END;
    END;

<*IF WWW THEN*>
    IF (tcpsock>=0) & issetr(tcpsock) THEN                     (* tcp listensocket has news *)
      res:=SIZE(mbuf);
      wwwsock:=tcp.acceptconnect(tcpsock, mbuf, res);
      IF wwwsock>=0 THEN                                       (* a new www connect *)
        res:=udp.socknonblock(wwwsock);
        connt:=0;
        tlen:=0;
      END;
    END;

    IF wwwsock>=0 THEN
      IF issetw(wwwsock) THEN                                  (* data to www *)
        res:=tcp.sendsock(wwwsock, tbuf, tlen);
        IF res>0 THEN
          FOR resi:=res TO tlen-1 DO tbuf[resi-res]:=tbuf[resi] END; (* delete the sent part *)
          DEC(tlen,res);
          IF connt=0 THEN connt:=systime END;
        ELSE tlen:=0 END;                                      (* should not happen *)
      ELSIF issetr(wwwsock) THEN Www(wwwsock) END;             (* http request to www server *)
    END;
<*END*>

  END;
END udprfnet.


(*
todo: 

----------------protocol:
(mycall)>(netname),(destination),(command)(num):
OE5XBL>HAMNET,WHOIS,RTP124:
OE2XZR>HAMNET,OE5XBL,RTR124:

OE5XBL>HAMNET,OE2XZR,RTP125:
OE5XZR>HAMNET,OE5XBL,RTR125:

command:
RTP poll need data
RTS poll need no data
RTR reply manual route
RTA reply autoroute
----------------



poll: 
src false, resert link
dest false reset link
dest WHOIS reply insert src heard:=0

rep:
src false, reset link
dest false reset link  

44.143.100.1:20100 44.143.40.34:10100

receive local monitor digipeted 
send it 3rd party encasulated udp to all neighbours
receive from all neighbours remove doubles append own call
send to all neighbours not in have it path
send all as monitor to local aprs digi input
send beacon and stop data on recipt of beacon a while
neigbours file
user message routing file
www statistic and userlist

user table: dist from me, call, count, lastheared
            enter only till max distance

neighbour table: line with favorite left only 1 link
                 1 line per link
                 stop double links

OE5XBL>HAMNET,WHOIS,RTP124:
OE2XZR>HAMNET,OE5XBL,RTR124:

OE5XBL>HAMNET,OE2XZR,RTP124:
OE5XZR>HAMNET,OE5XBL,RTR124:
min max everage cnt loss


insock net local


get local udp
append header
doublefilter
sendall if not call in path
remove header 
send local

*)