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

MODULE udpbox; (* axudp in/out ui/aprs stream splitter, filter, digipeater by OE5DXL *)

IMPORT udp;
FROM osi IMPORT WrLn, WrStr, WrStrLn, WrInt, WrHex, ALLOCATE, NextArg, time;
(*FROM FdSet IMPORT FdSet, FD_ZERO, FD_SET, FD_ISSET, TimeVal;*)
FROM Select IMPORT fdclr, fdsetr, selectr, issetr;
(*FROM mlib IMPORT select*)
FROM SYSTEM IMPORT CAST, SHIFT, ADR, CARD8, CARD16;
--FROM Storage IMPORT ALLOCATE;
--FROM Lib IMPORT NextArg;
--FROM TimeConv IMPORT time; 
FROM osi IMPORT OpenRead, OpenWrite, OpenAppend, Close, WrBin, RdBin, File, Erase, WrFixed;
FROM aprspos IMPORT GetPos, distance, RAD, posvalid, KNOTS, WKNOTS;
FROM aprsstr IMPORT TIME ,Assign, Append, Length, StrToFix, POSITION,
     StrCmp, DateToStr, CtrlHex, Hash, HashCh, AppCRC, SET8, Call2Str, raw2mon,
     mon2raw, extrudp2, GHOSTSET, InStr, IntToStr, Delstr;

CONST CALLLEN=7;
      HASHSIZE=16384;

      NOTFIRSTDIGI=3;
      NOUPLINKCHECK=4;
      SENDTRACE=5;
      SENDWIDE=6;
      DOWNPATHDIGICALL=7;
      DOWNPATHRELAY=8;
      DOWNPATHWIDE=9;
      NOVIADIGICALL=10;
      NOVIARELAY=11;
      NOVIATRACE=12;
      NOVIAWIDEN=13;
      NOCALLBEFOREWIDE=14;
      SSIDTOWIDE=15;
      NULLSSID=16;
      KILLWIDE=17;
      VIAGATE=18;
      RELAYECHO=19;
--      FINGERPRINT=20;

      STDIN=0;
      STDINIP=0FFFFFFFFH;

TYPE  UDPPORT=CARDINAL;
      IPNUM=CARDINAL;
      PATHSET=SET OF [0..31];
      SET256=SET OF [0..255];
      RAWCALL=ARRAY[0..CALLLEN-1] OF CHAR; 
      MONCALL=ARRAY[0..8] OF CHAR;
      FILENAME=ARRAY[0..1023] OF CHAR;

      pDIGIPARMS=POINTER TO DIGIPARMS;
      DIGIPARMS=RECORD
                  digicall              : RAWCALL;
                  pathcheck             : PATHSET;
                  duptime, messagetime  : TIME;
                  timehash              : ARRAY[0..HASHSIZE-1] OF TIME;
                END;

      BEACON=RECORD
               bintervall,
               piggytime : TIME;                  (* time send beacons earlier if sending some else *)
               piggyback : BOOLEAN;               (* sent something so append beacon immediately *)
               bfile     : FILENAME;
               btime     : TIME;
               bline     : CARDINAL;
             END;


      pCALLS=POINTER TO CALLS;
      CALLS=RECORD
              next      : pCALLS;
              call      : MONCALL;
            END;

      pOUTPORT=POINTER TO OUTPORT;
      OUTPORT=RECORD
                next       : pOUTPORT;
                toip       : IPNUM;   
                toport     : UDPPORT;
                filtercalls: pCALLS;
                invertfilter,
                echo,
                rawwrite,
                crlfwrite,
                passnoUI,
                axudp2,
                satgate,
                decode,
                rawpayload : BOOLEAN;
                aprspass   : SET256;
                digiparm   : pDIGIPARMS;
                beacon     : BEACON;
                mypos      : POSITION;
                maxkm      : INTEGER;
              END;
      
      pINSOCK=POINTER TO INSOCK;
      INSOCK=RECORD
               next       : pINSOCK;
               fd         : INTEGER;
               rawread    : BOOLEAN;
               rflinkname : MONCALL;
               fromip     : IPNUM;
               bindport   : UDPPORT;
               outchain   : pOUTPORT;
             END; 

      pMSGHASH=POINTER TO MSGHASH; 
      MSGHASH=RECORD
                next    : pMSGHASH;
                usercall: MONCALL;
                msgfile : FILENAME;
                wpos    : CARDINAL;
                hash:ARRAY[0..15] OF RECORD
                  sums, ackcnt:CARDINAL;
                  acktime: TIME;
                  source : pINSOCK;
                  froms  : MONCALL;
                  acks   : ARRAY[0..5] OF CHAR;
                END;
              END;  

      TELEMETRY=ARRAY[0..6] OF CARD16;

CONST MAXLEN=256+7*10+10+2;
      MINLEN=7*2+1+2;
      BLANKH=CHR(ORD(" ")*2);
      HBIT=128;
      ACKMSG="ack";
      POLYNOM=BITSET{3,10,15};
      cFILTPASS="p";
      cFILTDEL="d";
      DEFAULTMESSAGETIME=28;                      (* block seconds user message frames *)
      DEFAULTDUPTIME=29*60;                       (* block seconds invariant payload frames *)
      CR=015C;
      LF=012C;
      SENDACKS=4;
      OLDMSG=600;                                 (* s long kill dupe user message *)
      TOCALL="APNL01";
      DEFAULTACK="WIDE2-2";
      cUSERMSG=":";
      cTELEMETRY="T";
      THIRDPARTY="}";
      HEADEREND=":";

VAR
    show                  : BOOLEAN;
    insocks               : pINSOCK;
    showip                : IPNUM;
    showport              : UDPPORT;
    msgusers              : pMSGHASH; 
    ackpath               : ARRAY[0..63] OF CHAR;
    stdinpos              : CARDINAL;
    stdinbuf              : ARRAY[0..255] OF CHAR;
 
PROCEDURE Err(text-:ARRAY OF CHAR);
BEGIN
  WrStr("udpbox: "); WrStr(text); WrStrLn(" error abort");
  HALT
END Err;


PROCEDURE Stomsg(user:pMSGHASH; from-, to-, msg-, ack-:ARRAY OF CHAR; fromsock:pINSOCK);
VAR i, h : CARDINAL;
    t    : TIME;
    f    : File;
    mb   : ARRAY[0..255] OF CHAR;
BEGIN
  WITH user^ DO
    i:=0;
    WHILE (i<=HIGH(msg)) & (msg[i]<>0C) DO INC(i) END;
    t:=time();
    h:=Hash(msg, 0, i) MOD HASHSIZE;
    i:=0;
    WHILE (i<=HIGH(hash)) & NOT ((h=hash[i].sums) & (hash[i].acktime+OLDMSG>=t) 
    & StrCmp(ack, hash[i].acks) & StrCmp(from, hash[i].froms)) DO INC(i) END;
    IF i>HIGH(hash) THEN                                                        (* new msg*)

      DateToStr(t,mb);
      Append(mb, " from ");
      Append(mb, from);
      Append(mb, " to ");
      Append(mb, to);
      Append(mb, " <");
      Append(mb, msg);
      Append(mb, "> (");
      Append(mb, ack);
      Append(mb, ")");

IF show THEN  WrStr(" <"); WrStr(mb); WrStr("> "); END;

      Append(mb, 12C);

      IF msgfile[0]<>0C THEN
        f:=OpenAppend(msgfile);
        IF f<0 THEN f:=OpenWrite(msgfile) END;
        IF f>=0 THEN
          WrBin(f, mb, Length(mb));
          Close(f);
        END; 
      END;

      WITH hash[wpos] DO
        sums:=h;
        Assign(acks, ack);
        Assign(froms, from);
        IF ack[0]>" " THEN 
          ackcnt:=SENDACKS;
          acktime:=0;
        END;
        source:=fromsock;
      END;
      INC(wpos);
      IF wpos>HIGH(hash) THEN wpos:=0 END;    
    ELSE                                                                              (* old msg *)
      hash[i].ackcnt:=SENDACKS;
    END;
  END;
END Stomsg;


PROCEDURE skipthirdparty(b-:ARRAY OF CHAR; len:CARDINAL; VAR p:CARDINAL);  (* remove third party header *)
BEGIN
  WHILE b[p]=THIRDPARTY DO
    WHILE (p<len) & (b[p]<>HEADEREND) DO INC(p) END;
    INC(p);
  END;
END skipthirdparty;


PROCEDURE Usermsg(b-:ARRAY OF CHAR; len,p:INTEGER; fromsock:pINSOCK; VAR selfmsg:BOOLEAN):BOOLEAN;
CONST FROMEND=">";
      USERACK="{";

VAR pf:INTEGER;
    j:CARDINAL; 
    user:pMSGHASH;
    from, to:ARRAY[0..8] OF CHAR;
    ack:ARRAY[0..5] OF CHAR;
    msg:ARRAY[0..68] OF CHAR;
    ok:BOOLEAN; 
BEGIN
  selfmsg:=FALSE;
  pf:=0;
  WHILE b[p]=THIRDPARTY DO
    pf:=p+1;
    WHILE (p<len) & (b[p]<>HEADEREND) DO INC(p) END;
    INC(p);
  END;
  IF (p+10<len) & (b[p]=cUSERMSG) & (b[p+10]=cUSERMSG) THEN           (* user message *)
    INC(p); 

    j:=0;                                                             (* message from *)
    IF pf=0 THEN ok:=Call2Str(b, from, 7, j);
    ELSE
      WHILE (pf<len) & (j<=HIGH(from)) & (b[pf]<>FROMEND) DO
        from[j]:=b[pf];
        INC(pf);
        INC(j);
      END;
    END;
    WHILE j<=HIGH(from) DO from[j]:=" "; INC(j) END;

    ok:=FALSE;
    FOR j:=0 TO HIGH(to) DO                                           (* message to *)
      to[j]:=b[p+VAL(INTEGER,j)];
      IF to[j]<>from[j] THEN ok:=TRUE END;
    END;

    IF NOT ok THEN                                                    (* msg from to same call *)
IF show THEN WrStr(" msg to it self ") END;
      selfmsg:=TRUE;
      RETURN FALSE

    END;
--WrStr("<"); WrStr(from); WrStr(">"); WrStr("<"); WrStr(to); WrStrLn(">");


    user:=msgusers;
    WHILE user<>NIL DO
      j:=0;
      WHILE (j<=HIGH(to)) & (user^.usercall[j]=to[j]) DO INC(j) END; 
      IF j=9 THEN 
(*
        j:=0;
        IF pf=0 THEN
          IF Call2Str(b, from, 7, j) THEN END;
        ELSE 
          WHILE (pf<len) & (j<=HIGH(from)) & (b[pf]<>FROMEND) DO from[j]:=b[pf]; INC(pf); INC(j); END;
        END;
        WHILE j<=HIGH(from) DO from[j]:=" "; INC(j) END; 

        FOR j:=0 TO 8 DO to[j]:=b[p]; INC(p) END;
*)
        INC(p,10); 

        j:=0;
        WHILE (p<len) & (j<HIGH(msg)) & (b[p]<>USERACK) DO msg[j]:=b[p]; INC(j); INC(p) END;
        msg[j]:=0C;
        
        j:=0;
        LOOP
          IF ACKMSG[j]<=" " THEN RETURN FALSE END;   (* "ack" in text field is not for delete *)
          IF ACKMSG[j]<>msg[j] THEN EXIT END;
          INC(j);
        END;

        INC(p);

        j:=0;
        WHILE (p<len) & (j<HIGH(ack)) DO ack[j]:=b[p]; INC(j); INC(p) END;
        ack[j]:=0C;

        Stomsg(user, from, to, msg, ack, fromsock);
        RETURN TRUE

      END;
      user:=user^.next;
    END; 
  END;
  RETURN FALSE
END Usermsg;


PROCEDURE CallFilt(calls:pCALLS; s-:ARRAY OF CHAR; len:INTEGER):BOOLEAN;

 PROCEDURE MakeMonCall(rs-:ARRAY OF CHAR; p:INTEGER; VAR mc:ARRAY OF CHAR);
 VAR i,j:INTEGER;
 BEGIN
   j:=0;
   FOR i:=0 TO 5 DO
     mc[j]:=CHR(ASH(ORD(rs[p+i]),-1));
     IF mc[j]>" " THEN INC(j) END;
   END;
   i:=ORD(rs[p+6]) DIV 2 MOD 16;
   IF i>0 THEN
     mc[j]:="-"; INC(j);
     IF i>=10 THEN mc[j]:="1"; INC(j) END;
     mc[j]:=CHR(i MOD 10+ORD("0")); INC(j);
   END;
   IF j<=VAL(INTEGER, HIGH(mc)) THEN mc[j]:=0C END; 
 END MakeMonCall;


 PROCEDURE cmp(c:pCALLS; s-:ARRAY OF CHAR):BOOLEAN;

   PROCEDURE cmprest(a-,b-:ARRAY OF CHAR; VAR i,j:CARDINAL):CARDINAL;
   BEGIN
     LOOP
       IF (j<=HIGH(b)) & (b[j]="*") THEN
         IF (j>=HIGH(b)) OR (b[j+1]=0C) THEN RETURN 1 ELSE RETURN 3 END;

       ELSIF (i>HIGH(a)) OR (a[i]=0C) THEN RETURN ORD((j>HIGH(b)) OR (b[j]=0C)) END; (* word 1 end *)

       IF (j>HIGH(b)) OR (b[j]=0C) THEN RETURN 0 END;      (* word 2 end *)

       IF (b[j]<>"?") & (a[i]<>b[j]) THEN RETURN 2 END;

       INC(i);
       INC(j);
     END;
   END cmprest; 


 VAR i,j,jj,ii,res:CARDINAL;
     wild:BOOLEAN;
 BEGIN
   WHILE c<>NIL DO
     i:=0;
     j:=0;
     wild:=FALSE;
     LOOP
       res:=cmprest(s, c^.call, i, j);
       IF res=1 THEN RETURN TRUE END;

       IF res=3 THEN                           (* "*" *)
         jj:=j+1;                              
         j:=jj;
         wild:=TRUE;
         ii:=i;

       ELSIF wild THEN
         IF res=0 THEN EXIT END;               (* no fit till end *)

         INC(ii);                              (* no fit but no word at end *)
         i:=ii;                                (* compare again shifted *)
         j:=jj;
       ELSE EXIT END;
     END;
     c:=c^.next;
   END;
   RETURN FALSE
 END cmp;

VAR i,j:INTEGER;
    mc:ARRAY[0..99] OF CHAR;
BEGIN
  i:=0;
  REPEAT                                               (* first look in ax25 frame *)
    MakeMonCall(s, i, mc);
    IF cmp(calls, mc) THEN RETURN TRUE END;

    INC(i, CALLLEN);
  UNTIL (i>=len) OR ODD(ORD(s[i-1]));

  INC(i,2);
  IF s[i]=THIRDPARTY THEN                               (* in text part of third party frame *)
    INC(i);
    LOOP
      IF i>=len THEN EXIT END;

      j:=0;
      WHILE (i<len) & (s[i]<>",") & (s[i]<>">") & (s[i]<>HEADEREND) & (j<HIGH(mc)) DO
        mc[j]:=s[i];
        INC(i);
        INC(j);
      END;
      mc[j]:=0C;
      IF cmp(calls, mc) THEN RETURN TRUE END;

      IF s[i]=HEADEREND THEN
        INC(i);
        IF s[i]<>THIRDPARTY THEN EXIT END;

      END;    
      INC(i);
    END;
  END;

  RETURN FALSE;
END CallFilt;


PROCEDURE DistFilt(mypos:POSITION; b:ARRAY OF CHAR; payload, len:CARDINAL):INTEGER;
VAR i, speed, course :CARDINAL;
    comment          :ARRAY[0..500] OF CHAR;
    alt              :INTEGER; 
    sym, symt, postyp:CHAR;
    pos              :POSITION;
BEGIN
  FOR i:=CALLLEN-1 TO 0 BY -1 DO b[i+1]:=CAST(CHAR, SHIFT(CAST(SET8,b[i]), -1)) END;
  b[len]:=0C;
  skipthirdparty(b, len, payload);                       (* from whom *)
  GetPos(pos, speed, course, alt, sym, symt, b, 1, payload, comment, postyp);
  IF posvalid(pos) THEN
    RETURN TRUNC(distance(mypos,pos))
  ELSE RETURN -1 END;
END DistFilt;  

PROCEDURE findpayload(b-:ARRAY OF CHAR; len:INTEGER):INTEGER;
VAR i:INTEGER;
BEGIN
  i:=13;
  WHILE (i<len) & NOT ODD(ORD(b[i])) DO INC(i, 7) END;
  RETURN i+3
END findpayload;


PROCEDURE Filter(b-:ARRAY OF CHAR; len:INTEGER; parm:pOUTPORT; fromsock:pINSOCK):BOOLEAN;
VAR i:INTEGER;
    km:INTEGER;
    selfmsg:BOOLEAN;
BEGIN
  DEC(len,2);                                                      (* crc *)  
  IF len<=0 THEN
    IF parm^.passnoUI THEN
      IF show THEN WrStrLn(" pass axudp2") END;
      RETURN TRUE

    ELSE RETURN FALSE END;
 
  END;

  i:=findpayload(b, len);
  IF (i>len) OR (CAST(SET8, b[i-2])-SET8{4}<>SET8{0,1}) THEN 

    IF show THEN WrStr(" not UI ") END;

    RETURN parm^.passnoUI;                                         (* not UI frame *)

  END;

(* is UI frame *)
  IF Usermsg(b, len, i, fromsock, selfmsg) THEN RETURN FALSE END;  

  IF (parm^.filtercalls<>NIL) & (CallFilt(parm^.filtercalls, b, len)<>parm^.invertfilter) THEN 
IF show THEN WrStr(" callfilter deletes frame") END;
    RETURN FALSE

  END; 

  IF NOT (ORD(b[i]) IN parm^.aprspass) OR selfmsg & NOT (ORD(cTELEMETRY) IN parm^.aprspass) THEN 
IF show THEN WrStr(" message type filter") END;
    RETURN FALSE

  END;

  IF (parm^.maxkm>0) & ((b[i]<>cUSERMSG) OR (b[i+10]<>cUSERMSG)) THEN  (* dist filter on and no user message *) 
    km:=DistFilt(parm^.mypos, b, i, len);
    IF km<0 THEN
IF show THEN WrStr(" no pos") END;
      RETURN FALSE

    END; 
IF show THEN WrStrLn(" "); WrInt(km,1); WrStr("km"); END;
    IF km>=parm^.maxkm THEN
IF show THEN WrStr(" too far") END;
      RETURN FALSE

    END;  
  END;

  IF parm^.satgate & NOT ODD(ORD(b[13])) & (b[20]<200C) THEN (* has >=1 vias and first via no h-bit *)
IF show THEN WrStr(" sat gate and direct heard") END;
    RETURN FALSE

  END;

  RETURN TRUE;
END Filter;


PROCEDURE getstdin(VAR buf:ARRAY OF CHAR):INTEGER;
VAR c:CHAR;
BEGIN
  WHILE RdBin(STDIN, c, 1)=1 DO
    IF c=LF THEN c:=0C END;
    IF stdinpos<HIGH(stdinbuf) THEN stdinbuf[stdinpos]:=c; INC(stdinpos) END;
    IF c=0C THEN Assign(buf, stdinbuf); stdinpos:=0; RETURN Length(buf) END;

  END;
  RETURN -1
END getstdin; 


PROCEDURE getudp(fd:INTEGER; VAR buf:ARRAY OF CHAR; fromip:IPNUM; addcrc:BOOLEAN):INTEGER;
VAR fromport:UDPPORT;
    ip:IPNUM;
    crc1, crc2:CHAR;
    len:INTEGER;
BEGIN
  len:=udp.udpreceive(fd, buf, SIZE(buf), fromport, ip);
  IF (len>2) & (len<CAST(INTEGER, SIZE(buf))) & ((fromip=0) OR (fromip=ip)) THEN
    showip:=ip;
    showport:=fromport;
    IF NOT addcrc THEN RETURN len END;

    crc1:=buf[len-2];
    crc2:=buf[len-1];
    AppCRC(buf, len-2);
    IF (crc1=buf[len-2]) & (crc2=buf[len-1]) THEN RETURN len 
    ELSIF show THEN 
      WrStrLn(" raw crc error "); 
(*
      IO.WrHex(ORD(crc1)+ORD(crc2)*256, 1);
      IO.WrStr("<>");
      IO.WrHex(ORD(buf[len-2])+ORD(buf[len-1])*256, 1);
      IO.WrStr("  ");
*)
    END; 
  END;
  RETURN -1
END getudp; 


PROCEDURE checkhamnet(VAR b:ARRAY OF CHAR; VAR len:INTEGER; rflinkname-:ARRAY OF CHAR; VAR hamup:RAWCALL);
VAR i, j:INTEGER;
    s:CARDINAL;
BEGIN
  IF rflinkname[0]=0C THEN RETURN END;

  hamup[0]:=0C;
  i:=0;
  WHILE b[i]<>">" DO                                                (* skip fromcall *) 
    INC(i); 
    IF i>=len THEN len:=0; RETURN END;
  END;
  INC(i);

  j:=0;
  WHILE (j<=VAL(INTEGER, HIGH(rflinkname))) & (rflinkname[j]<>0C) DO   (* compare rflink name *) 
    IF b[i]<>rflinkname[j] THEN 
      len:=0;
      RETURN
    END;
    INC(i);
    INC(j);  
  END;

  IF b[i]="," THEN
    INC(i);
    j:=0;
    WHILE (i<len) & (b[i]<>"-") & (b[i]<>",") & (b[i]<>HEADEREND) DO        (* make rawcall of rflink uplink *)
      s:=ORD(b[i])*2 MOD 256;
      IF s<=ORD(" ")*2 THEN len:=0; RETURN END;
      hamup[j]:=CHR(s);
      INC(i);
      INC(j);
      IF j>=CALLLEN THEN len:=0; RETURN END;
    END;
    WHILE j<CALLLEN-1 DO
      hamup[j]:=CHR(ORD(" ")*2);
      INC(j);
    END;
    s:=0;
    IF b[i]="-" THEN
      INC(i);
      WHILE (b[i]>="0") & (b[i]<="9") DO s:=s*10 + ORD(b[i])-ORD("0"); INC(i) END;
      IF s>15 THEN len:=0; RETURN END;
    END;
    hamup[j]:=CHR((s+48+64)*2);                                       (* set H bit *)
  END;

  IF (b[i]<>",") & (b[i]<>":") THEN len:=0; RETURN END;
  
  WHILE b[i]<>"}" DO                                                (* find end of rflink head *)
    INC(i);
    IF i>=len THEN len:=0; RETURN END;
  END;
  INC(i);
  DEC(len, i);                                                    (* payload len *)
  FOR j:=0 TO len DO b[j]:=b[i]; INC(i) END;                        (* remove rflink head *)

(* DIGICALL>HAMNAME,UPLINKCALL,.... :}payload *)
END checkhamnet;


(*
PROCEDURE MakeDupeTime(s-:ARRAY OF CHAR; p:INTEGER; parm:pDIGIPARMS):TIME;
VAR le,nu:CARDINAL;
    i:INTEGER; 
BEGIN
  le:=0;
  nu:=0;
  FOR i:=p+3 TO p+5 DO 
    IF (s[i]>="A") & (s[i]<="Z") THEN INC(le) END;
    IF (s[i]>="0") & (s[i]<="9") THEN INC(nu) END;
  END;
  IF (s[p+2]=cUSERMSG) & (le>0) & (nu>0) & (le+nu=3) THEN        (* looks like a user message *)
    RETURN parm^.messagetime
  END;
  RETURN parm^.duptime
END MakeDupeTime;
*)

PROCEDURE IsCall(raw-:ARRAY OF CHAR; pos:CARDINAL; div:CARDINAL):BOOLEAN;
VAR le, nu, i:CARDINAL;
    c:CHAR; 
BEGIN
  le:=0;
  nu:=0;
  FOR i:=pos TO pos+2 DO
    c:=CHR(ORD(raw[i]) DIV div);
    IF (c>="A") & (c<="Z") THEN INC(le) END;
    IF (c>="0") & (c<="9") THEN INC(nu) END;
  END;
  RETURN (le>0) & (nu>0) & (le+nu=3);                            (* looks like a call *)
END IsCall;


PROCEDURE Dup(raw-:ARRAY OF CHAR; pathlen, rawlen:CARDINAL; VAR sum:CARDINAL):BOOLEAN;
VAR len, i:CARDINAL;
    hashl, hashh  :SET8;
    h:ARRAY[0..255] OF CHAR;
    ok:BOOLEAN;
(*
  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{};
  INC(pathlen, 2);                                                 (* skip frametyp pid *)
  IF raw[pathlen]<>THIRDPARTY THEN
    len:=0;
    ok:=Call2Str(raw, h, CALLLEN, len);
    i:=0;
    WHILE i<len DO HashCh(h[i], hashl, hashh); INC(i) END;
    len:=0;
    ok:=Call2Str(raw, h, 0, len);
    i:=0;
    WHILE (i<len) & (h[i]<>"-") DO HashCh(h[i], hashl, hashh); INC(i) END;
  ELSE
    i:=pathlen+1;
    LOOP
      INC(pathlen);
      IF pathlen>=rawlen THEN EXIT END;
      IF raw[pathlen-1]=HEADEREND THEN
        IF raw[pathlen]=THIRDPARTY THEN i:=pathlen+1 ELSE EXIT END;
      END;  
    END;
    WHILE (i<pathlen-1) & (raw[i]<>">") DO HashCh(raw[i], hashl, hashh); INC(i) END;
    INC(i);
    WHILE (i<pathlen-1) & (raw[i]<>"-") & (raw[i]<>",") DO HashCh(raw[i], hashl, hashh); INC(i) END;
  END;

  i:=pathlen;
  WHILE (i<rawlen) & (raw[i]<>CR) & (raw[i]<>LF) DO HashCh(raw[i], hashl, hashh); INC(i) END;
  sum:=(ORD(CAST(CHAR, hashl)) + ORD(CAST(CHAR, hashh))*256) MOD HASHSIZE;

  IF raw[pathlen]<>cUSERMSG THEN RETURN FALSE END;
  RETURN IsCall(raw, pathlen+1, 1)                               (* if call it is user msg *)
END Dup;


PROCEDURE Cmp(s-:ARRAY OF CHAR; start:CARDINAL; word-:ARRAY OF CHAR):BOOLEAN;
VAR i:CARDINAL;
BEGIN
  i:=0;
  WHILE word[i]<>0C DO
    IF word[i]<>CHR(ORD(s[start]) DIV 2) THEN RETURN FALSE END;
    INC(i);
    INC(start);
  END;
  RETURN TRUE
END Cmp;


PROCEDURE ChkNN(ssid:CARDINAL; c:CHAR):BOOLEAN;
BEGIN 
  c:=CHR(ORD(c) DIV 2);
  RETURN (c=" ") & (ssid=0) OR (c>="1") & (c<="7") & (c>=CHR(ORD("0")+ssid))
END ChkNN;

PROCEDURE NeqN(ssid:CARDINAL; c:CHAR; pos:INTEGER):BOOLEAN;
BEGIN RETURN (pos<=CALLLEN*2) & ((ssid+ORD("0")=ORD(c) DIV 2) OR (ssid=0) & (c=BLANKH)) END NeqN;


PROCEDURE setSSID(VAR c:CHAR; ssid:CARDINAL);
BEGIN c:=CAST(CHAR, CAST(SET8,c)-SET8{1..4}+CAST(SET8,ssid*2)) END setSSID;

PROCEDURE getSSID(c:CHAR):CARDINAL;
BEGIN RETURN ORD(c) DIV 2 MOD 16 END getSSID;

PROCEDURE killwide(VAR startpath:INTEGER; downpath:INTEGER; VAR s:ARRAY OF CHAR);
VAR i,j:INTEGER;
BEGIN
  FOR i:=startpath TO downpath-1 BY CALLLEN DO
    IF (s[i]=CHR(ORD("W")*2)) & (s[i+1]=CHR(ORD("I")*2))  
    & (s[i+2]=CHR(ORD("D")*2)) & (s[i+3]=CHR(ORD("E")*2)) THEN
      FOR j:=i-1 TO startpath BY -1 DO s[j+CALLLEN]:=s[j] END;
      INC(startpath, CALLLEN);
    END;
  END;
END killwide;


PROCEDURE Digi(VAR raw, send:ARRAY OF CHAR; inlen:INTEGER; VAR outlen:INTEGER; hamup-:RAWCALL;
               parm:pDIGIPARMS; duponly:BOOLEAN);
VAR i, j, pathlen, startpath, actdigi, downpath, goodpath:INTEGER;
    ssid, hash, ssidroute:CARDINAL;
    t,tt:TIME;
    ok, nodigicall, noloop:BOOLEAN;
BEGIN
  IF parm^.digicall[0]<=BLANKH THEN duponly:=TRUE END;
  outlen:=0;
  DEC(inlen, 2);                                              (* crc bytes *)

  pathlen:=CALLLEN*2-1;
  WHILE (pathlen<inlen) & NOT ODD(ORD(raw[pathlen])) DO INC(pathlen,CALLLEN) END; (* find end of path *)
  INC(pathlen);

  ok:=FALSE;
  downpath:=0;
  IF NOT duponly THEN
--  IF (FINGERPRINT IN parm^.pathcheck) OR ((raw[6]>=200C)<>(raw[13]>=200C)) THEN
      actdigi:=CALLLEN*2;
      noloop:=TRUE;
      IF NOTFIRSTDIGI IN parm^.pathcheck THEN                   (* need not be first repeater *)
        WHILE (actdigi<pathlen) & (raw[actdigi+(CALLLEN-1)]>=CHR(128)) DO 

(* test if own digicall in path *)
          ok:=FALSE;
          FOR i:=0 TO CALLLEN-2 DO
            IF raw[i+actdigi]<>parm^.digicall[i] THEN ok:=TRUE END;
          END;
          IF getSSID(raw[actdigi+CALLLEN-1])<>getSSID(parm^.digicall[CALLLEN-1]) THEN ok:=TRUE END;
          IF NOT ok THEN noloop:=FALSE END;

          INC(actdigi,CALLLEN);
        END;
      END;

      IF noloop THEN                                            (* not looping thru own digi *)
        startpath:=actdigi+CALLLEN;
        nodigicall:=FALSE;
        IF DOWNPATHDIGICALL IN parm^.pathcheck THEN downpath:=pathlen END;

(* test for ssid routing*)

        ssid:=CAST(INTEGER, parm^.pathcheck*PATHSET{0..2});     (* limit ssid routing hopps *)
        ssidroute:=getSSID(raw[CALLLEN-1]);                     (* destination call ssid *)

        goodpath:=CALLLEN*2;
        WHILE (goodpath<pathlen) & (raw[goodpath+6]>=CHR(128)) 
        & IsCall(raw, goodpath, 2) DO INC(goodpath, CALLLEN) END; (* repeated via callsigns *)

        IF (ssidroute>0) & (ssid>0) & (goodpath=pathlen) & (pathlen<CALLLEN*7)
        & ((NOTFIRSTDIGI IN parm^.pathcheck) OR (goodpath=CALLLEN*2)) THEN
          ok:=TRUE;
          IF ssidroute>7 THEN ssidroute:=1 END;                 (* we can no directional routing *)
          IF ssidroute>ssid THEN ssidroute:=ssid END;           (* limit dest ssid to WIDEn-n *) 

          IF (ssidroute=1) OR NOT (SSIDTOWIDE IN parm^.pathcheck) THEN (* use decrement dest ssid routing *) 
            setSSID(raw[CALLLEN-1], ssidroute-1);               (* chain by dec dest ssid *)
            ssidroute:=0;
          ELSE                                                  (* expand to digicall + wideN-N *)
            DEC(ssidroute);
            setSSID(raw[CALLLEN-1], 0);                         (* switch to via routing *)
          END;          
          downpath:=0;                                          (* delete rest of path *)

IF show THEN 
  WrStr(" via ssid routing ");
END;

        ELSE
          ssidroute:=0;
          IF goodpath<=CALLLEN*2 THEN goodpath:=0 END;          (* may be missing uplink call *)
          IF NOUPLINKCHECK IN parm^.pathcheck THEN goodpath:=actdigi END;
          ok:=pathlen>actdigi;  (* there are via calls *)
          IF ok THEN
            ok:=raw[actdigi+(CALLLEN-1)]<CHR(128);  (* no H-bit is not digipeated *)
            IF ok THEN
              ssid:=getSSID(raw[actdigi+(CALLLEN-1)]);
              IF NOVIADIGICALL IN parm^.pathcheck THEN ok:=FALSE
              ELSE 
                FOR i:=0 TO CALLLEN-2 DO 
                  IF raw[i+actdigi]<>parm^.digicall[i] THEN ok:=FALSE END;
                END;
                IF ssid<>getSSID(parm^.digicall[CALLLEN-1]) THEN ok:=FALSE END;
              END;
              IF ok THEN
                IF DOWNPATHDIGICALL IN parm^.pathcheck THEN downpath:=pathlen END;

IF show THEN WrStr(" via digicall "); END;

              ELSE
                IF NOT (NOVIARELAY IN parm^.pathcheck) THEN
                  ok:=Cmp(raw, actdigi, "RELAY ");
                  IF NOT ok & (RELAYECHO IN parm^.pathcheck) THEN ok:=Cmp(raw, actdigi, "ECHO  ") END;
                  IF ok THEN
                    IF DOWNPATHRELAY IN parm^.pathcheck THEN downpath:=pathlen END;

IF show THEN WrStr(" via RELAY "); END;

                  END;
                END;  
              END;

              IF NOT ok THEN
                IF VIAGATE IN parm^.pathcheck THEN
                  ok:=Cmp(raw, actdigi, "GATE  ");
                  IF ok THEN
                    IF DOWNPATHRELAY IN parm^.pathcheck THEN downpath:=pathlen END;

IF show THEN WrStr(" via GATE "); END;

                  END;
                END;
              END;

              IF NOT ok THEN 
                IF NOT (NOVIATRACE IN parm^.pathcheck) 
                & Cmp(raw, actdigi, "TRACE")
                & ChkNN(ssid, raw[actdigi+(CALLLEN-2)])
                & ((goodpath=actdigi) OR NeqN(ssid, raw[actdigi+(CALLLEN-2)], actdigi)) THEN
                  ok:=TRUE;
                  IF (ssid>ORD(NOT (NULLSSID IN parm^.pathcheck))) & (SENDTRACE IN parm^.pathcheck) THEN
                    setSSID(raw[actdigi+(CALLLEN-1)], ssid-1);          (* dec(N) of WIDEn-N *)
                    startpath:=actdigi;
                  END;
                  IF NOT (DOWNPATHRELAY IN parm^.pathcheck) THEN downpath:=actdigi+CALLLEN END;
                END;

IF show & ok THEN WrStr(" via TRACEn-n "); END;

              END;

              IF NOT ok THEN
                IF NOT (NOVIAWIDEN IN parm^.pathcheck) 
                & Cmp(raw, actdigi, "WIDE") & (raw[actdigi+(CALLLEN-2)]=BLANKH)
                & ChkNN(ssid, raw[actdigi+(CALLLEN-3)])
                & ((goodpath=actdigi) OR NeqN(ssid, raw[actdigi+(CALLLEN-3)], actdigi)) THEN
                  ok:=TRUE;
                  IF (raw[actdigi+(CALLLEN-3)]<>BLANKH) & (SENDWIDE IN parm^.pathcheck) THEN
                    IF (NOCALLBEFOREWIDE IN parm^.pathcheck)
                    OR (goodpath<>actdigi) & NOT NeqN(ssid, raw[actdigi+(CALLLEN-3)], actdigi) THEN nodigicall:=TRUE END;   (* maybe repeatet before *)

                    IF ssid>ORD(NOT (NULLSSID IN parm^.pathcheck)) THEN
                      setSSID(raw[actdigi+(CALLLEN-1)], ssid-1);
                      startpath:=actdigi; 
                    ELSIF nodigicall THEN raw[actdigi+(CALLLEN-1)]:=CHR(ORD("0")*2+HBIT); (* WIDE* *) 
                    END;
                    IF nodigicall THEN startpath:=actdigi END;
                  END;
                  IF NOT (DOWNPATHWIDE IN parm^.pathcheck) THEN downpath:=actdigi+CALLLEN END;
                END;

IF show & ok THEN WrStr(" via WIDEn-n " ); END;

              END;

IF show & NOT ok THEN WrStr(" no source path " ); END;

            ELSIF show THEN WrStr(" H-bit set, already digipeated " ) END;
          ELSIF show THEN WrStr(" no (more) digipeat flags " ) END;
        END;
      ELSIF show THEN WrStr(" we have already digipeated " ) END; 
--    ELSIF show THEN WrStr(" fingerprint filtered " ) END;
  END;

  IF duponly OR ok THEN
(*
IO.WrLn; IO.WrStr("<<<");IO.WrHex(ORD(raw[pathlen+2]),1);IO.WrStr(">>> ");
*)
    tt:=parm^.duptime;
    IF Dup(raw, pathlen, inlen, hash) THEN tt:=parm^.messagetime END;
    t:=time();                                                          (* time in s *)
    IF parm^.timehash[hash]+tt<=t THEN                                  (* not a duplicate *)
      parm^.timehash[hash]:=t;

      IF duponly THEN                                                   (* dupfilter only *)
        outlen:=inlen+2;
        FOR i:=0 TO outlen-1 DO send[i]:=raw[i] END;

      ELSE                                                              (* digipeater *)
        i:=0;
        WHILE i<actdigi DO send[i]:=CAST(CHAR, CAST(SET8,raw[i])*SET8{1..7}); INC(i) END; (* copy from-to and clear address end bit *)

        IF NOT nodigicall THEN

          IF hamup[0]<>0C THEN
            FOR j:=0 TO CALLLEN-1 DO send[i]:=hamup[j]; INC(i) END;    (* append uplink via digicall *)
          END;

          FOR j:=0 TO CALLLEN-1 DO send[i]:=parm^.digicall[j]; INC(i) END;    (* append new via digicall *)
        END;
        IF ssidroute>0 THEN
          send[i]:=CHR(ORD("W")*2); INC(i);
          send[i]:=CHR(ORD("I")*2); INC(i);
          send[i]:=CHR(ORD("D")*2); INC(i);
          send[i]:=CHR(ORD("E")*2); INC(i);
          send[i]:=CHR((ORD("0")+ssidroute)*2); INC(i);
          send[i]:=CHR(ORD(" ")*2); INC(i);
          send[i]:=CHR((ORD("0")+ssidroute)*2); INC(i);               (* no H bit set *)
        END;

        IF KILLWIDE IN parm^.pathcheck THEN killwide(startpath, downpath, raw) END;
        j:=startpath;                                                   (* append rest of path *)
        WHILE (j<downpath) & (i<CALLLEN*10) DO send[i]:=raw[j]; INC(i); INC(j) END; 
        send[i-1]:=CAST(CHAR, CAST(SET8, send[i-1])+SET8{0});           (* set address end bit *)

        FOR j:=pathlen TO inlen-1 DO send[i]:=raw[j]; INC(i); END;      (* append data field no crc *)
        AppCRC(send,i);
        outlen:=i+2;
      END;

    ELSIF show THEN WrStr(" "); WrInt(t-parm^.timehash[hash],1); WrStr("s since same payload "); 
    END;

  END;
END Digi;


PROCEDURE GetIp(h:ARRAY OF CHAR; VAR p:CARDINAL; VAR ip:IPNUM; VAR port:UDPPORT):INTEGER;
VAR i, n:CARDINAL;
    ok:BOOLEAN;
BEGIN
  p:=0;
  h[HIGH(h)]:=0C;
  ip:=0;
  FOR i:=0 TO 4 DO
    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;
    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 n>65535 THEN RETURN -1 END;

    port:=n;
    INC(p);
  END;  
  RETURN 0
END GetIp;


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 MakeRawCall(VAR c:RAWCALL; s:ARRAY OF CHAR; j:CARDINAL);
VAR i, n:CARDINAL;
BEGIN
  i:=0;
  WHILE i<CALLLEN-1 DO
    IF (s[j]<>0C) & (s[j]<>",") & (s[j]<>"-") THEN c[i]:=CHR(ORD(s[j])*2); INC(j);
    ELSE c[i]:=BLANKH END; 
    INC(i);
  END;
  n:=0;
  IF s[j]="-" THEN
    INC(j);
    WHILE (s[j]>="0") & (s[j]<="9") DO n:=n*10 + ORD(s[j])-ORD("0"); INC(j) END;
  END;
  IF n>15 THEN Err("wrong SSID") END;
  IF s[j]="*" THEN c[CALLLEN-1]:=0C ELSE c[CALLLEN-1]:=CHR(n*2+(96+HBIT)) END;   (* set H bit *)
END MakeRawCall;


PROCEDURE Ackpath(h-:ARRAY OF CHAR);
BEGIN
  Assign(ackpath, ">");
  Append(ackpath, TOCALL);
  IF h[0]<>0C THEN
    Append(ackpath, ",");
    Append(ackpath, h);
  END;
  Append(ackpath, "::");
END Ackpath;

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, actecho, actsat, actinvert,
    actpassui        : BOOLEAN;
    lasth            : CHAR;
    actsock          : pINSOCK;
    outsock, onext   : pOUTPORT;
    actpass          : SET256;
    actdigi          : pDIGIPARMS; 
    i, n, nold       : CARDINAL;
    actbeacon        : BEACON;
    user             : pMSGHASH; 
    actcall, callnext: pCALLS;
    actkm            : REAL;
    actpos           : POSITION;  
BEGIN

  msgusers:=NIL;
  actsock:=NIL;
  actcall:=NIL;
  err:=FALSE;
  show:=FALSE;
  Ackpath(DEFAULTACK);
  actkm:=0.0;
  actpassui:=FALSE;
  actsat:=FALSE;
  actinvert:=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
        NextArg(h);
        IF h[0]="-" THEN h[0]:=0C END; 
        Ackpath(h);

      ELSIF (lasth="R") OR (lasth="M") OR (lasth="L") THEN
        NextArg(h);
        actecho:=FALSE;
        actpass:=SET256{0..255};
        actdigi:=NIL;
        actcall:=NIL;
        actkm:=0.0; 
        actpassui:=FALSE;
        actsat:=FALSE;
        actbeacon.bintervall:=0;
        actbeacon.piggytime:=0;
        actbeacon.piggyback:=FALSE;
        ALLOCATE(actsock, SIZE(actsock^));
        IF actsock=NIL THEN Err("out of memory") END;
        WITH actsock^ DO
          outchain:=NIL;
          rflinkname[0]:=0C;
          IF GetIp(h, i, fromip, bindport)<0 THEN Err("cannot open udp socket") END;
          fd:=udp.openudp();
          rawread:=lasth="R";
          IF lasth="L" THEN 
            n:=0;
            IF h[i-1]=":" THEN
              LOOP
                IF i>=HIGH(h) THEN EXIT END;
                IF h[i]=0C THEN EXIT END;
                rflinkname[n]:=h[i];
                INC(i);
                INC(n);
              END;
            END;
            IF n=0 THEN Err("-L ip:port:name") END;
          END;
          IF (fd>=0) & (fromip<>STDINIP) & (udp.bindudp(fd, bindport)<0) THEN Err("cannot bind inport") END;
          next:=NIL;
        END;
        IF insocks<>NIL THEN actsock^.next:=insocks END;
        insocks:=actsock;

      ELSIF lasth="f" THEN
        NextArg(h);
        IF actsock=NIL THEN Err("need input -M or -R before -f") END;
        actpass:=SET256{};
        IF (h[0]<>cFILTDEL) & (h[0]<>cFILTPASS) THEN Err("-f (p)ass or (d)elete needed") END;
        i:=1;
        n:=0;
        nold:=256;
        LOOP
          IF i>=HIGH(h) THEN EXIT END;
          IF (h[i]>="0") & (h[i]<="9") THEN n:=n*10 + ORD(h[i]) - ORD("0");
          ELSE
            LOOP 
              IF (n>0) & (n<256) THEN INCL(actpass, n) END;
              IF n<=nold THEN EXIT END;
              DEC(n);
            END;
            nold:=256; 
            IF h[i]="-" THEN nold:=n ELSIF h[i]<>"," THEN EXIT END;
            n:=0;
          END;  
          INC(i);
        END;
        IF h[0]=cFILTDEL THEN

          actpass:=-actpass;  (* c translate problem *)
(*
          FOR i:=0 TO MAX(SET256) DO 
            IF i IN actpass THEN EXCL(actpass, i) ELSE INCL(actpass, i) END;
          END;
*)
        END;  

      ELSIF lasth="k" THEN
        NextArg(h);
        IF actsock=NIL THEN Err("need input -M or -R before -k") END;
        i:=0;
        IF NOT getfix(actpos.lat, h, i) THEN Err("latitude in deg") END;
        INC(i); 
        IF (h[i-1]<>"/") OR NOT getfix(actpos.long, h, i) THEN Err("longitude in deg") END;
        INC(i);
        IF (h[i-1]<>"/") OR NOT getfix(actkm, h, i) OR (actkm>=FLOAT(MAX(INTEGER))) THEN 
          Err("distance in km");
        END;

      ELSIF lasth="b" THEN
        NextArg(h);
        IF actsock=NIL THEN Err("need input -M or -R before -b") END;
        WITH actbeacon DO
          i:=0;
          IF (GetSec(h,i,n)>=0) & (h[i]=":") THEN 
            bintervall:=n;
            btime:=bintervall+time();
            bline:=0;
            INC(i);
            FOR n:=0 TO HIGH(bfile) DO IF i<=HIGH(h) THEN bfile[n]:=h[i]; INC(i) END; END;
          ELSE Err("beacon format is time:file") END;
        END;

      ELSIF lasth="d" THEN
        NextArg(h);
        IF actsock=NIL THEN Err("need input -M or -R before -d") END;

        ALLOCATE(actdigi, SIZE(actdigi^));
        IF actdigi=NIL THEN Err("out of memory") END;
        WITH actdigi^ DO
          MakeRawCall(digicall, h, 0);
          IF (digicall[0]=0C) OR (digicall[CALLLEN-1]=0C) THEN Err("wrong digi callsign") END;
          FOR i:=0 TO HIGH(timehash) DO timehash[i]:=0 END;
          duptime:=DEFAULTDUPTIME;
          messagetime:=DEFAULTMESSAGETIME;
          pathcheck:=PATHSET{};
        END;

      ELSIF lasth="e" THEN actecho:=TRUE

      ELSIF (lasth="r") OR (lasth="m") OR (lasth="c")
         OR (lasth="l") OR (lasth="D") OR (lasth="n") THEN
        IF actsock=NIL THEN Err("need input -M or -R before -r or -m or -c or -D") END;
        IF lasth<>"D" THEN NextArg(h) END;

        ALLOCATE(outsock, SIZE(outsock^));
        IF outsock=NIL THEN Err("out of memory") END;
        WITH outsock^ DO
          decode:=FALSE;
          IF lasth="D" THEN
            toport:=0; 
            decode:=TRUE;
          ELSIF GetIp(h, i, toip, toport)<0 THEN Err("wrong udp:port") END;
          aprspass:=actpass;
          echo:=actecho; 
          digiparm:=actdigi;
          axudp2:=lasth="l";
          rawwrite:=(lasth="r") OR axudp2 OR (lasth="n");
          crlfwrite:=lasth="c";
          rawpayload:=lasth="n";          
          beacon:=actbeacon;
          actbeacon.bintervall:=0;
          passnoUI:=actpassui;
          satgate:=actsat;
          next:=NIL;
          filtercalls:=actcall;
          invertfilter:=actinvert;
          mypos.lat :=actpos.lat*RAD;
          mypos.long:=actpos.long*RAD;
          maxkm:=TRUNC(actkm);
        END;
        actdigi:=NIL;
        actpassui:=FALSE;
        actecho:=FALSE;
        onext:=actsock^.outchain;
        IF onext=NIL THEN actsock^.outchain:=outsock;
        ELSE 
          WHILE onext^.next<>NIL DO onext:=onext^.next END;
          onext^.next:=outsock;
        END;

      ELSIF lasth="h" THEN
        WrLn;
        WrStrLn(" -a <paths>     user message ack path eg. WIDE2-2 or - for no path");
        WrStrLn(" -b <s>:<file>  enable beacon every s(econds) path and text from <file>");
        WrStrLn("                cycles thru lines in file, empty lines = no tx (size max 32kb)");
        WrStrLn("                \\z ddhhmm, \\h hhmmss, \\:filename: insert file, \\[filename]");
        WrStrLn("                insert file and delete after, \\(filename) if exists insert");
        WrStrLn("                and delete,\\\ is \\, \\rm delete beacon file");
        WrStrLn("                file may be modified any time eg. by telemetry program");
        WrStrLn(" -c <ip>:<port> send text monitor udp frame with cr lf");
        WrStrLn(" -D             output decoded Data to stdout");
        WrStrLn(" -d <call>      digipeater enable (and dupe filter) call");
        WrStrLn(" -d -           dupe filter without data modification");
        WrStrLn(" -e             echo last (filtert) output");
        WrStrLn(" -f <filterparm>  'p<x>,<x>...' pass UI frames with first char (-f p58,110)");
        WrStrLn("                  'd<x>,<x>...' pass UI frames with not first char (-f d32,65-79)");
        WrStrLn("                  Messages to itself are treated as Telemetry  (-f d84)");
        WrStrLn(" -h             this");
        WrStrLn(" -k <deg>/<deg>/<km> distance filter, center/radius -k 48.2/13.5/100");
        WrStrLn("                -k 0/0/20000 remove all (not user msg) with no position data");
        WrStrLn(" -L <ip>:<port>:<netname>   read monitor rflink header with netname");
        WrStrLn(" -l <ip>:<port> send raw axudp frame and pass thru axudp2 header");
        WrStrLn(" -M <ip>:<port> read text monitor udp frame");
        WrStrLn("                ip=255.255.255.255:0 read text monitor from stdin");
        WrStrLn("                ip=255.255.255.255:1 read text monitor from stdin and terminate");
        WrStrLn(" -m <ip>:<port> send text monitor udp frame 0 terminated");
        WrStrLn(" -n <ip>:<port> send raw payload (no axudp header and crc) udp frame");
        WrStrLn(" -p <n>,<...>   -p 0,1,5,6,7,8,9 first hop digi, -p 3,4 (noisy) last hop digi");
        WrStrLn("                -p 0,1,3,4,5,6,7,8,9,14,16 original, noisy, path loosing, do not use");
        WrStrLn("                0..2 limit ssid-routing to (bit0 + 2*bit1 + 4*bit2)");
        WrStrLn("                dest-3: dest-2,digicall*, dest-3,call*: dest-2,call,digicall*");
        WrStrLn("                3 allow repeatet before (mostly with wrong path trace)");
        WrStrLn("                4 no uplink check for 'looks like direct heard'");
        WrStrLn("                  (noisy, wrong path trace possible)");
        WrStrLn("                5 resend TRACEn-(N-1), 6 resend WIDEn-(N-1)");
        WrStrLn("                  so frames may be relayed again by loss of downlink trace");
        WrStrLn("                7 append remaining digi path after via digicall");
        WrStrLn("                8 append remaining digi path after RELAY/GATE/TRACE");
        WrStrLn("                9 append remaining digi path after WIDE");
        WrStrLn("                  so frames may be relayed again by loss of downlink trace");
        WrStrLn("                10, 11, 12, 13 switch off via digicall, RELAY, TRACE, WIDE");
        WrStrLn("                14 insert not digicall on direct heared before WIDEn-N,");
        WrStrLn("                   as others do, your digi is hidden, and path is shown wrong");
        WrStrLn("                15 convert destination ssid routing to WIDEn-n");
        WrStrLn("                16 send n-0 without repeated flag");
        WrStrLn("                17 remove all WIDE from downlink path");
        WrStrLn("                18 enable via GATE (use as gate: disable via all other)");
        WrStrLn("                19 allow ECHO as alias to RELAY");
        WrStrLn(" -P <s>         piggyback time sending beacon earlier if sent anything now");
        WrStrLn(" -R <ip>:<port> read raw axudp frame, 0 ip read from all (-R 0.0.0.0:2000)");
        WrStrLn(" -r <ip>:<port> send raw axudp frame");
        WrStrLn(" -S             Satgate, filter out uplink (has via with no h-bit)");
        WrStrLn(" -s             pass not-UI-frames too (all PR-Frames, SABM, RR..)");
        WrStrLn("                (raw axudp only) and axudp2 modem to layer2 message frames");
        WrStrLn(" -t <s>,<s>     dupe filter time in seconds (all types, user messages)");
        WrStrLn("                -t 1740,28 29min not same beacon, 28s for retrying user message)");
        WrStrLn(" -u <call>:<file> global option, receive & ack usermessages to call store in file");
        WrStrLn("                repeat -u for more Calls to same or different File");
        WrStrLn(" -v             show frames and analytics on stdout");
        WrStrLn(" -X             same as -x but pass only frames with this calls");
        WrStrLn(" -x <call>{,<call>} delete frames with call in a address field, -x TCPIP,N?CALL*");
        WrStrLn("udpbox -v -M 0.0.0.0:9200 -d MYCALL-10 -p 0,1,7 -t 1800,28 -r 192.168.1.24:9400");
        WrLn;

        HALT

      ELSIF lasth="s" THEN actpassui:=TRUE;
      ELSIF lasth="S" THEN actsat:=TRUE;
      ELSIF lasth="t" THEN
        IF actdigi=NIL THEN Err("need -d before -t") END;
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN 
          actdigi^.duptime:=n;
          INC(i);
          IF (h[i-1]=",") & (GetSec(h,i,n)>=0) THEN actdigi^.messagetime:=n END; 
        END;

      ELSIF lasth="P" THEN
        IF actsock=NIL THEN Err("need input -M or -R before -P") END;
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN actbeacon.piggytime:=n END;

      ELSIF lasth="p" THEN
        IF actdigi=NIL THEN Err("need -d before -p") END;
        NextArg(h);
        i:=0;
        WHILE GetSec(h,i,n)>=0 DO 
          IF n<31 THEN INCL(actdigi^.pathcheck, n) END;
          IF h[i]="," THEN INC(i) END;
        END;

      ELSIF lasth="u" THEN
        NextArg(h);
        ALLOCATE(user, SIZE(user^));
        IF user=NIL THEN Err("out of memory") END;
        WITH user^ DO
          wpos:=0;
          msgfile[0]:=0C;
          FOR i:=0 TO HIGH(hash) DO hash[i].ackcnt:=0 END;
          i:=0;
          n:=0;
          WHILE (n<=HIGH(usercall)) & (h[i]<>0C) & (h[i]<>":") DO 
            usercall[n]:=h[i]; INC(n); INC(i);
          END;
          WHILE n<=HIGH(usercall) DO usercall[n]:=" "; INC(n) END;
          IF h[i]<>0C THEN
            INC(i);
            n:=0;
            WHILE (n<=HIGH(msgfile)) & (h[i]<>0C) DO msgfile[n]:=h[i]; INC(n); INC(i) END;
          END;
          next:=NIL;
        END;
        IF msgusers<>NIL THEN user^.next:=msgusers END;  
        msgusers:=user;

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

      ELSIF (lasth="x") OR (lasth="X") THEN
        actinvert:=lasth="X";
        NextArg(h);
        IF actsock=NIL THEN Err("need input -M or -R before -x") END;

        i:=0;
        LOOP
          ALLOCATE(callnext, SIZE(callnext^));
          IF callnext=NIL THEN Err("out of memory") END;

          callnext^.call:="";
          WHILE (h[i]<>",") & (i<=HIGH(h)) & (h[i]>" ") DO
            Append(callnext^.call, h[i]);
            INC(i);
          END;
          callnext^.next:=actcall;
          actcall:=callnext;
          IF (i>=HIGH(h)) OR (h[i]<=" ") THEN EXIT END;

          INC(i);
        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 showstr(s-:ARRAY OF CHAR);

  PROCEDURE Hex(b:SET8):CHAR;
  VAR d:CARDINAL;
  BEGIN
    d:=CAST(CARDINAL, b*SET8{0..3});
    IF d>9 THEN INC(d, ORD("A")-10-ORD("0")) END;
    RETURN CHR(d+ORD("0"))  
  END Hex;

VAR i,j:CARDINAL;
    h:ARRAY[0..1023] OF CHAR; 
BEGIN
  i:=0;
  j:=0;
  WHILE (i<=HIGH(s)) & (s[i]<>0C) & (j<HIGH(h)-5) DO
    IF s[i]<" " THEN 
      h[j]:="<"; INC(j);
      h[j]:=Hex(SHIFT(CAST(SET8, s[i]), -4)); INC(j);
      h[j]:=Hex(CAST(SET8, s[i])); INC(j);
      h[j]:=">";
    ELSE h[j]:=s[i] END;
    INC(i);
    INC(j);
  END;
  h[j]:=0C;
  WrStrLn(h); 
END showstr;
*)

-------------------- decode to stdout


PROCEDURE Showpos(rawb:ARRAY OF CHAR; rawlen:INTEGER);

 PROCEDURE GetTLM(VAR v:TELEMETRY; b-:ARRAY OF CHAR);

  PROCEDURE r91(VAR n:CARD16; c:CHAR):BOOLEAN;
  BEGIN
    IF (c<CHR(33)) OR (c>CHR(33+91)) THEN RETURN FALSE END;
    n:=n*91 + (ORD(c)-33);
    RETURN TRUE
  END r91;

 VAR i, j, ia, ib:CARDINAL;
    t:TELEMETRY;
 BEGIN
  ia:=0;
  ib:=0;
  i:=0;
  WHILE (i<HIGH(b)) & (b[i]<>0C) DO
    IF b[i]="|" THEN ib:=ia; ia:=i+1 END;
    INC(i);
  END;
  IF (ib>0) & ODD(ia-ib) & (ia-ib>=5) & (ia-ib<=(HIGH(t)+1)*2+1) THEN
    i:=0;
    j:=ib;
    REPEAT
      t[i]:=0;
      IF NOT r91(t[i], b[j]) OR NOT r91(t[i], b[j+1]) THEN RETURN END;

      INC(i);
      INC(j, 2);
    UNTIL j+1>=ia;
    FOR ia:=0 TO i-1 DO v[ia]:=t[ia]+1 END;
--    b[ib-1]:=0C;
--    Delstr(b, ib-1, j-ib+2);
  END;
 END GetTLM;

 PROCEDURE GetClb(VAR clb:INTEGER; VAR com: ARRAY OF CHAR);
 VAR i:INTEGER;
    sig:BOOLEAN;
 BEGIN
  clb:=0;
  i:=InStr(com, "Clb=");
  IF i>=0 THEN
    INC(i, 4);
    sig:=FALSE;
    IF com[i]="-" THEN sig:=TRUE; INC(i) END;
    WHILE (i<=VAL(INTEGER,HIGH(com))) & (clb<1000) & (com[i]>="0") & (com[i]<="9") DO
      clb:=clb*10+VAL(INTEGER, ORD(com[i])-ORD("0"));
      INC(i);
    END;
    IF sig THEN clb:=-clb END;
  END;
 END GetClb;

 PROCEDURE WrTelemetry(t-:TELEMETRY; VAR s:ARRAY OF CHAR);
 VAR i, n:CARDINAL;
    h:ARRAY[0..30] OF CHAR;
 BEGIN
  Assign(s, " telemetry=");
  i:=0;
  LOOP
    IF t[i]<>0 THEN
      IF i<>HIGH(t) THEN IntToStr(t[i]-1, 1, h); Append(s, h);
      ELSE
        n:=t[i]-1;
        IF n>=256 THEN n:=n MOD 8192+8192 ELSE n:=n MOD 256+256 END;
        WHILE n>1 DO Append(s, CHR(ORD(ODD(n))+ORD("0"))); n:=n DIV 2 END;
      END;
    END;
    INC(i);
    IF i>HIGH(t) THEN EXIT END;

    Append(s, ",");
  END;
 END WrTelemetry;


VAR destcall, payload, altitude, clb, i, j:INTEGER;
    speed, course, len:CARDINAL;
    sym, symt:CHAR;
    comment, ts, b:ARRAY[0..500] OF CHAR;
    postyp:CHAR;
    pos:POSITION;
    tel:TELEMETRY;
BEGIN
  raw2mon(rawb, b, rawlen-2, len, GHOSTSET{});

  IF len<=HIGH(b) THEN b[len]:=0C END;
  LOOP                                                        (* remove 3rd party head *)
    payload:=InStr(b, HEADEREND+THIRDPARTY);  
    IF payload<=0 THEN EXIT END;

    Delstr(b, 0, payload+2);
  END;
  destcall:=InStr(b, ">");
  payload:=InStr(b, HEADEREND);
  IF (destcall>0) & (payload>destcall) THEN
    speed:=0;
    course:=1000;
    altitude:=-10000;
    GetPos(pos, speed, course, altitude, sym, symt, b, destcall+1, payload+1, comment, postyp);
    IF posvalid(pos) THEN
      WrStr("lat="); WrFixed(pos.lat*(1.0/RAD), 5, 1);
      WrStr(" long="); WrFixed(pos.long*(1.0/RAD), 5, 1);

      IF altitude>-10000 THEN WrStr(" alt="); WrInt(altitude, 1) END;

      IF speed>0 THEN

        IF (symt="/") & (sym="_") THEN speed:=VAL(CARDINAL, FLOAT(speed)*WKNOTS+0.5)
        ELSE speed:=VAL(CARDINAL, FLOAT(speed)*KNOTS+0.5) END;
        WrStr(" speed="); WrInt(speed, 1);

        IF course<=360 THEN WrStr(" course="); WrInt(course MOD 360, 1) END;
      END;

      GetClb(clb, comment);
      IF clb<>0 THEN WrStr(" clb="); WrInt(clb, 1) END;

      tel[0]:=0;
      GetTLM(tel, comment);
      IF tel[0]<>0 THEN WrTelemetry(tel, ts); WrStr(ts); END;

      WrStr(" call=");
      i:=payload+1;
      IF b[i]=";" THEN INC(i); j:=i+9;                                    (* object *)
      ELSIF b[i]=")" THEN                                                 (* item *)
        INC(i);
        j:=i+3;
        WHILE (j<i+9) & (b[j]<>"_") & (b[j]<>"!") DO INC(j) END;
      ELSE i:=0; j:=destcall END;

      WHILE (i<j) & (b[i]>=" ") & (b[i]<177C) DO WrStr(b[i]); INC(i) END;


      WrStr(" comment=");
      j:=0; 
      WHILE (j<=HIGH(comment)) & (comment[j]<>0C) DO
        IF (comment[j]>=" ") & (comment[j]<=CHR(127)) THEN WrStr(comment[j]) END;
        INC(j);
      END;

      WrLn;
    END;
  END;
END Showpos;


-------------------- decode to stdout

PROCEDURE WrStrCrtl(b:ARRAY OF CHAR);
BEGIN
  CtrlHex(b);
  WrStrLn(b);
END WrStrCrtl;

PROCEDURE hexdump(b-:ARRAY OF CHAR; len:INTEGER);
VAR i:INTEGER;
BEGIN
  FOR i:=0 TO len-1 DO WrHex(ORD(b[i]),3) END;
  WrLn;
END hexdump;

PROCEDURE cpraw(VAR in, out:ARRAY OF CHAR; VAR len:INTEGER);
VAR i,n,e:INTEGER;
    c:CHAR;
    h:BOOLEAN;

  PROCEDURE showhex(s-:ARRAY OF CHAR);
  VAR i:INTEGER;
  BEGIN
    IF show THEN
      WrLn;
      WrStrLn(s);
      FOR i:=0 TO len-1 DO WrHex(ORD(in[i]),3) END;
      WrLn;
      FOR i:=0 TO e-1 DO
        n:=ORD(in[i]) DIV 2;
        IF n<ORD(" ") THEN WrStr("<"); WrHex(ORD(n),1); WrStr(">")
        ELSE WrStr(CHR(n)) END;
        IF i MOD 7=6 THEN WrStr(",") END;
      END;
      WrLn;
    END;
  END showhex;

BEGIN
  e:=0;
  FOR i:=0 TO len-1 DO
    c:=in[i];
    out[i]:=c;
    IF (e=0) & ODD(ORD(c)) THEN e:=i+1 END;
  END;
  IF len=2 THEN RETURN END;                        (* crc only, maybe there is a axudp2 head*)

  IF (VAL(CARDINAL,e) MOD CALLLEN<>0) OR (e<CALLLEN*2) OR (e>CALLLEN*10) THEN
    showhex(" bad raw format, no address end found");
    len:=0;
  ELSE 
    h:=TRUE;
    FOR i:=CALLLEN*3-1 TO e-1 BY CALLLEN DO
      IF ORD(in[i])>=128 THEN
        IF NOT h THEN
          showhex(" bad H bit in raw frame"); 
          len:=0;
        END; 
        h:=TRUE;
      ELSE h:=FALSE END;
    END;
  END;
END cpraw;


PROCEDURE beaconmacros(VAR s:ARRAY OF CHAR; VAR del:BOOLEAN);
CONST MSYM="\";
      INSFN=":";              (* insert file and send no beacon if missing *)
      INSFNEND=":";
      DELFN="[";              (* insert file, delete and send no beacon if missing *)
      DELFNEND="]";
      DELFNN="(";             (* insert file, delete and insert nothing if missing *)
      DELFNNEND=")";

VAR i:CARDINAL;
    len,j:INTEGER;  
    ds,ns:ARRAY[0..255] OF CHAR;
    fn:ARRAY[0..1023] OF CHAR;
    f:File;
    fnend:CHAR;
    voidok:BOOLEAN;
BEGIN
  del:=FALSE;
  i:=0;
  ns[0]:=0C;
  WHILE (i<HIGH(s)) & (s[i]<>0C) DO
    IF (s[i]=MSYM) & (s[i+1]=MSYM) THEN
      INC(i, 2);
      IF s[i]="z" THEN                                     (* insert day, hour, min *)
        DateToStr(time(), ds);
        ds[0]:=ds[8]; ds[1]:=ds[9]; ds[2]:=ds[11]; ds[3]:=ds[12]; ds[4]:=ds[14]; ds[5]:=ds[15];
        ds[6]:=0C;
        Append(ns, ds); 
      ELSIF s[i]="h" THEN                                  (* insert hour, min, s *)
        DateToStr(time(), ds);
        ds[0]:=ds[11]; ds[1]:=ds[12]; ds[2]:=ds[14]; ds[3]:=ds[15]; ds[4]:=ds[17]; ds[5]:=ds[18];
        ds[6]:=0C;
        Append(ns, ds); 
      ELSIF (s[i]=INSFN) OR (s[i]=DELFN) OR (s[i]=DELFNN) THEN      (* insert file *)
        IF s[i]=INSFN THEN fnend:=INSFNEND ELSIF s[i]=DELFNN THEN fnend:=DELFNNEND
        ELSE fnend:=DELFNEND END; 
        fn[0]:=0C;
        INC(i);
        WHILE (i<HIGH(s)) & (s[i]<>0C) & (s[i]<>fnend) DO Append(fn, s[i]); INC(i) END;
        f:=OpenRead(fn);
        IF f>=0 THEN
          len:=RdBin(f, ds, SIZE(ds)-1);
          Close(f);
          IF (fnend=DELFNEND) OR (fnend=DELFNNEND) THEN Erase(fn, voidok) END; (* delete insert file after inserting *)
          j:=0;
          WHILE (j<len) & (ds[j]<>CR) & (ds[j]<>LF) & (ds[j]<>0C) DO 
            Append(ns, ds[j]); 
            INC(j);
          END;
        ELSIF fnend<>DELFNNEND THEN                        (* skip whole beacon line *)
          IF show THEN WrLn; WrStr("beacon macro file not readable "); END;
          s[0]:=0C;
          RETURN

        END; 
      ELSIF (s[i]="r") & (s[i+1]="m") THEN   (* delete beacon file *)
        s[0]:=0C;
        del:=TRUE;
        RETURN

      ELSIF s[i]="\" THEN Append(ns, "\\");
      ELSE
        IF show THEN WrLn; WrStr("bad beacon macro "); END;
        s[0]:=0C;
        RETURN

      END; 
    ELSE Append(ns, s[i]) END;
    INC(i);
  END;
  Assign(s, ns);
END beaconmacros;


PROCEDURE beacon(insock:pINSOCK; VAR buf:ARRAY OF CHAR; VAR len:INTEGER; VAR outsock:pOUTPORT);
VAR i, bol, eol, lc:INTEGER;
    f   :File;
    fb  :ARRAY[0..32767] OF CHAR;
    t   :TIME;
    del,
    ok:BOOLEAN;
BEGIN
  len:=0;
  outsock:=insock^.outchain;
  LOOP
    IF outsock=NIL THEN len:=0; EXIT END;
    WITH outsock^.beacon DO
      t:=time();
      IF piggyback THEN INC(t, piggytime) END;
      piggyback:=FALSE;
      IF (bintervall>0) & (bfile[0]<>0C) & (btime<=t) THEN
        INC(btime, bintervall);
        IF btime<=t THEN btime:=t+bintervall END;
        f:=OpenRead(bfile);
        IF f>=0 THEN
          len:=RdBin(f, fb, SIZE(fb)-1);
          Close(f);
    

          WHILE (len>0) & (fb[len-1]<=" ") DO DEC(len) END;      (* remove junk from eof *)
          IF (len>0) & (len<HIGH(fb)) THEN fb[len]:=LF; INC(len) END; 


          REPEAT
            lc:=bline;
            eol:=0;
            LOOP
              bol:=eol;
              WHILE (eol<len) & (fb[eol]<>LF) DO INC(eol) END;
              IF eol>=len THEN bol:=eol; IF bline<>0 THEN lc:=1; bline:=0 END; EXIT END;
              IF fb[bol]<>"#" THEN
                IF lc=0 THEN INC(bline); EXIT END;
                DEC(lc);
              END;
              INC(eol);
            END;
          UNTIL lc=0;

          i:=0;
          WHILE bol<eol DO fb[i]:=fb[bol]; INC(i); INC(bol) END;
          fb[i]:=0C;
(*
IF show THEN WrStrLn(fb) END;
*)        

          len:=0;
          IF i>0 THEN 
            beaconmacros(fb, del);
            IF del THEN Erase(bfile, ok) ELSE mon2raw(fb, buf, len) END;

IF show & (len=0) THEN WrLn; 
IF del THEN WrStrLn("delete beacon file "); ELSE WrStrLn("bad beacon format "); END;
END;

          END;
          EXIT

        ELSIF show THEN WrStrLn("beacon file not found") END;
      END;
      outsock:=outsock^.next;
    END; 
  END;
END beacon;

PROCEDURE sendack(VAR buf:ARRAY OF CHAR; VAR len:INTEGER; fromsock:pINSOCK);
CONST ACKTIME=30;

VAR m:INTEGER;
    i,j:CARDINAL;
    user:pMSGHASH;
    fb:ARRAY[0..255] OF CHAR;
    t:TIME;
BEGIN
  user:=msgusers;
  t:=time();
  WHILE user<>NIL DO
    len:=0;
    WITH user^ DO
      FOR m:=0 TO HIGH(hash) DO
        WITH hash[m] DO
          IF (ackcnt>0) & (acktime<t) & (fromsock=source) THEN
            DEC(ackcnt);
            acktime:=t+ACKTIME; 

            j:=0;
            i:=0;
            WHILE (i<=HIGH(usercall)) & (usercall[i]>" ") DO 
              fb[j]:=usercall[i];
              INC(j);
              INC(i);
            END;

            i:=0;
            WHILE ackpath[i]>" " DO fb[j]:=ackpath[i]; INC(j); INC(i); END;

            FOR i:=0 TO 8 DO fb[j]:=froms[i]; INC(j); END;
            fb[j]:=":";
            INC(j); 

            i:=0;
            WHILE ACKMSG[i]>" " DO fb[j]:=ACKMSG[i]; INC(j); INC(i); END;
(*
IO.WrLn; IO.WrStr("    <"); IO.WrStr(hash[m].acks); IO.WrStrLn(">");
*)
            i:=0;
            WHILE acks[i]>" " DO fb[j]:=acks[i]; INC(j); INC(i); END;

            fb[j]:=0C;
(*
IO.WrLn; IO.WrStr("    <"); IO.WrStr(fb); IO.WrStrLn(">");
*)
            mon2raw(fb, buf, len);
IF show & (len=0) THEN WrStr(fb); WrStrLn(" message ack path wrong") END;


            RETURN
          END;
        END;
      END;
      user:=next;
    END;
  END;
END sendack;


PROCEDURE stripheadcrc(VAR b:ARRAY OF CHAR; VAR len:INTEGER);
VAR i, j:INTEGER;
BEGIN
  i:=findpayload(b, len);
  j:=0;
  WHILE i<len DO b[j]:=b[i]; INC(i); INC(j) END;
  len:=j-2;                                            (* strip crc *)
END stripheadcrc;

PROCEDURE appudp2(VAR ob:ARRAY OF CHAR; VAR olen:CARDINAL; ud-, ib-:ARRAY OF CHAR; len:INTEGER); (* append axudp2 header *)
VAR i, j:INTEGER;
BEGIN
  i:=0;
  j:=0;
  WHILE ud[i]<>0C DO ob[i]:=ud[i]; INC(i) END;
  IF i>0 THEN ob[i]:=0C; INC(i) END;
  DEC(len, 2);
  WHILE j<len DO ob[i]:=ib[j]; INC(i); INC(j) END;
  olen:=i+2;
  AppCRC(ob, i);
END appudp2;


VAR 
    ibuf, rawbuf, rawout, workraw : ARRAY[0..MAXLEN-1] OF CHAR;
    udp2                  : ARRAY[0..63] OF CHAR;                    (* axudp2 header *)
    mbuf                  : ARRAY[0..511] OF CHAR;
    inlen, outlen,
    worklen, res          : INTEGER;
    monlen                : CARDINAL;
    actsock               : pINSOCK;
    outsock, isbeacon     : pOUTPORT;
    nobeacon,
    piggy                 : BOOLEAN;
    hamup                 : RAWCALL;

BEGIN
  stdinpos:=0; 
  insocks:=NIL;
  parms;


  LOOP
    fdclr;
    actsock:=insocks;
    IF (insocks<>NIL) & (insocks^.fromip=STDINIP) THEN fdsetr(STDIN) END; 
    WHILE actsock<>NIL DO
      WITH actsock^ DO
        IF fd>=0 THEN fdsetr(fd) END;
        actsock:=next;
      END;
    END;
    IF selectr(1, 0)>=0 THEN

      actsock:=insocks;
      WHILE actsock<>NIL DO  
        
        REPEAT
          piggy:=FALSE;

          inlen:=0; 
          IF (actsock^.fd>=0) & issetr(actsock^.fd) THEN
            inlen:=getudp(actsock^.fd, ibuf, actsock^.fromip, actsock^.rawread);
          ELSIF issetr(STDIN) & (actsock^.fromip=STDINIP) THEN inlen:=getstdin(ibuf) END;
          udp2[0]:=0C;
          IF (inlen>0) & (ibuf[0]=1C) THEN extrudp2(ibuf, udp2, inlen) END;     (* axudp2 *)

          hamup[0]:=0C;
          IF inlen>0 THEN
            nobeacon:=TRUE;
            IF actsock^.rawread THEN cpraw(ibuf, rawbuf, inlen);
            ELSE
              IF inlen<=HIGH(ibuf) THEN ibuf[inlen]:=0C END;
              checkhamnet(ibuf, inlen, actsock^.rflinkname, hamup);
              IF inlen>0 THEN
                mon2raw(ibuf, rawbuf, inlen);
                IF show & (inlen=0) THEN WrStrLn("bad mon format "); END;
              ELSIF show THEN WrStrLn("no rflink head match"); END;
            END;
            isbeacon:=NIL;
          ELSIF inlen>=0 THEN
            nobeacon:=FALSE;
            beacon(actsock, rawbuf, inlen, isbeacon);
            IF isbeacon=NIL THEN sendack(rawbuf, inlen, actsock) END;
          END; 
 
          IF inlen>=2 THEN
            IF show & (inlen>2) THEN
              raw2mon(rawbuf, mbuf, inlen-2, monlen, GHOSTSET{});
              WrLn;
              showpip(showip, showport);
              WrStr("("); WrInt(inlen,1); WrStr(")"); 
              WrStr(":");
              IF monlen<=0 THEN
                WrStr("<rawframe decode error>");
                hexdump(rawbuf, inlen-2);
              END; 
              WrStrCrtl(mbuf);
            END;

            outsock:=actsock^.outchain;
            outlen:=inlen;
            rawout:=rawbuf;
            WHILE outsock<>NIL DO
              IF show & (inlen>2) & (outsock^.toport<>0) THEN
                WrStr(" tx: "); showpip(outsock^.toip, outsock^.toport);
              END;
              IF ((isbeacon=NIL) OR (isbeacon=outsock) OR outsock^.echo) THEN
                IF NOT outsock^.echo THEN outlen:=inlen; rawout:=rawbuf END; 
                IF (outlen>0) & NOT Filter(rawout, outlen, outsock, actsock) THEN outlen:=0 END;

                IF (outlen>0) & (outsock^.digiparm<>NIL) THEN 
                  Digi(rawout, workraw, outlen, worklen, hamup, outsock^.digiparm, NOT nobeacon);
                  outlen:=worklen;
                  rawout:=workraw;
                  IF show & (outlen>2) THEN WrStr(" digi"); END;
                END;                                                 (* else use last filtert *)

                IF outlen>0 THEN
                  outsock^.beacon.piggyback:=TRUE;
                  piggy:=TRUE;
                  IF outsock^.decode THEN Showpos(rawout, outlen) END;
                  IF outsock^.toport<>0 THEN
                    IF outsock^.rawwrite THEN
                      IF outsock^.axudp2 THEN
                        appudp2(mbuf, monlen, udp2, rawout, outlen);
                        res:=udp.udpsend(actsock^.fd, mbuf, monlen, outsock^.toport, outsock^.toip);
                      ELSE
                        IF outsock^.rawpayload THEN stripheadcrc(rawout, outlen);
                        ELSE AppCRC(rawout, outlen-2) END;
                        IF outlen>0 THEN res:=udp.udpsend(actsock^.fd, rawout, outlen, outsock^.toport, outsock^.toip) END;
                      END;
                      IF show & (outlen>2) THEN WrStrLn(" raw") END;
                    ELSE
                      raw2mon(rawout, mbuf, outlen-2, monlen, GHOSTSET{});
                      IF monlen>0 THEN
                        IF outsock^.crlfwrite THEN 
                          mbuf[monlen-1]:=CR; mbuf[monlen]:=LF; INC(monlen);
                        END; 
                        res:=udp.udpsend(actsock^.fd, mbuf, monlen, outsock^.toport, outsock^.toip);
                        IF show THEN WrStrLn(" mon") END;
                      ELSIF show THEN WrStrLn(" monerr") END;
                    END;
                  END;
                ELSIF show THEN WrStrLn(" no tx") END;
              ELSIF show & (outlen>2) THEN WrStrLn(" no input data") END;
              outsock:=outsock^.next;
            END;
          END;
          IF (insocks<>NIL) & (insocks^.fromip=STDINIP)
          & ((insocks^.bindport=1) OR (inlen<0)) THEN EXIT END; (* single stdin line mode or eof *)
          
        UNTIL NOT piggy;   
        actsock:=actsock^.next;
      END;
    END;
  END;
END udpbox.