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

<*NEW PROXY*>
<*-PROXY*>
<*NEW SONDE*>
<*+SONDE*>
<*NEW SRTM*>
<*+SRTM*>

MODULE udpgate4; (* axudp / tcpip aprs-is gateway (message relay and query answers removed) by OE5DXL *)

IMPORT udp, tcp;
FROM osi IMPORT WrLn, WrStr, WrStrLn, WrInt, WrHex, NextArg, WrFixed, sqrt, arctan,
                OpenRead, OpenAppend, OpenWrite, Close, Rename, keepalive,
                WrBin, RdBin, Size, Seek, Exists, pi, time, ALLOCATE, DEALLOCATE, DIRSEP,
                DIRCONTEXT, OpenDir, CloseDir, ReadDirLine, OpenNONBLOCK;

FROM Select IMPORT selectrw, fdclr, fdsetr, fdsetw, issetr, issetw;
FROM SYSTEM IMPORT CAST, SHIFT, ADR, CARD8, CARD16, INT8, INT16, FILL;
FROM aprspos IMPORT RAD, posvalid, distance, GetPos, GetSym, KNOTS, wgs84s, azimuth,
             ENCODEGPS, ENCODEMICE, ENCODECOMP, ENCODEGPSDAO, ENCODEMICEDAO;

FROM aprsstr IMPORT TIME, Assign, Append, Length, IntToStr, FixToStr, StrToFix, Delstr,
     StrCmp, InStr, TimeToStr, DateToStr, CtrlHex, IPNUM, UDPPORT, SET8, postoloc,
     AppCRC, mon2raw, raw2mon, GetIp2, CardToStr, extrudp2, GHOSTSET, POSITION, showctrl;

FROM signal IMPORT signal, SIGHUP;

<* IF SRTM THEN *>
FROM libsrtm IMPORT srtmdir, srtmmaxmem, egm96, getsrtm;
<* END *>


CONST CALLLEN=7;
      HASHSIZE=65536;

<* IF __GEN_C__ THEN *>
      VERS="udpgate 0.81";
<* ELSE *>
      VERS="udpgate(m) 0.81";
<* END *>
 
      CPUTEMPFN="/sys/class/thermal/thermal_zone0/temp";
      CONNECTS="connects";
      INDEXHTML="index.html";
      INFOHTML="info.html";
      CANTBIND="trying to bind to port ";
      KEEPALIVE_IDLE_USER=300;
      KEEPALIVE_INTERVALL_USER=60;
      KEEPALIVE_COUNT_USER=3;
      KEEPALIVE_IDLE_IS=180;
      KEEPALIVE_INTERVALL_IS=30;
      KEEPALIVE_COUNT_IS=2;

      TOCALL="APNL51";
      HTTPTIMEOUT=60;
      APRSLISTENSOCKS=4;                             (* max same time tcp connects *)
      WWWLISTENSOCKS=16;                             (* max same time www tcp connects *)
      UDPSHOWTIME=600;                               (* show udp in html *)
      GATECONNDELAY=30;
      MAXINTERNALDELAY=5;                            (* max seconds between udp ports read to not discard data *)
      DEFAULTPONGTIME=30;                            (* s after last #ping stop datatransfer *)
      DAYSEC=86400;
      PI=3.14159265358979323844;
      DEGSYM=260C;
      MAXAFC=1000000;
TYPE  
      MONCALL=ARRAY[0..9] OF CHAR;
      FILENAME=ARRAY[0..1023] OF CHAR;
      FRAMEBUF=ARRAY[0..511] OF CHAR;
      FILTERST=ARRAY[0..255] OF CHAR;
      RES=(resOK, resDUP, resMSG, resQUERY, resUNGATE, resBADPATH, resNOPASS, resLEN, resSRCCAL, resDESTCAL,
           resVIACAL, resNCAL, resQAZ, resDELAY, resFILT, resLOG);

      SORTBY=ARRAY[0..3] OF ARRAY[0..1] OF CHAR;
(*
      FRAMEBUF=ARRAY[0..256+3+11*10] OF CHAR;
*)
      CHSET=SET OF [0C..177C];

      BEACON=RECORD
               bintervall: TIME;
               bfile     : FILENAME;
               btime     : TIME;
             END;


      POSCALL=RECORD
                call:MONCALL;
                typ:CHAR;
                pos:POSITION;
              END;   
       

      FILTERCALLS=ARRAY[0..8] OF MONCALL;
      FILTERS=RECORD
                typ         :CHAR;
                base,
                edge        :POSITION;
                radius      :REAL;
                viacalls    :FILTERCALLS;
                notvia      :BOOLEAN;
                entrycalls  :FILTERCALLS;
                notentry    :BOOLEAN;
                prefixes    :FILTERCALLS;
                notprefix   :BOOLEAN;
                bud         :FILTERCALLS;
                notbud      :BOOLEAN;
                objects     :FILTERCALLS;
                notobject   :BOOLEAN;
                destcalls   :FILTERCALLS;
                notdestcall :BOOLEAN;
                msgs        :FILTERCALLS;
                notmsgs     :BOOLEAN;
                q           :FILTERCALLS;
                notq        :BOOLEAN;
                symbols     :FILTERCALLS;
                notsymbols  :BOOLEAN;
                typs        :ARRAY[0..12] OF CHAR;
                nottyps     :BOOLEAN;
              END;
 
      WWWB=ARRAY[0..1400] OF CHAR;

      pWWWBUF=POINTER TO WWWBUF;
      WWWBUF=RECORD
              buf  :WWWB;
              tlen :INTEGER;
              push :BOOLEAN;
              next :pWWWBUF;
            END;

      QWatch=RECORD
               lasttb  :CARDINAL;
               qsize   :INTEGER;
               lastqb  :INTEGER;
               txbyte  :ARRAY[0..59] OF INTEGER;
             END;

      pTCPSOCK=POINTER TO TCPSOCK;
      TCPSOCK=RECORD
               next    : pTCPSOCK;
               fd      : INTEGER;
               beacont, 
               connt,
               pongtime: TIME;
               slowlink,
               passvalid,
               pingout : BOOLEAN;                         (* ping timeout state *) 
               service : CHAR;
               gatepri : CARDINAL;    
               ipnum   : ARRAY[0..63] OF CHAR;
               port    : ARRAY[0..5] OF CHAR;
               user    : POSCALL;
               vers    : ARRAY[0..20] OF CHAR; 
               wwwst   : CARDINAL;
               reload  : CARDINAL;
               sortby  : SORTBY;
               qwatch  : QWatch;
               txframes,
               txbytes,
               txbytesh, 
               rxframes,
               rxbytes,
               rxbytesh,
               losttxframes,
               lostrxframes : CARDINAL;
               filters     : FILTERS;
               outfilterst : FILTERST;                    (* for www show outconn filters *)
               rpos, 
               tlen    : INTEGER;
               rbuf    : FRAMEBUF; 
               tbuf    : ARRAY[0..1023] OF CHAR; 
               get     : ARRAY[0..255] OF CHAR;
               txbuf   : pWWWBUF;
             END;

     pUDPSOCK=POINTER TO UDPSOCK;
     UDPSOCK=RECORD
               next       : pUDPSOCK;
               fd         : INTEGER;
               ghosts     : GHOSTSET;
               rawread,
               checkip    : BOOLEAN;
               ip         : IPNUM;
               bindport,
               dport      : UDPPORT;
               lasttxtime : TIME;                          (* for net to rf bit/s limit *)
               laststat   : CARDINAL;
               torfradius : REAL;                          (* radius 0 no gateing *)
               maxbytes,                                   (* byte/s tx *)  
               lasttxbytes,                                (* for tx byte/s limit *)
               txframes,
               txbytes    : CARDINAL;
               allpathkey,                                 (* keyword on comment for allpath *)
               portname   : ARRAY[0..9] OF CHAR;
               stat:ARRAY[0..15] OF RECORD
                 uip                : IPNUM;
                 uport              : UDPPORT;
                 rxframes, rxbytes  : CARDINAL;
                 utime, dtime       : TIME;
               END;
             END;


     GATEFILT=(gUNGATE, gRFONLY, gNOGATE, gTCPIP, gTCPXX, gQ);
     GFILTSET=SET OF GATEFILT; 

     UDPSET=RECORD
       txd,
       level,
       quali,
       afc,
       snr      :INTEGER;
       longcalls:BOOLEAN;
     END;


CONST MAXHEARD=500;
      cUSERMSG=":";
      USERACK="{";
      cTHIRDPARTY="}";
      ICONDIR="icon";
      CALLINKFN="calllink.txt";          (* build an URL for a klicked mh call *)
      SERVERLINKFN="serverlink.txt";     (* build an URL for a klicked server ip *)
      OBJECTLINKFN="objectlink.txt";     (* build an URL for a klicked mh object *)
      MAPLINKFN="maplink.txt";           (* build an URL for map on klicked raw object *)
      MHSTEPS=48;
      tCELSIUS="C";
      tSPEED="S";
      tJUNK="J";
      tUNK="U";
      tPOS=0C;
      UNACKRET=1;
      MSGLEN=67;

TYPE
     SOURCE=(OBSOLET, NET, INDIR, DIR);

     pRAWTEXT=POINTER TO RAWTEXT;
     RAWTEXT=RECORD
       next    :pRAWTEXT;
       htime   :TIME;
       txd,
       quali,
       len     :CARDINAL;
       afc,
       snr     :INTEGER;
       position:POSITION;
       text    :ARRAY[0..1023] OF CHAR;
     END;

     pHEARD=POINTER TO HEARD;
     HEARD=RECORD
       next    :pHEARD;
       fromrx  :CARDINAL;
       mhtime  :TIME;
       call    :MONCALL;
       cntt    :TIME;
       position:POSITION; 
       dir     :CARDINAL;
       objtimediff,
       altitude:INTEGER;
       sym,symt:CHAR; 
       cnt     :ARRAY[0..MHSTEPS] OF RECORD pack, junk: CARD16 END;
       head    :ARRAY[0..40] OF CHAR;
       datatyp :CHAR;
       mhz,
       clb,
       data    :REAL;
       sortval :LONGREAL;                (* sort value inserted depending on sort by *)
       altfromsrtm,
       ungate  :BOOLEAN;                 (* flag set by user to not igate this direct heard *)  
       txd     :CARD16;
       quali   :CARD8;
       level   :INT16;
       snr     :INT8;
       afc     :INTEGER;
       rawtext :ARRAY[0..1] OF pRAWTEXT; (* normal / junk raw frame storage *)
     END;


CONST 
      POLYNOM=BITSET{3,10,15};
      CRCINIT=BITSET{0..15};
      CRCRESULT=BITSET(40715);
      CR=015C;
      LF=012C;
      cUSERMESSAGE=":";
      cISGATEWAY="G";
      cISSERVER="S";
      cISWWW="W";
      cTELEMETRY="T";
--      STYLE='<html><head><link href="style.css" rel="stylesheet" type="text/css"';
      TABDIR=0;
      TABVIA=1;
      TABNET=2;
      TABOBJ=3;
      MINLEVEL=MIN(INT16);
VAR 
    mhperport,                                      (* mh line for same call but different port *)
    datafilter,                                     (* send no data to user with no filter set *)                                                          
    sighup,
    rfcallchk,
    objmhfromtcp,
    nogatebadvia,
    altifromsrtm,
    verb,
    callsrc               : BOOLEAN;
    tcpsocks              : pTCPSOCK;
    showip1               : IPNUM;
    showport1             : UDPPORT;
    systime, keeptime     : TIME;
    CRCL, CRCH            : ARRAY[0..255] OF SET8;
    qau                   : ARRAY[0..2] OF CHAR;
    hashl, hashh          : SET8;
    hash2, hash3          : CARD8;
    ungates               : ARRAY[MIN(GATEFILT)..MAX(GATEFILT)] OF ARRAY[0..10] OF CHAR;
    timehash              : ARRAY[0..HASHSIZE-1] OF RECORD
                              htime:TIME;
                              hsum:CARD16;
                            END;
    realtime,
    udpdonetime,
    maxpongtime,
    dupetime,
    uptime,
    readurlfiletime       : TIME;
    rawlogname,
    netbeaconfn,
    logframename          : FILENAME;
    lastdnstime,
    gateconndelay,
    netbeaconintervall    : TIME;
    vcourse, vspeed,
    qas, qasc, 
    wwwsizelimit,
    maxusers,httpcount    : CARDINAL;
    vsym, vsymt           : CHAR;
    valt,
    logframes             : INTEGER;
    showid, servercall    : MONCALL;
    home                  : POSITION;                         (* own position *)
    homealt               : REAL;
    passwd                : ARRAY[0..5] OF CHAR;
    serverrangefilter,
    actfilter             : ARRAY[0..255] OF CHAR;
    wwwdir                : ARRAY[0..1023] OF CHAR;
    tcpbindport, 
    wwwbindport           : ARRAY[0..5] OF CHAR;
    nettorfpath           : ARRAY[0..80] OF CHAR;
    udpsocks              : pUDPSOCK; 
    trygate               : CARDINAL;
    qmaxtime              : INTEGER;
    gatesfn               : FILENAME;                         (* filename with gateway table *)
    gateways              : ARRAY[0..20] OF RECORD
                              url:ARRAY[0..255] OF CHAR;
                              port:ARRAY[0..5] OF CHAR;
                              resolvtime,
                              connecttime:TIME;
                              filterst:FILTERST;
                            END;  
    modeminfo:UDPSET;

  viacall     :MONCALL;
  netmhin,
  netmhout,
  msghttpcount,
  mhhttpcount,
  maxatonce,
  rawlines  :CARDINAL;
  rfquiet,
  heardtimetcp,
  heardtimevia,
  heardtimeobj,
  heardtimew  :TIME;
  heardobj,
  hearddir,
  heardvia,
  heardtcp    :pHEARD;
  netmh       :ARRAY[0..99] OF MONCALL;
  mhfilelines :CARDINAL;
  mhfilename  :FILENAME;
  SORTURL     :ARRAY[0..3] OF ARRAY[0..6] OF CHAR;
<*IF NOT SRTM THEN*>
  srtmdir     :ARRAY[0..1023] OF CHAR;
<*END*>


PROCEDURE spintime;                         (* make monotonic systime out of jumping realtime *)
VAR t, dt:TIME; 
BEGIN
  t:=time();
  dt:=t-realtime;
  realtime:=t;
  IF dt<60 THEN INC(systime, dt) END;
END spintime;

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

PROCEDURE Max(a,b:CARDINAL):CARDINAL;
BEGIN IF a>b THEN RETURN a ELSE RETURN b END; END Max;

PROCEDURE Min(a,b:CARDINAL):CARDINAL;
BEGIN IF a<b THEN RETURN a ELSE RETURN b END; END Min;

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 elevation(VAR el, c:REAL; home:POSITION; homealt:REAL; dist:POSITION; distalt:REAL);
VAR x0,y0,z0, x1,y1,z1, a,b,s,r,sb:REAL;

BEGIN
  el:=-1000.0;
  wgs84s(home.lat, home.long, homealt*0.001, x0,y0,z0);
  wgs84s(dist.lat, dist.long, distalt*0.001, x1,y1,z1);

  a:=sqrt(x0*x0 + y0*y0 + z0*z0);
  b:=sqrt(x1*x1 + y1*y1 + z1*z1);
  x1:=x1-x0;
  y1:=y1-y0;
  z1:=z1-z0;
  c:=sqrt(x1*x1 + y1*y1 + z1*z1);

(* halbwinkelsatz *)
  s:=(a+b+c)*0.5;
  IF s=0.0 THEN RETURN END;

  r:=(s-a)*(s-b)*(s-c)/s;
  IF r<=0.0 THEN RETURN END;

  r:=sqrt(r);
  sb:=s-b;
  IF sb<>0.0 THEN el:=(360.0/PI)*arctan(r/sb)-90.0 ELSE el:=90.0 END;
END elevation;


PROCEDURE skipblank(s-:ARRAY OF CHAR; VAR p:CARDINAL);
BEGIN WHILE (p<HIGH(s)) & (s[p]=" ") DO INC(p) END; END skipblank;

PROCEDURE FiltToStr(f:FILTERS; VAR s:ARRAY OF CHAR);

  PROCEDURE app(x:REAL; rad:BOOLEAN);
  VAR h:ARRAY[0..29] OF CHAR;
  BEGIN
    Append(s,"/");
    IF rad THEN FixToStr(x/RAD,5,h) ELSE FixToStr(x,0,h) END;
    Append(s,h);
  END app;

  PROCEDURE wrcalls(tab-:ARRAY OF MONCALL; not:BOOLEAN; sym:CHAR);
  VAR j:CARDINAL;
  BEGIN
    IF tab[0][0]<>0C THEN
      IF s[0]<>0C THEN Append(s," ") END;
      IF not THEN Append(s,"-") END;
      Append(s,sym);
      j:=0;
      WHILE tab[j][0]<>0C DO
        Append(s,"/");
        IF tab[j][0]>" " THEN Append(s, tab[j]) END;
        INC(j);
      END;
    END;
  END wrcalls;

BEGIN
  s[0]:=0C;
  WITH f DO
    IF typ="a" THEN  
      Assign(s, "a");
      app(base.lat, TRUE);
      app(base.long, TRUE);
      app(edge.lat, TRUE);
      app(edge.long, TRUE);
    ELSIF typ="r" THEN
      Assign(s, "r");
      app(base.lat, TRUE);
      app(base.long, TRUE);
      app(radius, FALSE);
    ELSIF typ="m" THEN
      Assign(s, "m");
      app(radius, FALSE);
    END;

    wrcalls(viacalls, notvia, "d");
    wrcalls(entrycalls, notentry, "e");
    wrcalls(prefixes, notprefix, "p");
    wrcalls(bud, notbud, "b");
    wrcalls(objects, notobject, "o");
    wrcalls(destcalls, notdestcall, "u");
    wrcalls(msgs, notmsgs, "g");
    wrcalls(q, notq, "q");
    wrcalls(symbols, notsymbols, "s");

    IF typs[0]<>0C THEN
      Append(s," ");
      IF nottyps THEN Append(s,"-") END;
      Append(s,"t/");
      Append(s, typs);
    END;

  END;
END FiltToStr;


PROCEDURE Watchclock(VAR t:TIME; intervall:TIME):BOOLEAN;
VAR tn:TIME;
BEGIN
  IF (intervall>0) OR (t=0) THEN    (* send once *)
    tn:=systime;
    IF t<=tn THEN
      INC(t, intervall);
      IF t<=tn THEN t:=tn+intervall END;
      RETURN TRUE
    END;
  END;
  RETURN FALSE
END Watchclock; 


PROCEDURE call2pass(c-:ARRAY OF CHAR):CARDINAL;
CONST ROOT=CAST(BITSET, 073E2H);
VAR i:CARDINAL;
    s:BITSET;
BEGIN
  s:=ROOT;
  i:=0;
  WHILE (i<=HIGH(c)) & (c[i]<>0C) & (c[i]<>"-") DO 
    s:=s/SHIFT(CAST(BITSET, ORD(CAP(c[i]))),VAL(INTEGER,NOT ODD(i))*8); 
    INC(i);
  END;
  RETURN CAST(CARDINAL, s*BITSET{0..14})
END call2pass;


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;
  RETURN 0
END GetSec;

PROCEDURE callok(h-:ARRAY OF CHAR):BOOLEAN;
VAR i,num,lit:CARDINAL;
    c:CHAR;
BEGIN
  num:=0;
  lit:=0;
  i:=0;
  LOOP
    c:=h[i];
    IF (c>="0") & (c<="9") THEN INC(num) ELSIF (c>="A") & (c<="Z") THEN INC(lit) ELSE EXIT END;
    INC(i);
  END;
  IF (lit<2) OR (num=0) OR (num>2) THEN RETURN FALSE END;
  IF h[i]="-" THEN
    INC(i);
    IF h[i]="1" THEN
      INC(i);
      IF (h[i]>="0") & (h[i]<="5") THEN INC(i) END;
    ELSIF (h[i]<"1") OR (h[i]>"9") THEN RETURN FALSE ELSE INC(i) END;
  END;
  RETURN h[i]=0C
END callok;

PROCEDURE readurlsfile(gatesfn-:ARRAY OF CHAR);
VAR n,i:CARDINAL;
    fd, len, ii:INTEGER;
    h:FILENAME;
BEGIN
  IF verb THEN WrStrLn("read url-file") END;
  FILL(ADR(gateways), 0C, SIZE(gateways));
  fd:=OpenRead(gatesfn);
  IF fd<0 THEN
    h:="-g :file <"; Append(h, gatesfn); Append(h, "> not readable"); WrStrLn(h);
    RETURN
  END;

  n:=0;
  REPEAT
    i:=0;
    LOOP
      len:=RdBin(fd, h[i], 1);
      IF (len<=0) OR (i>=HIGH(h)) OR (h[i]=CR) OR (h[i]=LF) THEN h[i]:=0C; EXIT END;

      INC(i);
    END;
    
    IF (h[0]<>0C) & (h[0]<>"#") THEN
      IF h[0]="[" THEN
        ii:=1;
        WHILE (h[ii]<>0C) & (h[ii]<>"]") DO INC(ii) END;
        IF (h[ii]<>"]") OR (h[ii+1]<>":") THEN WrStrLn("udpgate: urlfile: [url]:port") END;

        h[ii]:=0C;
        i:=1;
        WHILE i<=HIGH(h) DO h[i-1]:=h[i]; INC(i) END;

      ELSE ii:=InStr(h, ":") END;
      IF ii>=0 THEN h[ii]:=0C END;
      Assign(gateways[n].url, h);
      IF ii>0 THEN                           (* port number *)
        INC(ii);
        i:=0;
        WHILE ii<=HIGH(h) DO h[i]:=h[ii]; INC(i); INC(ii) END;
      ELSE WrStrLn("urlfile: [url]:port") END;

      ii:=InStr(h, "#");
      IF ii>=0 THEN h[ii]:=0C END;
      IF h[0]=0C THEN WrStrLn("urlfile: [url]:port#filters") END;

      Assign(gateways[n].port, h);

      IF ii>0 THEN                           (* we have a filter string *)
        INC(ii);
        i:=0;
        WHILE ii<=HIGH(h) DO
          IF h[ii]="," THEN h[ii]:=" " END;
          h[i]:=h[ii];
          INC(i);
          INC(ii);
        END;
        Assign(gateways[n].filterst, h);
      END;
      INC(n);
    END;
  UNTIL (len<=0) OR (n>HIGH(gateways));
  Close(fd);        
END readurlsfile;


PROCEDURE corrpath(VAR s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
  i:=Length(s);
  IF (i>0) & (s[i-1]<>DIRSEP) THEN Append(s, DIRSEP) END;
END corrpath;

PROCEDURE parms;
VAR h          : ARRAY[0..4095] OF CHAR;
    hh         : ARRAY[0..99] OF CHAR;
    ghost      : GHOSTSET;
    err        : BOOLEAN;
    lasth      : CHAR;
    i, n       : CARDINAL;
    gatecnt    : CARDINAL;
    fd, len    : INTEGER;
    usock, ush : pUDPSOCK;
    ii         : INTEGER; 
    allkey     : ARRAY[0..9] OF CHAR;
BEGIN
  err:=FALSE;
  verb:=FALSE;
  datafilter:=FALSE;
  gatecnt:=0;
  ghost:=GHOSTSET{};
  keeptime:=0; (*600*)                          (* default keep connected to gateway time *)
  allkey[0]:=0C;
  showctrl:=TRUE;
  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="R") OR (lasth="M") THEN
        NextArg(h);
        ALLOCATE(usock, SIZE(usock^));
        IF usock=NIL THEN Err("out of memory") END;

        FILL(usock, 0C, SIZE(usock^));
        WITH usock^ DO
          IF GetIp2(h, ip, dport, bindport, checkip)<0 THEN Err("-R or -M need ip:port:port") END;
          fd:=udp.openudp();
          rawread:=lasth="R";
          IF (fd<0) OR (udp.bindudp(fd, bindport)<0) THEN
            h:="-R or -M cannot bind udpport ";
            CardToStr(bindport, 1, hh); Append(h, hh);  
            Err(h);
          END;

          len:=udp.socknonblock(fd);

          ii:=InStr(h, "+");
          IF ii>0 THEN 
            i:=ii+1;
            IF (GetSec(h,i,n)>=0) THEN 
              maxbytes:=n;
              INC(i);
              IF (h[i-1]=":") & (GetSec(h,i,n)>=0) THEN torfradius:=FLOAT(n) END;
            END;
          END;

          ii:=InStr(h, "#");                   (* get port name *)
          IF ii>0 THEN
            INC(ii);
            i:=0;
            WHILE (i<=HIGH(portname)) & (ii<=HIGH(h)) & (h[ii]<>0C) DO
              portname[i]:=h[ii];
              INC(i);
              INC(ii);
            END;
          END;

          ghosts:=ghost;
          Assign(allpathkey, allkey);
          next:=NIL;
        END;
        IF udpsocks=NIL THEN udpsocks:=usock;
        ELSE 
          ush:=udpsocks; 
          WHILE ush^.next<>NIL DO ush:=ush^.next END; 
          ush^.next:=usock;
        END; 
        ghost:=GHOSTSET{};

      ELSIF lasth="a" THEN 
        NextArg(h);
        IF NOT StrToFix(homealt, h) THEN Err("-a altitude in m") END;

      ELSIF lasth="B" THEN 
        NextArg(h);
        IF h[0]="+" THEN
          Delstr(h, 0, 1);
          objmhfromtcp:=TRUE;
        END;
        i:=0;
        IF GetSec(h,i,n)>=0 THEN heardtimeobj:=n*60 ELSE Err("-B minutes") END;

      ELSIF lasth="c" THEN callsrc:=TRUE;

      ELSIF CAP(lasth)="S" THEN
        rfcallchk:=lasth="s";
        NextArg(h);
        Assign(servercall, h);
        IF (servercall[0]=0C) OR (servercall[0]="-") OR (rfcallchk & NOT callok(h)) 
        THEN Err("-s call-ssid") END;

      ELSIF lasth="p" THEN
        NextArg(h);
        IF (h[0]>="0") & (h[0]<="9") THEN
          i:=0;  
          WHILE (i<=HIGH(passwd)) & (h[i]>=" ") DO passwd[i]:=h[i]; INC(i) END;
        ELSE
          fd:=OpenRead(h);
          IF fd<0 THEN Err("-p passcode or passwordfile") END;
          len:=RdBin(fd, passwd, SIZE(passwd)-1);
          IF len>=0 THEN passwd[len]:=0C ELSE Err("-p error with password file") END;
          Close(fd);
        END;
        passwd[HIGH(passwd)]:=0C;
        i:=0; 
        WHILE (passwd[i]>="0") & (passwd[i]<="9") DO INC(i) END;
        IF (i=0) OR (passwd[i]<>0C) THEN Err("-p invalid passcode") END;

      ELSIF lasth="m" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN maxusers:=n ELSE Err("-m number") END;

      ELSIF lasth="A" THEN
        NextArg(h);
        IF (h[0]=0C) OR (h[0]="-") THEN Err("-A directory") END;
        Assign(srtmdir, h);
        corrpath(srtmdir);

      ELSIF lasth="D" THEN
        NextArg(h);
        IF (h[0]=0C) OR (h[0]="-") THEN Err("-D directory") END;
        Assign(wwwdir, h);
        corrpath(wwwdir);

      ELSIF lasth="d" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN dupetime:=n ELSE Err("-d number") END;
        IF dupetime<27 THEN WrStrLn("-d do not set dupefilter less 27s!") END;

      ELSIF lasth="e" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN 
          IF n=0 THEN n:=1 END;
          gateconndelay:=n;
        ELSE Err("-e seconds") END;

      ELSIF lasth="C" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN heardtimetcp:=n*60 ELSE Err("-C minutes") END;

      ELSIF lasth="H" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN heardtimew:=n*60 ELSE Err("-H minutes") END;

      ELSIF lasth="I" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN heardtimevia:=n*60 ELSE Err("-I minutes") END;

      ELSIF lasth="l" THEN
        NextArg(h);
        i:=0;
        IF (GetSec(h,i,n)>=0) & (h[i]=":") THEN
          logframes:=n;
          INC(i);
          FOR n:=0 TO HIGH(logframename) DO 
            IF i<=HIGH(h) THEN 
              logframename[n]:=h[i];
              INC(i);
            END;
          END;
          IF logframename[0]<=" " THEN Err("-l loglevel:filename") END;
        ELSE Err("log format is level:file") END;

      ELSIF lasth="r" THEN
        NextArg(rawlogname);
        IF rawlogname[0]<=" " THEN Err("-r rawlogfilename") END;

      ELSIF lasth="F" THEN
        NextArg(h);
        i:=0;
        IF (GetSec(h,i,n)>=0) & (h[i]=":") THEN
          mhfilelines:=n;
          INC(i);
          FOR n:=0 TO HIGH(mhfilename) DO
            IF i<=HIGH(h) THEN
              mhfilename[n]:=h[i];
              INC(i);
            END;
          END;
          IF mhfilename[0]<=" " THEN Err("-F MHfilename") END;
        ELSE Err("MH File lines:file") END;

      ELSIF lasth="n" THEN
        NextArg(h);
        i:=0;
        IF (GetSec(h,i,n)>=0) & (h[i]=":") THEN
          netbeaconintervall:=n*60;
          INC(i);
          FOR n:=0 TO HIGH(netbeaconfn) DO 
            IF i<=HIGH(h) THEN 
              netbeaconfn[n]:=h[i];
              INC(i);
            END;
          END;
          IF netbeaconfn[0]<=" " THEN Err("-n netbeacon filename") END;
        ELSE Err("-n netbeacon format is minutes:file") END;

      ELSIF lasth="E" THEN showctrl:=FALSE;

      ELSIF lasth="t" THEN
        NextArg(h);
        Assign(tcpbindport, h);
        IF (h[0]=0C) OR (h[0]="-") THEN Err("-t port") END;

      ELSIF lasth="w" THEN
        NextArg(h);
        Assign(wwwbindport, h);
        IF (h[0]=0C) OR (h[0]="-") THEN Err("-w port") END;

      ELSIF lasth="X" THEN
        NextArg(h);
        Assign(qau, h);
        IF (h[0]=0C) OR (h[0]="-") THEN Err("-X q-construct") END;
        IF qau[0]<>"q" THEN Err('-X q-construct needs "q" at begin') END;

      ELSIF lasth="f" THEN
        NextArg(h);
        Assign(serverrangefilter, h);
        IF (h[0]=0C) OR (h[0]="-") THEN Err("-f rangefilter") END;
        FOR i:=0 TO Length(serverrangefilter) DO
          IF serverrangefilter[i]="," THEN serverrangefilter[i]:=" " END;
        END;  

      ELSIF lasth="g" THEN                     (* "url port" or "url:port" or "url:port#filter" *) 
        NextArg(h);
        IF h[0]=0C THEN Err("-g url port") END;
        IF h[0]=":" THEN                       (* get urls later from file *) 
          FOR i:=1 TO HIGH(h) DO h[i-1]:=h[i] END;
          h[HIGH(h)]:=0C;
          Assign(gatesfn, h);
        ELSE       
          IF gatecnt>HIGH(gateways) THEN Err("-g gateway table full") END;

          h[HIGH(h)]:=0C;
          IF h[0]="[" THEN
            ii:=1;
            WHILE (h[ii]<>0C) & (h[ii]<>"]") DO INC(ii) END;
            IF (h[ii]<>"]") OR (h[ii+1]<>":") THEN Err("-g [url]:port") END;

            h[ii]:=0C;
            i:=1;
            WHILE i<=HIGH(h) DO h[i-1]:=h[i]; INC(i) END;
          
          ELSE ii:=InStr(h, ":") END;
          IF ii>=0 THEN h[ii]:=0C END;
          Assign(gateways[gatecnt].url, h);
          IF ii>0 THEN                           (* port number *)
            INC(ii);
            i:=0;
            WHILE ii<=HIGH(h) DO h[i]:=h[ii]; INC(i); INC(ii) END;
          ELSE NextArg(h) END;

          h[HIGH(h)]:=0C;
          ii:=InStr(h, "#");
          IF ii>=0 THEN h[ii]:=0C END;
          IF h[0]=0C THEN Err("-g url:port") END;
          Assign(gateways[gatecnt].port, h);

          IF ii>0 THEN                           (* we have a filter string *)    
            INC(ii);
            i:=0;
            WHILE ii<=HIGH(h) DO 
              IF h[ii]="," THEN h[ii]:=" " END;
              h[i]:=h[ii];
              INC(i);
              INC(ii);
            END;
            Assign(gateways[gatecnt].filterst, h);
          END;

          INC(gatecnt);
        END;

      ELSIF lasth="h" THEN
        WrStrLn("                "+VERS);
        WrStrLn(" -0             send no Data (only Messages and ack) to User with no Filter");
        WrStrLn(" -A <path>      srtm directory path to enable overground calculation (-A /usr/srtm/)");
        WrStrLn('                for objects with "Clb=" file WW15MGH.DAC will be needed on this path');
        WrStrLn(" -a <meter>     Altitude of Igate for elevation calulation (overrides value from srtm)");
        WrStrLn(' -B [+]<time>   Minutes show heard Items/Objects, with "+" from AprsIs too (-B +60)');
        WrStrLn(' -C <time>      connected (tcp) remember position minutes (Min) (-C 1440)');
        WrStrLn(" -c             delete frames with no valid source call in APRS-IS stream");
        WrStrLn(" -D <path>      www server root directory (-D /usr/www/)");
        WrStrLn(" -d <time>      dupe filter time in seconds, not below 27s! (default 60s)");
        WrStrLn(' -E             Erase axudp frames with ctrl-chars in calls else show "^" (off)');
        WrStrLn(" -e <time>      wait before (re)connect to (next) gateway in seconds, (30s)");
        WrStrLn(" -F <lines>:<file> write direct heard file (call,sym,port,s,cnt,km,data,path)");
        WrStrLn(" -f <filters>   backstream filter text sent to out connected server -f m/50");
        WrStrLn("                if blanks dont pass parameter settings use , (-f m/30,-d/CW)");
        WrStrLn(" -g <url>:<port>[#<filters>] connect to APRS-IS gateway, repeat -g for a list");
        WrStrLn("                with favorites first and all urls will be tried to connect");
        WrStrLn("                if the active connect is not the first in list, urls");
        WrStrLn("                before will be polled and if gets connected, data transfer");
        WrStrLn("                is switched to this link and the old gets disconnected");
        WrStrLn("                if no filter setting, global -f filter is used");
        WrStrLn("                -g www.db0anf.de:14580#m/50 -g 127.0.0.1:3000");
        WrStrLn("                ipv6 if enabled by kernel -g [::1]:14580#m/200");
        WrStrLn(" -g :<filename> read gateway urls from file url:port#filter,filter,...");
        WrStrLn("                send SIGHUP to reread file & reconnect (kill -SIGHUP <tasknumber>)");
        WrStrLn(" -H <time>      direct heard keep time minutes (Min) (-H 1440)");
        WrStrLn(" -h             this");
        WrStrLn(" -I <time>      indirect heard keep time minutes (Min) (-I 30)");
        WrStrLn(" -K             not Gate frame rf to net if sender of frame has no call");
        WrStrLn(" -k <time>      0 always connect to gateway else connect on demand and hold (0)");
        WrStrLn("                (seconds) after last User gone or valid UDP Data arrived");
        WrStrLn(" -l <level>:<file> logfile -l 6:/tmp/log.txt");
        WrStrLn("                level: 0 all, 1 dupes, >1 error, status...");
        WrStrLn(" -M             same as -R but tnc text format");
        WrStrLn(" -m <maxconnects> max inbound connects -m 20 (default 200)");
        WrStrLn(" -n <min>:<file> netbeacon minutes:filename -n 10:netbeacon.txt");
        WrStrLn("                \\z ddhhmm, \\h hhmmss, \\:filename: insert file, \\v insert");
        WrStrLn("                Version, \\\ insert \\");
        WrStrLn("                beacon file like: !8959.00N/17959.00E&igate mars");
        WrStrLn("                beacon file used by udpgate itself to find out own position");
        WrStrLn(" -O             make MH entry for same calls but different port");
        WrStrLn(" -o <seconds>   ping-pong: time to stop data forwarding after last ping");
        WrStrLn("                use double time of igate ping intervall");
        WrStrLn(" -p <password>  login password for aprs-is servers -p 12345");
        WrStrLn("                to hide password in commandline use file mode -p pass.txt");
        WrStrLn(" -Q <n>         send netbeacon with qAS if qAI dont pass some servers");
        WrStrLn("                0=never, 1=always else every n beacons send 1 with qAI");
        WrStrLn(" -q <time>      minimum quiet time after rf tx seconds (-q 10)");
        WrStrLn(" -R <ip>:<dport>/<lport>[+<byte/s>[:<radius>]][#<portname>]");
        WrStrLn("                udp rf port (monitor frame format) for local (t)rx");
        WrStrLn('                <dport>/<lport> "/" only from this ip, dport=0 no tx');
        WrStrLn("                +byte/s enable inet to rf for services like WLNK, WHO-IS");
        WrStrLn("                :radius enable all inet to rf gate (from km around digi)");
        WrStrLn("                messages to NOT direct heard users are gated at any radius >0");
        WrStrLn("                if no <ip> given then '127.0.0.1' is used");
        WrStrLn("                #portname max 10 char like '144800'");
        WrStrLn("                repeat -R for each radio port with a tx or different portname");
        WrStrLn(" -r <filename>  write a dated 1 day logfile with date+time+data lines");
        WrStrLn(" -S <call>      server call of this server -s MYCALL-10, no check for (gateing) valid calls");
        WrStrLn(" -s <call>      server call of this server -s MYCALL-10");
        WrStrLn(" -T <seconds>   kill link to server if unack tcp bytes are longer in tx queue");
        WrStrLn("                avoids delayed trackpoints (default 15s, off 0, max 60)");
        WrStrLn(" -t <localport> local igate tcp port for in connects -t 14580");
        WrStrLn(" -u <maxlines>  raw frame listing by click to frame counter in Heard list (50) (0 off)");
        WrStrLn(' -V <path>      Via Path for net to rf frames, "-1" for SSID on destination call');
        WrStrLn(" -v             show frames and analytics on stdout");
        WrStrLn(" -W <filesize>  limit www server file size in 1024byte, (-W 4000) (10MB)");
        WrStrLn(" -w <port>      port of www server -w 14501");
        WrStrLn(' -X <qXX>       change "qAR" for gate rf to aprs-is on ports with tx (dport not 0) (-X qAR)');
        WrStrLn(" -x <call>      via <call> send messages to rf (-x OE0AAA-10) tx off: -x -");
        WrStrLn("                default is server call");

<*IF SRTM THEN*>
        WrStrLn(" -Y             get missing altitude in MH from SRTM");
<*END*>

        WrStrLn("");
        WrStrLn("Netbeacon format example: 1 active Line, comment out with #");
        WrStrLn("!8815.10N/01302.20E&Igate Northpole 433.5MHz \\hz");
        WrStrLn("Insert Macros: \\h time hhmmss,  \\z ddhhmm, \\v program version, \\:filename:, \\t cpu temp, \\\ \");
        WrStrLn("");
        WrStrLn("udpgate4 -v -R 127.0.0.1:9200:9201 -s MYCALL-10 -l 7:aprs.log -n 10:beacon.txt -t 14580 -g www.server.org:14580#m/30 -p 12345 -w 14501 -D /home/pi/www");
        WrStrLn('for your own startpage put file "index.html" in (-D) root directory');
        WrStrLn('enable www server dir-list with empty file ".dirlist " in listable subdirectories');

        HALT

      ELSIF lasth="u" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN rawlines:=n; ELSE Err("-u <lines>") END;

      ELSIF lasth="O" THEN
        mhperport:=TRUE;

      ELSIF lasth="Q" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN qas:=n ELSE Err("-Q number") END;

      ELSIF lasth="q" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN rfquiet:=n ELSE Err("-q seconds") END;

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

      ELSIF lasth="V" THEN
        NextArg(h);
        Assign(nettorfpath, h);
        IF (h[0]=0C) THEN Err("-V net to rf via path") END;

      ELSIF lasth="k" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN keeptime:=n ELSE Err("-k seconds") END;

      ELSIF lasth="K" THEN
        nogatebadvia:=TRUE;

      ELSIF lasth="T" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN qmaxtime:=n ELSE Err("-T seconds") END;
        IF qmaxtime>HIGH(tcpsocks^.qwatch.txbyte) THEN qmaxtime:=HIGH(tcpsocks^.qwatch.txbyte) END;

      ELSIF lasth="o" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN maxpongtime:=n ELSE Err("-o seconds") END;

      ELSIF lasth="x" THEN
        NextArg(h);
        Assign(viacall, h);
        IF (h[0]=0C) OR (h[0]="-") & (h[1]<>0C) THEN Err("-x call") END;

      ELSIF lasth="W" THEN
        NextArg(h);
        i:=0;
        IF GetSec(h,i,n)>=0 THEN wwwsizelimit:=n*1024 ELSE Err("-W kbytes") END;

<*IF SRTM THEN*>
      ELSIF lasth="Y" THEN altifromsrtm:=TRUE;
<*END*>

      ELSIF lasth="0" THEN
        datafilter:=TRUE;

      ELSIF (lasth="L") OR (lasth="J") OR (lasth="P") OR (lasth="U") THEN
        NextArg(h);
        WrStrLn("");
        WrStrLn("-L -J -P -U switches not longer implemented!");
        WrStrLn("");
 
      ELSE err:=TRUE END;
      (*h[0]:=0C;*)
    ELSE err:=TRUE END;
    IF err THEN EXIT END;
  END;
  IF err THEN Append(h, " ? use -h"); Err(h) END;
  IF servercall[0]=0C THEN WrLn; WrStrLn("udpgate4: NO SERVERCALL ?"); WrLn; END;
  IF (wwwbindport[0]<>0C) & (wwwdir=0C) 
  THEN WrLn; WrStrLn("udpgate4: -w www-port but no -D icon-dir-path ?"); WrLn; END;
END parms;

PROCEDURE porttosock(p:CARDINAL):pUDPSOCK;
VAR s:pUDPSOCK;
BEGIN
  IF p=0 THEN RETURN NIL 
  ELSE
    s:=udpsocks;
    WHILE (s<>NIL) & (p>1) DO s:=s^.next; DEC(p) END;
  END;
  RETURN s
END porttosock;


PROCEDURE Sendudp(s-:FRAMEBUF; totx:CARDINAL; unlimit:BOOLEAN):BOOLEAN;
VAR len:INTEGER;
    raw:FRAMEBUF;
    us:pUDPSOCK;
    done:BOOLEAN;
BEGIN
  done:=FALSE;
  us:=porttosock(totx);                                         (* send to which udp modem *)
  IF (us<>NIL) & (unlimit OR (us^.maxbytes=65535) OR ((systime-us^.lasttxtime)*us^.maxbytes>us^.lasttxbytes)) THEN
    IF us^.rawread THEN mon2raw(s, raw, len) ELSE len:=Length(s)+1; raw:=s END;
    IF len>1 THEN 
      WITH us^ DO
--        udpstat(us, 0, dport, ip);
        lasttxbytes:=len;
        lasttxtime:=systime;
        INC(txframes);
        INC(txbytes, len);
      END;

      len:=udp.udpsend(us^.fd, raw, len, us^.dport, us^.ip);
      done:=TRUE;
    ELSIF verb THEN WrStrLn("wrong inet to rf frame format") END;
  END; 
  RETURN done
END Sendudp;


PROCEDURE getval(s-:ARRAY OF CHAR; VAR i:CARDINAL; VAR v:INTEGER);
VAR m:BOOLEAN;
BEGIN
  INC(i);
  v:=0;
  m:=s[i]="-";
  IF m THEN INC(i) END;
  WHILE (i<HIGH(s)) & (s[i]>="0") & (s[i]<="9")
  DO v:=v*10 + VAL(INTEGER, ORD(s[i]) - ORD("0")); INC(i) END;
  WHILE (i<HIGH(s)) & (s[i]>" ") DO INC(i) END;
  WHILE (i<HIGH(s)) & (s[i]=" ") DO INC(i) END;
  IF m THEN v:=-v END;
END getval;


PROCEDURE decodeudp2(ub-:ARRAY OF CHAR; VAR modeminfo:UDPSET);
VAR i:CARDINAL;
    res:INTEGER;

BEGIN
  WITH modeminfo DO
    txd:=0;
    level:=MINLEVEL;
    quali:=0;
    snr:=MIN(INT8);
    afc:=MAXAFC;
    longcalls:=FALSE;
    IF (ub[0]<>0C) & (ub[1]<>0C) THEN
      i:=2;
      WHILE (i<HIGH(ub)) & (ub[i]<>0C) DO
        CASE ub[i] OF
          "T":getval(ub, i, res); txd:=res;
         |"V":getval(ub, i, res); level:=res;
         |"Q":getval(ub, i, res); quali:=res;
         |"S":getval(ub, i, res); IF (res>MIN(INT8)) & (res<=MAX(INT8)) THEN snr:=res END;
         |"A":getval(ub, i, res); IF ABS(res)<MAXAFC THEN afc:=res END;
         |"X":getval(ub, i, res); IF res=2 THEN longcalls:=TRUE END;
        ELSE getval(ub, i, res) END;
      END;
    END;
  END;
END decodeudp2; 


PROCEDURE getudp(usock:pUDPSOCK; VAR buf:FRAMEBUF; ghost: GHOSTSET):BOOLEAN;
VAR fromport     : UDPPORT;
    ipn          : IPNUM;
    crc1, crc2   : CHAR;
    len, i, oldi : INTEGER;
    mlen         : CARDINAL;
    mbuf         : FRAMEBUF; 
    oldt         : TIME;
    udp2         : ARRAY[0..99] OF CHAR;    
BEGIN
  LOOP
    len:=udp.udpreceive(usock^.fd, buf, SIZE(buf), fromport, ipn);
    IF (len<=2) OR (len>=CAST(INTEGER, SIZE(buf))) OR usock^.checkip & (usock^.ip<>ipn)
    THEN RETURN FALSE END;

    buf[len]:=0C;
    FILL(ADR(modeminfo), 0C, SIZE(modeminfo));
    decodeudp2("", modeminfo);
    IF usock^.rawread THEN
      crc1:=buf[len-2];
      crc2:=buf[len-1];
      AppCRC(buf, len-2);
      IF (crc1<>buf[len-2]) OR (crc2<>buf[len-1]) THEN 
        IF verb THEN WrStrLn(" axudp crc error") END; 
        buf[0]:=0C;
      ELSE  
        DEC(len, 2);
        IF buf[0]=1C THEN
          extrudp2(buf, udp2, len);
          decodeudp2(udp2, modeminfo);
        END;
        IF len>2 THEN
          IF modeminfo.longcalls THEN buf[len]:=0C;
          ELSE
            raw2mon(buf, mbuf, len, mlen, ghost);
            IF (mbuf[0]=0C) & verb THEN 
              WrStrLn(" axudp frame decode error");

 FOR i:=0 TO len-3 DO WrHex(ORD(buf[i]),3) END;
 WrLn;
 i:=0;
 LOOP
   IF i>=len-3 THEN EXIT END;
   IF ORD(buf[i]) DIV 2<ORD(" ") THEN WrStr("<") ; WrHex(ORD(buf[i]) DIV 2,1); WrStr(">");
   ELSE WrStr(CHR(ORD(buf[i]) DIV 2)) END;
   IF ODD(ORD(buf[i])) THEN EXIT END;
   IF i MOD 7=6 THEN WrStr(",") END;
   INC(i);
 END;
 WrLn;

            END;
            buf:=mbuf;
          END;
        ELSE buf[0]:=0C END; 
        len:=Length(buf);                  (* for statistic *)
      END;
    END;

---    udpstat(usock, len, fromport, ipn);
 
    IF buf[0]<>0C THEN
(* statistic *)
      i:=0;
      oldt:=systime;
      oldi:=0;
      LOOP
        IF (usock^.stat[i].uip=ipn) & (usock^.stat[i].uport=fromport) THEN
          oldi:=i;
          i:=HIGH(usock^.stat);
        END;
        IF i>=HIGH(usock^.stat) THEN
          WITH usock^.stat[oldi] DO
            uport:=fromport;
            uip:=ipn;        
            IF (dtime DIV 2 + utime DIV 2>systime)       (* allow clock back step till 1/2 uptime *) 
            OR (utime+UDPSHOWTIME<systime) THEN          (* reset statistic *)
              dtime:=systime;
--            usock^.txframes:=0;
--            usock^.txbytes:=0;
              rxframes:=0;
              rxbytes:=0;
            END;
            INC(rxframes);
            INC(rxbytes, len);
            utime:=systime;
            usock^.laststat:=oldi;
          END;
          EXIT
        END;

        IF usock^.stat[i].utime<oldt THEN
          oldt:=usock^.stat[i].utime;
          oldi:=i;
        END;

        INC(i);
      END;
      RETURN TRUE

    END;
  END;
END getudp; 
    

PROCEDURE Gettcp(fd:INTEGER; VAR line, buf:FRAMEBUF; VAR pos:INTEGER):INTEGER;
VAR len,i,j:INTEGER;
BEGIN
  i:=pos;
  IF i>=SIZE(line) THEN i:=0 END;                             (* pos>SIZE is overflow mode *)
  len:=tcp.readsock(fd, line, SIZE(line)-i);

  IF len<0 THEN RETURN -1 END;

  IF pos>=SIZE(buf) THEN                                      (* hunt mode *)
    i:=0; 
    WHILE (i<len) & (line[i]<>12C) DO INC(i) END;
    IF i>=len THEN RETURN 0 END;                              (* no line start found *)
    pos:=0;
    INC(i);
    j:=0;
    WHILE i<len DO line[j]:=line[i]; INC(j); INC(i) END;
    len:=j;
  END;

  IF pos>0 THEN
    FOR i:=len-1 TO 0 BY -1 DO line[i+pos]:=line[i] END;      (* move up new *)
    FOR i:=0 TO pos-1 DO line[i]:=buf[i] END;                 (* ins buf before *)
    INC(len,pos);
    pos:=0;  
  END;

  i:=0;
  WHILE (i<len) & (line[i]<>12C) DO INC(i) END;
  IF i>=len THEN                                              (* no line end found *)
    WHILE pos<len DO buf[pos]:=line[pos]; INC(pos) END;       (* move to buf *)
    len:=0;  
  ELSE
    j:=i+1;
    WHILE j<len DO buf[pos]:=line[j]; INC(pos); INC(j) END;   (* move rest to buf *)  
    len:=i;
  END;
  line[len]:=0C;
  RETURN len
END Gettcp;

PROCEDURE showpip(ip:IPNUM; port:UDPPORT; VAR s:ARRAY OF CHAR);
VAR h:ARRAY[0..20] 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);
  IF port<>0 THEN
    Append(s,":");
    IntToStr(port, 1, h);
    Append(s,h);
  END;
END showpip;


PROCEDURE logline(r:RES; s:ARRAY OF CHAR);
VAR h:ARRAY[0..511] OF CHAR;
    fd:INTEGER;
    i:CARDINAL;
BEGIN
  IF (logframename[0]<>0C) & (logframes<=VAL(INTEGER, ORD(r))) THEN
    fd:=OpenAppend(logframename);
    IF fd<0 THEN fd:=OpenWrite(logframename) END;
    IF fd>=0 THEN
      DateToStr(time(), h);
      Append(h, " ");
      Append(h, s);
      Append(h,""+LF);
      WrBin(fd, h, Length(h));
      Close(fd);
    ELSE WrStr("cannot write"); WrStr(logframename); WrLn; END;
  END;
  IF verb (* & (r<>-5) *) THEN 
    i:=Length(s);
    IF (i>=2) & (s[i-1]=LF) & (s[i-2]=CR) THEN s[i-2]:=0C END; 
    CtrlHex(s);
    WrStrLn(s);
  END;
END logline;

PROCEDURE writerawlog(b-:FRAMEBUF);
VAR h:ARRAY[0..511] OF CHAR;
    fn:FILENAME;
    l, i:CARDINAL;
    f:INTEGER;
BEGIN
  l:=Length(b);
  WHILE (l>0) & (b[l-1]<=15C) DO DEC(l) END;         (* delete trailing junk *)
  IF l>0 THEN
    DateToStr(time(), h);
    h[4]:=h[5];
    h[5]:=h[6];
    h[6]:=h[8];
    h[7]:=h[9];
    h[8]:=0C;
    h[9]:=h[11];
    h[10]:=h[12];
    h[11]:=h[14];
    h[12]:=h[15];
    h[13]:=h[17];
    h[14]:=h[18];
    h[15]:=" ";
    Assign(fn, rawlogname);
    Append(fn, h);
    h[8]:=":";
 
    f:=OpenAppend(fn);
    IF f<0 THEN f:=OpenWrite(fn) END;
    IF f>=0 THEN
      IF l>=HIGH(h)-16 THEN l:=HIGH(h)-16 END;
      i:=0;
      REPEAT h[i+16]:=b[i]; INC(i) UNTIL i>=l;
      h[i+16]:=LF; INC(i);
  
      WrBin(f, h, i+16);
      Close(f);
    ELSIF verb THEN WrStr("cannot write "); WrStrLn(fn) END;
  END;
END writerawlog;

PROCEDURE showframe(r:RES; sp:pTCPSOCK; su:pUDPSOCK; buf-:ARRAY OF CHAR; pos:POSITION);
VAR h, s:ARRAY[0..511] OF CHAR;
BEGIN
  IF sp=NIL THEN 
    IF su<>NIL THEN
      s:="U:";
      WITH su^ DO 
        IF (stat[laststat].uip<>showip1) OR (stat[laststat].uport<>showport1) THEN
          showip1:=stat[laststat].uip;
          showport1:=stat[laststat].uport;
          showpip(showip1, showport1, h); Append(s,h); Append(s,":");
        END;
      END;
    ELSE s:=" :" END;
  ELSE
    s[0]:=sp^.service; s[1]:=":"; s[2]:=0C; 
    IF (sp^.user.call[0]<>0C) & NOT StrCmp(sp^.user.call, showid) THEN
      Append(s, sp^.user.call); Append(s,":");
      Assign(showid, sp^.user.call);
    END;
  END;
(*
IO.WrFixed(distance(home,pos), 1, 10); IO.WrStr("km"); IO.WrLn;
*)
  CASE r OF
   | resOK: IF NOT posvalid(pos) OR NOT posvalid(home) THEN h:="--->" 
        ELSE IntToStr(TRUNC(0.5+distance(home, pos)), 3, h); Append(h, ">") END;
   |resBADPATH: h:="pat:";
   |resNOPASS: h:="pas:";
   |resLEN: h:="len:";
   |resSRCCAL: h:="src:";
   |resDESTCAL: h:="dst:";
   |resVIACAL: h:="via:";
   |resNCAL: h:="num:";
   |resMSG: h:="msg:";
   |resDUP: h:="dup:";
   |resUNGATE: h:="ung:";
   |resDELAY: h:="del:";
   |resQAZ: h:="qaz:";
   |resFILT: h:="flt:";
   |resLOG: h:="log:";
  ELSE  h:="   :";
  END;
  Append(s,h);
  Append(s, buf);
  logline(r, s);
END showframe;

PROCEDURE appkib(VAR s:ARRAY OF CHAR; h,l:CARDINAL);
VAR b:ARRAY[0..40] OF CHAR;
BEGIN
  IF h>0 THEN CardToStr(l DIV 1024 + h*4194304, 1, b); Append(s, "kB=");
  ELSE CardToStr(l, 1, b); Append(s, "B=") END;
  Append(s, b);
END appkib; 

PROCEDURE bitsec64(h, l:CARDINAL; t:TIME):CARDINAL;
VAR r:REAL;
BEGIN
  r:=(FLOAT(h)*4294967296.0 + FLOAT(l))*8.0/FLOAT(t);
  IF r>2000000000.0 THEN RETURN 2000000000 END;
  RETURN TRUNC(r)
END bitsec64;

PROCEDURE iscall(b-:ARRAY OF CHAR; p:CARDINAL):BOOLEAN;
VAR li, nu, i:CARDINAL;
    c:CHAR;
BEGIN
  li:=0;
  nu:=0;
  FOR i:=0 TO 2 DO
    c:=b[p+i];
    IF (c>="A") & (c<="Z") THEN INC(li) ELSIF (c>="0") & (c<="9")
    THEN IF i=0 THEN INC(li) ELSE INC(nu) END END;     (* 0AA is no call *)
  END;  
(*
IO.WrCard(li,9);IO.WrCard(nu,9); IO.WrStrLn("<3>");
*)
  RETURN (nu+li=3) & (nu>=1) & (nu<=2) 
END iscall;

PROCEDURE Statist(cp:pTCPSOCK; t:TIME; VAR s:ARRAY OF CHAR);
VAR h:ARRAY[0..255] OF CHAR;
    n:CARDINAL;
BEGIN
  WITH cp^ DO
    IF connt<t THEN DEC(t, connt) ELSE t:=0 END;
    Assign(s, " t="); TimeToStr(t, h); Append(s, h);
    CardToStr(txframes, 1, h); Append(s, " txf=");Append(s, h);
    CardToStr(rxframes, 1, h); Append(s, " rxf=");Append(s, h);
    Append(s, " tx"); appkib(s, txbytesh, txbytes);
    Append(s, " rx"); appkib(s, rxbytesh, rxbytes);
    IF t>0 THEN
      Append(s, " ");
      CardToStr(bitsec64(txbytesh, txbytes, t),  1, h); Append(s, h); Append(s, "tbit/s "); 
      CardToStr(bitsec64(rxbytesh, rxbytes, t),  1, h); Append(s, h); Append(s, "rbit/s");
    END;
  END;
END Statist;


PROCEDURE showlogout(sp:pTCPSOCK);
VAR h,t:ARRAY[0..255] OF CHAR;
BEGIN
  WITH sp^ DO
    IF slowlink THEN h:="T:slowlink closed " ELSE h:="T:connection closed " END;
    Append(h, user.call); Append(h," "); Append(h, ipnum); 
    IF connt<>0 THEN
      Statist(sp, systime, t);
      Append(h, t); 
    END;
    Append(h,""+LF);
  END;
  logline(resLOG, h);
END showlogout;


PROCEDURE Filter(to:pTCPSOCK; posc:POSCALL; dat-:ARRAY OF CHAR):BOOLEAN;

  PROCEDURE callscmp(i, len:CARDINAL; ignorlonger:BOOLEAN; dat-:ARRAY OF CHAR; calls-:FILTERCALLS):BOOLEAN;
  VAR j,k:CARDINAL;
      w, eos:BOOLEAN;
  BEGIN
    j:=0;
    WHILE (j<=HIGH(calls)) & (calls[j][0]<>0C) DO
      k:=0;
      LOOP
        w:=calls[j][k]="*"; 
        IF NOT w & (calls[j][k]<>dat[i+k]) THEN EXIT END;

        INC(k);
        IF (i+k>HIGH(dat)) THEN EXIT END;                         (* not normal data *)

        eos:=(k>=len) OR (dat[i+k]<=" ");
        IF (k>HIGH(calls[0])) OR (calls[j][k]=0C) THEN
          IF eos OR w OR ignorlonger THEN RETURN TRUE ELSE EXIT END;

        ELSIF eos THEN
          REPEAT
            IF calls[j][k]<>"*" THEN EXIT END;

            INC(k);
          UNTIL (k>HIGH(calls[0])) OR (calls[j][k]=0C);
          RETURN TRUE

        END; 
      END;
      INC(j);
    END;
    RETURN FALSE
  END callscmp;


  PROCEDURE vias(calls-:FILTERCALLS):BOOLEAN;
  VAR a,b:CARDINAL;
  BEGIN
    IF (calls[0][0]=0C) OR (dat[0]=0C) THEN RETURN FALSE END;

    a:=5;
    WHILE dat[a]<>"*" DO                            (* find last H-bit *)
      IF (a>=HIGH(dat)) OR (dat[a]=0C) OR (dat[a]=":") THEN RETURN FALSE END;

      INC(a);
    END;
    LOOP 
      b:=a;
      REPEAT
        DEC(a);
        IF a<3 THEN RETURN FALSE END;

      UNTIL dat[a-1]=",";

      IF callscmp(a, b-a, FALSE, dat, calls) THEN RETURN TRUE END;

    END; 
    RETURN FALSE

  END vias;

  PROCEDURE entrypoint(calls-:FILTERCALLS):BOOLEAN;
  VAR a,b,i:CARDINAL;
  BEGIN
    IF calls[0][0]=0C THEN RETURN FALSE END;

    i:=0;
    LOOP
      IF (i>HIGH(dat)-5) OR (dat[i]=0C) OR (dat[i]=":") THEN RETURN FALSE END; (* no qA *) 
      IF (dat[i]=",") & (dat[i+1]="q") & (dat[i+2]="A") & (dat[i+4]=",") THEN  (* ,qA., *)
        a:=i+5;
        b:=a;
        WHILE (b<HIGH(dat)) & (dat[b]<>0C) & (dat[b]<>":") & (dat[b]<>",") DO INC(b) END; (* call after qA *)
        EXIT
      END;
      INC(i);
    END;

    RETURN callscmp(a, b-a, FALSE, dat, calls)
  END entrypoint;

  PROCEDURE prefix(calls-:FILTERCALLS; fullmatch:BOOLEAN):BOOLEAN;
  VAR i   :CARDINAL;
  BEGIN
    IF calls[0][0]=0C THEN RETURN FALSE END;

    i:=0;
    WHILE (i<=HIGH(dat)) & (dat[i]<>0C) & (dat[i]<>">") DO INC(i) END; 
    RETURN callscmp(0, i, fullmatch, dat, calls)
  END prefix;

  PROCEDURE destcallfilt(calls-:FILTERCALLS):BOOLEAN;
  VAR a,b:CARDINAL;
  BEGIN
    IF calls[0][0]=0C THEN RETURN FALSE END;

    a:=0;
    WHILE dat[a]<>">" DO                                       (* begin of dest call ">" *)
      IF (a>=HIGH(dat)) OR (dat[a]=0C) THEN RETURN FALSE END;  (* not normal data *)

      INC(a);   
    END;
    INC(a);
    b:=a;
    LOOP 
      IF (b>HIGH(dat)) OR (dat[b]=0C) THEN RETURN FALSE END;  (* not normal data *)

      IF (dat[b]=",") OR (dat[b]=":") THEN EXIT END;          (* end of dest call ":" "," *)

      INC(b);
    END;

    RETURN callscmp(a, b-a, FALSE, dat, calls)
  END destcallfilt;

  PROCEDURE objectfilt(calls-:FILTERCALLS):BOOLEAN;
  VAR i, len:CARDINAL;
  BEGIN
    IF calls[0][0]=0C THEN RETURN FALSE END;

    i:=0;
    WHILE dat[i]<>":" DO                                       (* begin data *)
      IF (i>=HIGH(dat)) OR (dat[i]=0C) THEN RETURN FALSE END;  (* not normal data *)

      INC(i);
    END;
    INC(i);
    IF dat[i]<>";" THEN len:=9;                                (* object *)
    ELSIF dat[i]<>")" THEN                                     (* item *)
      len:=3;                                                  (* min item len *)
      WHILE (len<9) & (dat[i+len+1]<>"!") & (dat[i+len+1]<>"_") DO INC(len) END;   (* find item len *)
    ELSE RETURN FALSE END;                                     (* not object or item *)

    INC(i);                                                    (* object name *)

    RETURN callscmp(i, len, FALSE, dat, calls)
  END objectfilt;

  PROCEDURE typ(VAR t:CHAR):BOOLEAN;
  VAR i, j, ii:CARDINAL;
      c:CHAR; 
  BEGIN
    IF to^.filters.typs[0]=0C THEN RETURN FALSE END;

    i:=0;
    j:=0; 
    c:=0C;
    LOOP
      IF (i>HIGH(dat)-2) OR (dat[i]=0C) THEN RETURN FALSE END;                 (* no typ *) 

      IF dat[i]=":" THEN                                                       (* outer typ *)
        c:=dat[i+1];
        IF c<>cTHIRDPARTY THEN INC(i, 2); EXIT                                 (* inner typchar found*)

        ELSIF InStr(to^.filters.typs, "3")>=0 THEN RETURN TRUE END;            (* 3rd party frame *)

        j:=i+2;                                                                (* start of inner frame *)
      END;
      INC(i);
    END;

    IF c=cUSERMSG THEN
      ii:=i;
      WHILE (ii<HIGH(dat)) & (dat[j]=dat[ii]) DO INC(ii); INC(j) END;          (* msg to itself *)
      IF dat[j]=">" THEN c:=cTELEMETRY; t:=cTELEMETRY END;                     (* gets type telemetry *)
    END;

    IF posvalid(posc.pos) & (InStr(to^.filters.typs, "p")>=0) THEN RETURN TRUE END;  (* position frame *)
    IF (c=";") & (InStr(to^.filters.typs, "o")>=0) THEN RETURN TRUE END;       (* object *)
    IF c=")" THEN RETURN InStr(to^.filters.typs, "i")>=0 END;                  (* item *)
    IF c=cUSERMSG THEN
      IF dat[i+10]="?" THEN RETURN InStr(to^.filters.typs, "q")>=0             (* query *)
      ELSIF (i<HIGH(dat)-6) & (dat[i]="N") & (dat[i+1]="W") & (dat[i+2]="S") & (dat[i+3]="-")
      THEN RETURN InStr(to^.filters.typs, "n")>=0                              (* NWS bulletin *)
      ELSE RETURN InStr(to^.filters.typs, "m")>=0 END;                         (* message *)
    END;
    IF c=">" THEN RETURN InStr(to^.filters.typs, "s")>=0 END;                  (* status *)
    IF c=cTELEMETRY THEN RETURN InStr(to^.filters.typs, "t")>=0 END;           (* telemetry *)
    IF c="{" THEN RETURN InStr(to^.filters.typs, "u")>=0 END;                  (* user defined *)
    IF InStr(to^.filters.typs, "w")>=0 THEN                                    (* test if wx *)
      j:=0;
      IF c="_" THEN RETURN TRUE                                                (* positionless wx *)
      ELSIF (c="!") OR (c="=") THEN
        IF (dat[i]>="0") & (dat[i]<="9") THEN j:=i+18 ELSE j:=i+9 END;
      ELSIF (c="/") OR (c="@") THEN
        IF (dat[i+7]>="0") & (dat[i+7]<="9") THEN j:=i+25 ELSE j:=i+16 END;
      ELSIF c=";" THEN j:=i+35 END;
      IF (j>0) & (j<HIGH(dat)) & (dat[j]="_") & posvalid(posc.pos) THEN RETURN TRUE END;

    END;
    RETURN FALSE
  END typ;

  PROCEDURE msgfilt(calls-:FILTERCALLS):BOOLEAN;
  VAR i,j:CARDINAL;
  BEGIN
    IF calls[0][0]=0C THEN RETURN FALSE END;

    i:=0;
    WHILE dat[i]<>":" DO                                       (* begin data *)
      IF (i+11>=HIGH(dat)) OR (dat[i]=0C) THEN RETURN FALSE END;  (* not normal data *)

      INC(i);
    END;
    INC(i);
    IF (dat[i]<>":") OR (dat[i+10]<>":") THEN RETURN FALSE END; (* not message *)

    INC(i);                                                    (* receiver call of msg *)
    j:=0;
    LOOP
      IF (j>=9) OR (dat[j]=">") THEN RETURN FALSE END;         (* is telemetry *)

      IF dat[i+j]<>dat[j] THEN EXIT END;

      INC(j);
    END; 
    RETURN callscmp(i, 9, FALSE, dat, calls)
  END msgfilt;

  PROCEDURE qfilt(s-:ARRAY OF CHAR):BOOLEAN;
  VAR i:CARDINAL;
      c:CHAR;
  BEGIN
    IF s[0]=0C THEN RETURN FALSE END;

    i:=0;
    WHILE (dat[i]<>",") OR (dat[i+1]<>"q") OR (dat[i+2]<>"A") DO
      IF (i+3>=HIGH(dat)) OR (dat[i]=0C) OR (dat[i]=":") THEN RETURN FALSE END;

      INC(i);
    END;
    c:=dat[i+3];   
    i:=0;
    WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
      IF s[i]=c THEN RETURN TRUE END;

      INC(i);
    END; 
    RETURN FALSE
  END qfilt;


  PROCEDURE symfilt(syms-:FILTERCALLS):BOOLEAN;
  VAR micedest, payload, i, speed, course:CARDINAL;
      ok,
      ov:BOOLEAN;
      pos:POSITION;
      alt:INTEGER;
      sym, symt, postyp:CHAR;
      com:ARRAY[0..500] OF CHAR;
  BEGIN
    IF syms[0][0]=0C THEN RETURN FALSE END;

    micedest:=0;
    LOOP
      IF (micedest>=HIGH(dat)) OR (dat[micedest]=0C) THEN RETURN FALSE END;

      IF dat[micedest]=">" THEN EXIT END;
      INC(micedest);
    END;
    INC(micedest);
    payload:=micedest;
    LOOP
      IF (payload>=HIGH(dat)) OR (dat[payload]=0C) THEN RETURN FALSE END;

      IF dat[payload]=":" THEN EXIT END;
      INC(payload);
    END;
    INC(payload);
    GetPos(pos, speed, course, alt, sym, symt, dat, micedest, payload, com, postyp);
    IF symt="/" THEN                                            (* primary table *)
      i:=0;
      WHILE (i<=HIGH(syms[0])) & (syms[0][i]>" ") DO
        IF syms[0][i]=sym THEN RETURN TRUE END;

        INC(i);
      END;
    ELSE                                                        (* secondary table *)
      ov:=syms[2][0]>" ";                                       (* overlay given *)
      IF syms[1][0]>" " THEN                                    (* symbol must fit *)
        ok:=FALSE;
        i:=0;
        REPEAT
          IF syms[1][i]=sym THEN ok:=TRUE END;
          INC(i);
        UNTIL ok OR (i>HIGH(syms[1])) OR (syms[1][i]<=" ");
        IF ok & NOT ov THEN RETURN TRUE END;

      ELSE ok:=TRUE END;
      IF ok & ov THEN                                           (* check overlay *)
        i:=0;
        REPEAT
          IF syms[2][i]=symt THEN RETURN TRUE END;

          INC(i);
        UNTIL (i>HIGH(syms[0])) OR (syms[2][i]<=" ");
      END;
    END;
    RETURN FALSE
  END symfilt;


VAR pass:BOOLEAN;
BEGIN
  pass:=FALSE;
  IF vias(to^.filters.viacalls) THEN 
    IF to^.filters.notvia THEN RETURN FALSE ELSE pass:=TRUE END;   (* exclusion overloads *)
  END;

  IF entrypoint(to^.filters.entrycalls) THEN 
    IF to^.filters.notentry THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF destcallfilt(to^.filters.destcalls) THEN
    IF to^.filters.notdestcall THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF prefix(to^.filters.bud, FALSE) THEN
    IF to^.filters.notbud THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF prefix(to^.filters.prefixes, TRUE) THEN
    IF to^.filters.notprefix THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF objectfilt(to^.filters.objects) THEN
    IF to^.filters.notobject THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF msgfilt(to^.filters.msgs) THEN
    IF to^.filters.notmsgs THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF qfilt(to^.filters.q[0]) THEN
    IF to^.filters.notq THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF symfilt(to^.filters.symbols) THEN
    IF to^.filters.notsymbols THEN RETURN FALSE ELSE pass:=TRUE END;
  END;

  IF typ(posc.typ) THEN
    IF to^.filters.nottyps THEN RETURN FALSE ELSE pass:=TRUE END;
  END;


  IF pass OR (posc.typ=cUSERMESSAGE) THEN RETURN TRUE END;          (* pass messages and ack *)

  IF to^.filters.typ="m" THEN
    RETURN posvalid(to^.user.pos) & posvalid(posc.pos) 
    & (distance(to^.user.pos, posc.pos)<=to^.filters.radius)

  ELSIF to^.filters.typ="r" THEN
(*
IO.WrStr("l,b,l,b,d,r:"); IO.WrFixed(to^.filters.base.lat/RAD, 4,10); IO.WrFixed(to^.filters.base.long/RAD, 4,10);  
IO.WrFixed(posc.pos.lat/RAD, 4,10); IO.WrFixed(posc.pos.long/RAD, 4,10);
IO.WrFixed(distance(to^.filters.base, posc.pos), 4,10); IO.WrFixed(to^.filters.radius, 4,10);
IO.WrLn;
*)
    RETURN posvalid(posc.pos) & (distance(to^.filters.base, posc.pos)<=to^.filters.radius)
  ELSIF to^.filters.typ="a" THEN
(*
IO.WrStr("l,b,l,b,l,b,d,r:"); 
IO.WrFixed(to^.filters.base.lat/RAD, 4,10); IO.WrFixed(to^.filters.base.long/RAD, 4,10);  
IO.WrFixed(to^.filters.edge.lat/RAD, 4,10); IO.WrFixed(to^.filters.edge.long/RAD, 4,10);
IO.WrFixed(posc.pos.lat/RAD, 4,10); IO.WrFixed(posc.pos.long/RAD, 4,10);
IO.WrLn;
*)
    RETURN posvalid(posc.pos) & (to^.filters.base.lat>=posc.pos.lat) 
         & (to^.filters.base.long<=posc.pos.long)
         & (to^.filters.edge.lat<=posc.pos.lat) & (to^.filters.edge.long>=posc.pos.long) 
  END;
  RETURN NOT datafilter;
END Filter;


PROCEDURE sendtcpbuf(to:pTCPSOCK);
VAR res, i:INTEGER;
BEGIN
  WITH to^ DO
    res:=tcp.sendsock(fd, tbuf, tlen);
    IF res>0 THEN
      FOR i:=res TO tlen-1 DO tbuf[i-res]:=tbuf[i] END;
      DEC(tlen,res);
    END;
  END;
END sendtcpbuf;


PROCEDURE Sendtcp(to:pTCPSOCK; buf-:FRAMEBUF);
VAR len,i:INTEGER;
BEGIN
  len:=Length(buf);
  WITH to^ DO
    IF tlen+len>=SIZE(tbuf) THEN sendtcpbuf(to) END;
    IF tlen+len<SIZE(tbuf) THEN
      FOR i:=0 TO len-1 DO tbuf[tlen]:=buf[i]; INC(tlen) END; 
      INC(txframes);
      INC(txbytes, len); IF txbytes<VAL(CARDINAL,len) THEN INC(txbytesh) END;       (* 32 bit overflow *)
    ELSE
      INC(losttxframes);
      IF verb THEN WrStrLn("tx buf overflow") END;
    END;
  END;
END Sendtcp;

PROCEDURE NetToRf(b-:ARRAY OF CHAR; rfport:CARDINAL);   (* send as 3rd party frame to rf *)
VAR tb:FRAMEBUF;
    i, len, viaend, viaused:CARDINAL;
    outer, ii:INTEGER;
    done:BOOLEAN;

  PROCEDURE filt(s-:ARRAY OF CHAR):BOOLEAN;
  VAR n:INTEGER;
  BEGIN n:=InStr(b, s); RETURN (n>=0) & (n<outer) END filt;
 
BEGIN
  outer:=InStr(b, ":");                                           (* test if gate to rf allowed *)
  IF (outer<0) OR filt("qAX") THEN RETURN END;

  viaend:=outer;
  WHILE (outer<VAL(INTEGER,HIGH(b))) & ((b[outer]<>":") OR (b[outer+1]=cTHIRDPARTY)) DO INC(outer) END; 
  IF filt("TCPXX") OR filt("NOGATE") OR filt("RFONLY") THEN RETURN END;  

  Assign(tb, viacall);
  Append(tb, ">"+TOCALL);
  IF nettorfpath[0]<>0C THEN
    IF nettorfpath[0]="-" THEN                                    (* append ssid to dest call*)
      REPEAT Append(tb, nettorfpath[0]); Delstr(nettorfpath,0,1);
      UNTIL (nettorfpath[0]<"0") OR (nettorfpath[0]>"9");
      IF nettorfpath[0]="," THEN Delstr(nettorfpath,0,1) END;
    END;
    IF nettorfpath[0]<>0C THEN
      Append(tb, ",");
      Append(tb, nettorfpath);
    END;
  END;
  Append(tb, ":"+cTHIRDPARTY);

  viaused:=0;
  WHILE (viaused<viaend) & (b[viaused]<>",") DO INC(viaused) END; (* find begin of via *)
  ii:=InStr(b, ",TCPIP");
  IF (ii<0) OR (ii>VAL(INTEGER, viaend)) THEN                     (* remove all via if via TCPIP *) 
    i:=viaused;
    WHILE (i<viaend) & (b[i]<>"*") DO INC(i) END;                 (* used via *)
    IF (i<viaend) THEN viaused:=i END;                            (* used path found remove "*" *)
  END;  

  len:=Length(tb);
  i:=0;
--  WHILE (b[i]<>",") & (i<viaend) & (len<=HIGH(tb)) DO           (* original head remove via*)
  WHILE (i<viaused) & (len<=HIGH(tb)) DO                          (* original head with used via*)
    tb[len]:=b[i];
    INC(i);
    INC(len);
  END;
  IF len<=HIGH(tb) THEN tb[len]:=0C END; 

  Append(tb, ",TCPIP,"); 
  Append(tb, viacall);
  Append(tb, "*");

  len:=Length(tb);
  i:=viaend;
  WHILE (i<=HIGH(b)) & (b[i]<>0C) & (len<=HIGH(tb)) DO            (* original data part *)
    tb[len]:=b[i];
    INC(i);
    INC(len);
  END;
  IF len<=HIGH(tb) THEN tb[len]:=0C END;

  i:=0;
  WHILE (i<HIGH(tb)) & (tb[i]<>0C) & (tb[i]<>CR) & (tb[i]<>LF) DO INC(i) END;
  tb[i]:=0C;
  done:=Sendudp(tb, rfport, FALSE);
END NetToRf;


PROCEDURE Sendall(buf-:FRAMEBUF; fromfd:INTEGER; posc-:POSCALL);
VAR t:pTCPSOCK; 
    u:pUDPSOCK;
    uport:CARDINAL;
BEGIN
  IF buf[0]<>0C THEN

    t:=tcpsocks;
    WHILE t<>NIL DO
      IF (t^.fd<>fromfd) & (t^.service<>cISWWW) 
      & (t^.connt>0) & ((t^.service<>cISSERVER) OR Filter(t, posc, buf)) THEN Sendtcp(t, buf) END;
      t:=t^.next;
    END;

    IF (fromfd>0) & posvalid(posc.pos) THEN
      u:=udpsocks;
      uport:=1;
      WHILE u<>NIL DO 
        IF (u^.torfradius>0.0) & ((u^.torfradius>=20000.0)
        OR posvalid(home) & (distance(home, posc.pos)<u^.torfradius))
        THEN NetToRf(buf, uport); END;
        INC(uport);
        u:=u^.next;
      END;
    END;
    IF rawlogname[0]<>0C THEN writerawlog(buf) END;

  END;
END Sendall;


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 str2int(s-:ARRAY OF CHAR; VAR x:INTEGER):BOOLEAN;
VAR i:CARDINAL;
    neg, ok:BOOLEAN;
BEGIN
  i:=0;
  neg:=s[0]="-";
  IF neg THEN INC(i) END;
  x:=0;
  ok:=FALSE;
  WHILE (i<=HIGH(s)) & (s[i]>="0") & (s[i]<="9") DO
    x:=x*10 + VAL(INTEGER, ORD(s[i])-ORD("0"));
    INC(i);
    ok:=TRUE;
  END;
  IF neg THEN x:=-x END;
  RETURN ok
END str2int;

PROCEDURE beaconmacros(VAR s:ARRAY OF CHAR);
CONST MSYM="\";
VAR i:CARDINAL;
    len,j:INTEGER;  
    ds,ns:ARRAY[0..255] OF CHAR;
    fn:ARRAY[0..1023] OF CHAR;
    f:INTEGER;
BEGIN
  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]="v" THEN                    (* insert version *)
        Append(ns, VERS);
      ELSIF s[i]=":" THEN                    (* insert file *)
        fn[0]:=0C;
        INC(i);
        WHILE (i<HIGH(s)) & (s[i]<>0C) & (s[i]<>":") DO Append(fn, s[i]); INC(i) END;
        f:=OpenRead(fn);
        IF f>=0 THEN
          len:=RdBin(f, ds, SIZE(ds)-1);
          Close(f);
          j:=0;
          WHILE (j<len) & (ds[j]<>CR) & (ds[j]<>LF) & (ds[j]<>0C) DO 
            Append(ns, ds[j]); 
            INC(j);
          END;
        ELSE
          IF verb THEN WrLn; WrStrLn("beacon macro file not readable "); END;
          s[0]:=0C;
          RETURN

        END; 
      ELSIF s[i]="t" THEN                    (* cpu temperature *)
        f:=OpenRead(CPUTEMPFN);
        IF f>=0 THEN
          len:=RdBin(f, ds, SIZE(ds)-1);
          Close(f);
          IF str2int(ds, j) THEN
            Append(ns, "CPU="); 
            IntToStr(j DIV 1000, 1, ds);
            Append(ns, ds);
            Append(ns, "C");
          END;
        ELSIF verb THEN WrLn; WrStrLn("cpu temp not readable "); END;
      ELSIF s[i]="\" THEN Append(ns, "\\");
      ELSE
        IF verb THEN WrLn; WrStrLn("bad beacon macro "); END;
        s[0]:=0C;
        RETURN

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


PROCEDURE AppQ(VAR h:ARRAY OF CHAR; q-:ARRAY OF CHAR; appcall:BOOLEAN);
BEGIN
  Append(h, ">"+TOCALL+",");
  Append(h, q);
  IF appcall THEN Append(h, servercall) END;
  Append(h, ":");
END AppQ;


<*IF SRTM THEN*>
PROCEDURE GetMyAlt(pos-:POSITION; VAR alt:REAL);
VAR res:REAL;
BEGIN alt:=getsrtm(pos, 1, res) END GetMyAlt;
<*END*>


PROCEDURE Netbeacon(VAR h:ARRAY OF CHAR; qai, withpath:BOOLEAN);
VAR f, i, valt:INTEGER;
    h1:ARRAY[0..4095] OF CHAR;
    j:CARDINAL;
    vcourse, vspeed       : CARDINAL;
    vsym, vsymt           : CHAR;
    postyp                : CHAR;
BEGIN
  h[0]:=0C;
  IF (servercall[0]<>0C) & (netbeaconfn[0]<>0C) THEN
    f:=OpenRead(netbeaconfn);  
    IF f>=0 THEN
      i:=RdBin(f, h1, SIZE(h1)-1);
      IF i>=0 THEN
        h1[i]:=0C;
        WHILE h1[0]="#" DO                                   (* comment *)
          i:=0;
          WHILE h1[i]>=" " DO INC(i) END;                    (* skip comment *)
          WHILE (h1[i]<>0C) & (h1[i]<" ") DO INC(i) END;     (* cr lf *)
          Delstr(h1, 0, i);                                  (* del comment line *)
        END;
        i:=0;
        WHILE h1[i]>=" " DO INC(i) END;
        h1[i]:=0C;
        beaconmacros(h1);
        IF withpath THEN
          Assign(h, servercall);
          IF qai THEN AppQ(h, "TCPIP*,qAI,", TRUE) ELSE AppQ(h, "TCPIP*", FALSE) END;
          Append(h, h1);
          Append(h, CR+LF);
        ELSE Assign(h, h1) END;                           (* APRSP *)
      END;
      Close(f);

      j:=0; WHILE (j<HIGH(h)-1) & (h[j]<>":") DO INC(j) END; 
      GetPos(home, vspeed, vcourse, valt, vsym, vsymt, h, 0, j+1, h1, postyp); (* find server position *) 
<*IF SRTM THEN*>
      IF posvalid(home) & (homealt<=-1000.0) THEN
        GetMyAlt(home, homealt);
        IF ABS(homealt)>10000.0 THEN homealt:=-10000.0 END; 
      END; 
      IF verb & (homealt>-1000.0) THEN
        WrStr("get igate altitude from srtm as "); WrFixed(homealt, 1,1); WrStrLn("m");
      END;
<*END*>
      IF verb & NOT posvalid(home) THEN WrStrLn("netbeacon has no valid position") END;
    ELSIF verb THEN WrStrLn("netbeacon file open error") END;
  END;
END Netbeacon;


PROCEDURE Timebeacon(cp:pTCPSOCK);
VAR h:FRAMEBUF;
    qai:BOOLEAN;
BEGIN
  IF (cp^.service<>cISWWW) & (Watchclock(cp^.beacont, netbeaconintervall)) THEN
    qai:=TRUE; 
    IF cp^.service=cISGATEWAY THEN
      IF (qas=1) OR (qas>qasc+1) THEN qai:=FALSE; INC(qasc) ELSE qasc:=0 END;
    END;
    Netbeacon(h, qai, TRUE);
    IF h[0]<>0C THEN Sendtcp(cp, h) END;
  END;
END Timebeacon;


PROCEDURE cpcall(VAR s:ARRAY OF CHAR; h-:ARRAY OF CHAR; pr:CARDINAL);
VAR c:CHAR;
    VAR i:CARDINAL;
BEGIN
  i:=0;
  LOOP
    c:=h[pr];
    IF (i>=HIGH(s)) OR (c=0C) OR (c=">") OR (c="*")
    OR (c=":") OR (c=",") OR (c=" ") THEN EXIT END;
    s[i]:=c;
    INC(i);
    INC(pr);
  END;
  s[i]:=0C;
END cpcall;


PROCEDURE FindUserHeard(VAR ph:pHEARD; c-:MONCALL; VAR rfport:CARDINAL):TIME; (* never heard or too long = 0 else time+1 *)
BEGIN
  WHILE (ph<>NIL) & (ph^.mhtime+heardtimew>systime) DO
    IF StrCmp(ph^.call, c) THEN
      IF ph^.mhtime<=systime THEN 
        rfport:=ph^.fromrx; 
        RETURN 1+systime-ph^.mhtime 

      ELSE RETURN 0 END;

    END;
    ph:=ph^.next;
  END;
  RETURN 0
END FindUserHeard;

PROCEDURE FindHeard(ph:pHEARD; c-:MONCALL; VAR rfport:CARDINAL):TIME; (* never heard or too long = 0 else time+1 *)
BEGIN RETURN FindUserHeard(ph, c, rfport) END FindHeard;


PROCEDURE Heard(b-:ARRAY OF CHAR; VAR from:MONCALL; VAR trust:BOOLEAN):BOOLEAN;
VAR p, i, len:CARDINAL;
BEGIN
(* from>to,path,gate:...*)
  p:=0;
  WHILE (p<HIGH(from)) & (b[p]<>">") DO from[p]:=b[p]; INC(p) END;  (* get user call *)
  from[p]:=0C;

  i:=Length(b);
  len:=0;
  WHILE (len<i) & (b[len]<>":") DO INC(len) END;
  trust:=(b[len+1]<>cUSERMESSAGE) & (b[len+1]<>cTHIRDPARTY);    (* not from physical sender *)


  WHILE (p<len) & (b[p]<>",") DO INC(p) END;                    (* skip destination call *)
  IF b[p]="," THEN                                              (* get first via *)
    INC(p);
    i:=p;
    WHILE (p<len) & (b[p]<>",") DO INC(p) END;
    IF b[p-1]="*" THEN RETURN FALSE END;                        (* is repeated *)

    IF (b[p-1]>="0") & (b[p-1]<="9") & (b[p-1]<>b[p-3]) THEN RETURN FALSE END;                     (* WIDEn-x with n<>x *) 
    WHILE p<len DO                                              (* more vias *)
      INC(p);
      WHILE (p<len) & (b[p]<>",") DO INC(p) END;
      IF b[p-1]="*" THEN RETURN FALSE END;                      (* is repeated *)
    END;
  END;
  RETURN TRUE
END Heard;


PROCEDURE IncHeard(ph:pHEARD; pk, jnk:BOOLEAN; livetime:TIME);
VAR  t:TIME;
BEGIN
  IF livetime>0 THEN
    WITH ph^ DO
      t:=systime DIV (livetime DIV MHSTEPS) + (HIGH(cnt)+1);
      IF cntt+(HIGH(cnt)+1)<t THEN cntt:=t-(HIGH(cnt)+1) END;
      WHILE cntt<t DO
        INC(cntt);
        WITH cnt[cntt MOD (HIGH(cnt)+1)] DO pack:=0; junk:=0 END;
      END; 
      t:=cntt MOD (HIGH(cnt)+1);
      IF pk  & (cnt[t].pack<MAX(CARD16)) THEN INC(cnt[t].pack) END;
      IF jnk & (cnt[t].junk<MAX(CARD16)) THEN INC(cnt[t].junk) END;
    END;
  END;
--FOR t:=0 TO HIGH(ph^.cnt) DO WrInt(ORD(ph^.cnt[t]), 2) END; WrLn;
END IncHeard;

PROCEDURE skipobj(b-:ARRAY OF CHAR; i:CARDINAL; VAR del:BOOLEAN):CARDINAL;
VAR len:CARDINAL;
BEGIN
  len:=0;
  IF (b[i]=";") & ((b[i+10]="*") OR (b[i+10]="_")) THEN (* object *)
    len:=9;
    IF b[i+10]="_" THEN del:=TRUE END;
  ELSIF b[i]=")" THEN                                      (* item *)
    len:=3;                                                  (* min item len *)
    WHILE (len<9) & (b[i+len+1]<>"!") & (b[i+len+1]<>"_") DO INC(len) END;   (* find item len *)
    IF b[i+len+1]="_" THEN del:=TRUE END;
  END;                                                       (* not object or item *)
  RETURN len
END skipobj;

PROCEDURE DirectPos(b-:ARRAY OF CHAR; VAR pos:POSITION; VAR sym, symt, typ:CHAR;
                    VAR data, clb, mhz:REAL; VAR alt:INTEGER; VAR dir:CARDINAL;
                    objpos:BOOLEAN; VAR objtime:TIME);
VAR vdir,
    p, m, my, i :CARDINAL;
    posn        :POSITION;
    postyp,
    sym1, symt1,
    ch          :CHAR;
    dc          :MONCALL;
    com         :FRAMEBUF;
    v,
    sg          :REAL;
    ii          :INTEGER;
    ok          :BOOLEAN;

  PROCEDURE decb(c:CHAR; VAR ok:BOOLEAN):CARDINAL;
  VAR d:CARDINAL; 
  BEGIN
    d:=ORD(c)-ORD("0");
    IF d>9 THEN ok:=FALSE END; 
    RETURN d
  END decb;


  PROCEDURE Wx(p:CARDINAL);
  VAR t:INTEGER;
      sig:BOOLEAN;
      o:CARDINAL;
  BEGIN
    o:=skipobj(b, p, sig);
    IF o=0 THEN
      IF (b[p]<>"/") & (b[p]<>"@") & (b[p]<>"!") & (b[p]<>"=") THEN RETURN END;

      IF (b[p]="/") OR (b[p]="@") THEN INC(p,7) END;
      INC(p);
    ELSE INC(p, o+9) END;
    IF (b[p]>="0") & (b[p]<="9") THEN INC(p, 30) ELSIF b[p]>="/" THEN INC(p, 17) END;
    IF b[p]<>"t" THEN RETURN END;

    t:=0;
    sig:=FALSE;
    IF b[p+1]="-" THEN sig:=TRUE
    ELSIF (b[p+1]>="0") & (b[p+1]<="9") THEN t:=(ORD(b[p+1])-ORD("0"))*100 ELSE RETURN END;

    IF (b[p+2]>="0") & (b[p+2]<="9") THEN INC(t, (ORD(b[p+2])-ORD("0"))*10) ELSE RETURN END;

    IF (b[p+3]>="0") & (b[p+3]<="9") THEN INC(t,  ORD(b[p+3])-ORD("0")) ELSE RETURN END;

    IF sig THEN t:=-t END;
    typ:=tCELSIUS;
    data:=VAL(REAL,t-32)/1.8;
  END Wx;

BEGIN
(* OE0AAA>ABCDEF-2,....:...*)
(*        ^mice         ^payload*) 
  
  clb:=0.0;
  alt:=-10000;
  dir:=0;
  typ:=tUNK;
  p:=0;
  objtime:=MAX(TIME);
  WHILE (p<HIGH(b)) & (b[p]<>">") DO INC(p) END;
  m:=p+1;
  WHILE (p<HIGH(b)) & (b[p]<>":") DO INC(p) END;
  INC(p);

  my:=0;
  WHILE b[p]=cTHIRDPARTY DO
    my:=p+1;                                                          (* inner src call *)
    WHILE (p<=HIGH(b)) & (b[p]<>0C) & (b[p]<>":") DO INC(p) END;
    INC(p);
  END;

  IF (p<HIGH(b)) & (objpos OR (b[p]<>";") & (b[p]<>")")) THEN         (* items, objects *)
    vspeed:=MAX(CARDINAL);
    valt:=-10000;
    vdir:=0;
    GetPos(posn, vspeed, vdir, valt, sym1, symt1, b, m, p, com, postyp);
    dc[0]:=b[m]; dc[1]:=b[m+1]; dc[2]:=b[m+2]; dc[3]:=b[m+3]; dc[4]:=b[m+4]; dc[5]:=b[m+5]; dc[6]:=0C;
    GetSym(dc, sym1, symt1);
---object time
    IF (b[p]=";") & (b[p+17]="h") THEN  (* object has time an is in HMS *) 
      ok:=TRUE;
      objtime:=decb(b[p+11], ok)*36000 + decb(b[p+12], ok)*3600
             + decb(b[p+13], ok)*600   + decb(b[p+14], ok)*60
             + decb(b[p+15], ok)*10    + decb(b[p+16], ok);
      IF NOT ok THEN objtime:=MAX(TIME) END;

    END;
---object time
    IF posvalid(posn) THEN 
      typ:=tPOS;
      pos:=posn; sym:=sym1; symt:=symt1; alt:=valt;
      IF (vspeed<MAX(CARDINAL)) & (vspeed>0) THEN dir:=vdir END;
      IF sym="_" THEN Wx(p);
      ELSIF vspeed<MAX(CARDINAL) THEN
        typ:=tSPEED;
        data:=VAL(REAL, vspeed)*KNOTS;  
      END;
      IF valt>-1000 THEN
        com[HIGH(com)]:=0C;
--clb
        ii:=InStr(com, "Clb=");
        IF ii>=0 THEN

          INC(ii, 4);
          IF com[ii]="-" THEN sg:=-1.0; INC(ii) ELSE sg:=1.0 END;
          WHILE (com[ii]>="0") & (com[ii]<="9") DO clb:=clb*10.0+VAL(REAL,ORD(com[ii])-ORD("0")); INC(ii) END;
          clb:=clb*sg;
          IF com[ii]="." THEN 
            LOOP
              INC(ii);
              sg:=sg*0.1;
              IF (com[ii]>="0") & (com[ii]<="9") THEN clb:=clb+VAL(REAL,ORD(com[ii])-ORD("0"))*sg
              ELSE EXIT END;
            END;             
          END;
          IF clb=0.0 THEN clb:=0.0001 END;     (* mark for altitude needs egm *)
        END;
--clb
      END; 
--mhz
      ii:=InStr(com, "MHz");
      IF ii>0 THEN
        v:=0.0;
        DEC(ii);
        WHILE (ii>=0) & (com[ii]>="0") & (com[ii]<="9") DO v:=(v+VAL(REAL,ORD(com[ii])-ORD("0")))*0.1; DEC(ii) END;
        sg:=1.0;
        IF (ii>0) & (com[ii]=".") THEN
          LOOP
            DEC(ii);
            IF (ii>=0) & (com[ii]>="0") & (com[ii]<="9") THEN v:=v+VAL(REAL,ORD(com[ii])-ORD("0"))*sg
            ELSE EXIT END;
            sg:=sg*10.0;
          END;
        END;
        IF v>0.0 THEN mhz:=v END;
      END;
--mhz

--  ELSIF NOT (b[p] IN CHSET{":","?"}) THEN typ:=tJUNK END;  (* message bulletin query have no pos but is ok *) 
    ELSIF b[p]=":" THEN                          (* msg bulletin query or telemetry *) 
      m:=0;            
      INC(p);                                    (* msg dest call *)
      LOOP
        ch:=b[my];
        IF ch=">" THEN ch:=" " ELSE INC(my) END; (* end of src call *)
        IF ch<>b[p+m] THEN EXIT END;             (* not same call *)

        INC(m);
        IF m>8 THEN typ:=tJUNK; EXIT END;        (* msg dest = inner mycall is telemetry *)
      END;
    ELSE typ:=tJUNK END;                         (* append more good frametypes *)

  END;
END DirectPos;

PROCEDURE MHcount(ph:pHEARD; maxtime:TIME; VAR cj:CARDINAL):CARDINAL;
VAR ci, i:CARDINAL;
BEGIN
  IncHeard(ph, FALSE, FALSE, maxtime);                                       (* clean count array *)
  WITH ph^ DO
    ci:=0;
    cj:=0;
    FOR i:=0 TO HIGH(cnt) DO INC(ci, cnt[i].pack); INC(cj, cnt[i].junk); END;
  END;
  RETURN ci
END MHcount;


PROCEDURE AddHeard(VAR table:pHEARD; maxtime:TIME; from-:MONCALL; fromport:CARDINAL;
                   buf-:ARRAY OF CHAR; VAR ungat:BOOLEAN; setungat, withobjpos, del:BOOLEAN);
VAR i, j, si, ji  :CARDINAL;
    res   :INTEGER;
    ph, po:pHEARD;
    pr, prh:pRAWTEXT;
    objtime:TIME; 
BEGIN
  po:=NIL;
  ph:=table;
  IF mhperport THEN
    WHILE (ph<>NIL) & ((ph^.fromrx<>fromport) OR NOT StrCmp(ph^.call, from)) DO po:=ph; ph:=ph^.next END;
  ELSE
    WHILE (ph<>NIL) & NOT StrCmp(ph^.call, from) DO po:=ph; ph:=ph^.next END;
  END;

  IF ph<>NIL THEN                                               (* entry found *)  
    IF po<>NIL THEN po^.next:=ph^.next END;                     (* remove from chain *)
  ELSE                                                          (* new entry *)
    po:=NIL;
    ph:=table;
    IF ph<>NIL THEN
      i:=0;
      WHILE ph^.next<>NIL DO INC(i); po:=ph; ph:=ph^.next END;
      IF (i>=MAXHEARD) OR (ph^.mhtime+maxtime<systime) THEN     (* old or table full *) 
        IF po<>NIL THEN po^.next:=ph^.next END;                 (* remove from chain *)
      ELSE ph:=NIL END;
    END;

    IF ph=NIL THEN 
      ALLOCATE(ph, SIZE(ph^));
      IF (ph=NIL) & (po<>NIL) THEN ph:=po^.next; po^.next:=NIL END;
    ELSE                                                        (* free rawtext lines *)
      FOR i:=0 TO HIGH(ph^.rawtext) DO
        prh:=ph^.rawtext[i];
        WHILE prh<>NIL DO pr:=prh^.next; DEALLOCATE(prh, prh^.len); prh:=pr END; 
      END;
    END;

    IF ph<>NIL THEN
      FILL(ph, 0C, SIZE(ph^));
      ph^.call:=from;
    END;
  END;

  IF ph<>NIL THEN
    IF ph<>table THEN
      ph^.next:=table;
      table:=ph;
    END;

    WITH ph^ DO
      IF del THEN mhtime:=0 ELSE mhtime:=systime END;
      IF setungat THEN 
        ungate:=ungat;
        IF NOT ungat & (MHcount(ph, maxtime, j)=0) THEN ph^.mhtime:=0 END; (* delete 0 count entry *) 
      ELSE


-- axudp2
        txd:=modeminfo.txd;
        level:=modeminfo.level;
        quali:=modeminfo.quali;
        snr:=modeminfo.snr;
        afc:=modeminfo.afc;

(*
        IF (udp2[0]<>0C) & (udp2[1]<>0C) THEN
          i:=2;
          WHILE (i<HIGH(udp2)) & (udp2[i]<>0C) DO
            CASE udp2[i] OF
              "T":getval(udp2, i, res); IF (res>0        ) & (res<=MAX(CARD16)) THEN txd:=res END;
             |"V":getval(udp2, i, res); IF (res>MINLEVEL ) & (res<=MAX(INT16)) THEN level:=res END; 
             |"Q":getval(udp2, i, res); IF (res>0        ) & (res<=MAX(CARD8)) THEN quali:=res END;
             |"S":getval(udp2, i, res); IF (res>MIN(INT8)) & (res<=MAX(INT8)) THEN snr:=res END;
             |"A":getval(udp2, i, res); IF ABS(res)<1000000 THEN afc:=res END;
            ELSE getval(udp2, i, res) END;
          END; 
        END;
*)
-- axudp2

        ungat:=ph^.ungate; 
        DirectPos(buf, position, sym, symt, datatyp, data, clb, mhz, altitude, dir, withobjpos, objtime);
        IF objtime<DAYSEC THEN                                           (* make time diff objet time - system time *)
          objtimediff:=objtime-realtime MOD DAYSEC;
          IF objtimediff<-DAYSEC DIV 2 THEN INC(objtimediff, DAYSEC)
          ELSIF objtimediff>DAYSEC DIV 2 THEN DEC(objtimediff, DAYSEC) END;
        ELSE objtimediff:=MAX(INTEGER) END;    
        IncHeard(ph, TRUE, datatyp=tJUNK, maxtime);

        i:=0;
        IF NOT withobjpos THEN
          WHILE (i<HIGH(buf)) & (buf[i]<>">") & (buf[i]<>0C) DO INC(i) END;
          INC(i);
        END; 
        j:=0;
        WHILE (j<HIGH(head)) & (i<HIGH(buf)) & (buf[i]<>":") & (buf[i]<>0C)
        & NOT ((buf[i]=",") & (buf[i+1]="q")) DO head[j]:=buf[i]; INC(j); INC(i) END;
        head[j]:=0C;
        fromrx:=fromport;
        IF rawlines>0 THEN                                          (* store raw frames in mh *)
          j:=Length(buf);
          IF j>=HIGH(pr^.text) THEN j:=HIGH(pr^.text)-1 END;        (* limit text len *)
          si:=SIZE(pr^)+j-HIGH(pr^.text);                           (* unit size *)
          ALLOCATE(pr, si);
          IF pr<>NIL THEN
            FILL(pr, 0C, si);
            pr^.htime:=time();
            pr^.txd:=txd;
            pr^.len:=si;
            pr^.quali:=quali;
            pr^.afc:=afc;
            pr^.snr:=snr;
            pr^.position:=position;
            i:=0;
            WHILE (i<j) DO pr^.text[i]:=buf[i]; INC(i) END;
            pr^.text[i]:=0C;
            ji:=ORD(datatyp=tJUNK);                                    (* use text/junk table *)
            prh:=rawtext[ji];
            i:=1;
            IF prh<>NIL THEN                                           (* not empty so find last line *)
              WHILE prh^.next<>NIL DO prh:=prh^.next; INC(i) END;      (* and count lines *)
              prh^.next:=pr; 
              IF i>=rawlines THEN                                      (* lines limit *)
                prh:=rawtext[ji]; 
                rawtext[ji]:=prh^.next;
                DEALLOCATE(prh, prh^.len);
              END; 
            ELSE rawtext[ji]:=pr END;                                  (* first line *)
          END;
        END;

      END;
    END;
  ELSE ungat:=FALSE END;
END AddHeard;

<*IF SONDE THEN*>


PROCEDURE AddObject(buf-:ARRAY OF CHAR; port:CARDINAL);
VAR i, j, len:CARDINAL;
    un,del:BOOLEAN;
    ob:MONCALL; 
BEGIN
  IF objmhfromtcp OR (port>0) THEN
    i:=0;
    del:=FALSE;
    WHILE buf[i]<>":" DO                                       (* begin data *)
      IF (i>=HIGH(buf)) OR (buf[i]=0C) THEN RETURN END;        (* not normal data *)

      INC(i);
    END;
    INC(i);
    len:=skipobj(buf, i, del);
    IF len>0 THEN
      INC(i);                                                    (* object name *)
      j:=0;
      REPEAT
        ob[j]:=buf[i]; INC(j); INC(i);
      UNTIL j>=len;
      WHILE (j>0) & (ob[j-1]<=" ") DO DEC(j) END;                (* trailing blanks *)
      IF j<=HIGH(ob) THEN ob[j]:=0C END;

      AddHeard(heardobj, heardtimeobj, ob, port, buf, un, FALSE, TRUE, del);
    END;
  END;
END AddObject;

<*END*>


PROCEDURE degtostr(VAR s:ARRAY OF CHAR; d:REAL; posc, negc:CHAR);
VAR n:CARDINAL;
    c:CHAR;
BEGIN
  d:=d/RAD;
  IF d<0 THEN d:=-d; c:=negc ELSE c:=posc END;
  n:=TRUNC(d);
  IntToStr(n, 1, s);
  Append(s, ".");
  n:=TRUNC((d-FLOAT(n))*3600.0);
  Append(s, CHR(48+n DIV 600));
  Append(s, CHR(48+n MOD 600 DIV 60));
  Append(s, ".");
  Append(s, CHR(48+n MOD 60 DIV 10));
  Append(s, CHR(48+n MOD 10));
  Append(s, c);
END degtostr;


PROCEDURE Getmsg(b-:ARRAY OF CHAR; rxport:CARDINAL; goodpath:BOOLEAN; VAR ungate:BOOLEAN);  (* get user msg and ack out of aprsis stream *)
CONST 
      HEADEREND=":";
      FROMEND=">";
      NOARCHIVE="!x!";

VAR pm, pf, len, p, void, po:CARDINAL; 
    fromcall, tocall, hfrom :MONCALL;
    c                       :CHAR;
    trust, dir, badcall:BOOLEAN;
BEGIN
  ungate:=FALSE;
  IF (b[0]=0C) OR rfcallchk & (rxport<>0) & NOT iscall(b, 0) OR (InStr(b, NOARCHIVE)>=0) THEN RETURN END;

  dir:=Heard(b, hfrom, trust);
  IF hfrom[0]<>0C THEN
    IF rxport<>0 THEN
      IF (heardtimew>MHSTEPS) & dir & trust THEN 
        AddHeard(hearddir, heardtimew, hfrom, rxport, b, ungate, FALSE, FALSE, FALSE);
      ELSIF heardtimevia>MHSTEPS THEN
        AddHeard(heardvia, heardtimevia, hfrom, rxport, b, ungate, FALSE, FALSE, FALSE);
      END;
    END;
  END;
  IF viacall[0]=0C THEN RETURN END;              (* mh server only *)

  len:=Length(b);
  pm:=0;
  REPEAT
    pf:=pm;
    LOOP
      IF pm>=len THEN RETURN END;

      IF b[pm]=HEADEREND THEN EXIT END;

      INC(pm);
    END;
    INC(pm, 2);
  UNTIL (pm>len) OR (b[pm-1]<>cTHIRDPARTY);                     (* skip thirdparty headers *)
  DEC(pm);

  IF (pm+10<len) & (b[pm]=cUSERMSG) & (b[pm+10]=cUSERMSG) & iscall(b, pm+1) THEN (* user message *)

(* to *)
    cpcall(tocall, b, pm+1);

(* from *)
    cpcall(fromcall, b, pf);
    IF StrCmp(fromcall, tocall) THEN RETURN END;                (* msg to him self telemetry ... *)

    IF goodpath & (FindHeard(hearddir, tocall, po)>0)
    THEN NetToRf(b, po) END;       (* from not-call (WINLINK) or msg sending off to local user *) 

  END;
END Getmsg;


PROCEDURE getportname(n:CARDINAL; VAR s:ARRAY OF CHAR); (* if not found return port number *)
VAR u:pUDPSOCK;
    i:CARDINAL;
BEGIN
  IF n=0 THEN Assign(s, "TCP") 
  ELSE
    u:=udpsocks;
    i:=1;
    WHILE (u<>NIL) & (i<n) DO INC(i); u:=u^.next END;
    IF (u=NIL) OR (u^.portname[0]=0C) THEN IntToStr(n, 1, s) ELSE Assign(s, u^.portname) END;
  END;
END getportname;


PROCEDURE MHtoFile;
CONST SEP="|";                                    (* field separator *)
      SEPESC=" ";                                 (* set instead of SEP *)
      TEMPFN="~";                                 (* append to filename for temp file *)
      LINELEN=99;                                 (* fill up lines to equal size *)

VAR h:ARRAY[0..255] OF CHAR;
    h1:ARRAY[0..15] OF CHAR;
    fn:FILENAME;
    hn:pHEARD;
    t:TIME;
    fd:INTEGER;
    p, cnt, jc:CARDINAL;

  PROCEDURE App(s:ARRAY OF CHAR);
  VAR i:CARDINAL;
  BEGIN
    i:=0;
    WHILE (i<=HIGH(s)) & (s[i]<>0C) DO 
      IF s[i]<>SEP THEN h[p]:=s[i] ELSE h[p]:=SEPESC END;
      INC(p);
      INC(i);
    END; 
  END App;

BEGIN
  Assign(fn, mhfilename);
  Append(fn, TEMPFN);
  fd:=OpenWrite(fn);
  IF fd<0 THEN RETURN END;

  cnt:=mhfilelines;
  hn:=hearddir;
  WHILE (cnt>0) & (hn<>NIL) DO
    p:=0;
    IF (hn^.mhtime+heardtimew>systime) & NOT hn^.ungate THEN
      App(hn^.call);  
      h[p]:=SEP; INC(p); 

      App(hn^.symt);
      App(hn^.sym);
      h[p]:=SEP; INC(p);

--      IntToStr(hn^.fromrx, 1, h1); App(h1);
      getportname(hn^.fromrx, h1); App(h1);
      h[p]:=SEP; INC(p);

      t:=hn^.mhtime;
      IF (systime<t) OR (t=0) THEN t:=0 ELSE t:=systime-t END;
      IntToStr(t, 1, h1); App(h1);
      h[p]:=SEP; INC(p);

      IntToStr(MHcount(hn, heardtimew, jc), 1, h1); App(h1);
      h[p]:=SEP; INC(p);

      IF posvalid(hn^.position) & posvalid(home) THEN
        FixToStr(distance(home, hn^.position)+0.05, 2, h1);
        App(h1);
      END;
      h[p]:=SEP; INC(p);

      IF hn^.datatyp=tCELSIUS THEN FixToStr(hn^.data, 2, h1); Append(h1, DEGSYM+"C");
      ELSIF hn^.datatyp=tSPEED THEN FixToStr(hn^.data, 0, h1); Append(h1, "kmh");
      ELSE h1:="" END;
      App(h1);
      h[p]:=SEP; INC(p);

      App(hn^.head);
      h[p]:=LF; INC(p);

      WrBin(fd, h, p);
    END;
    hn:=hn^.next;
    DEC(cnt);
  END; 
  Close(fd);
  Rename(fn, mhfilename);
END MHtoFile;


PROCEDURE pathchk(s-:ARRAY OF CHAR):BOOLEAN;         (* check if transmitter of frame sends its call*)
VAR p, ps, calls, ssid, num, lit:CARDINAL;
    ok, star:BOOLEAN; 
    c:CHAR;
BEGIN
  p:=0;
  WHILE s[p]<>"," DO
    IF s[p]=":" THEN RETURN TRUE END;

    INC(p);
    IF p>HIGH(s) THEN RETURN TRUE END;

  END;
  INC(p);
  star:=FALSE;
  calls:=0;
  LOOP
    num:=0;
    lit:=0;
    ok:=TRUE;
    LOOP
      IF p>HIGH(s) THEN RETURN TRUE END;

      c:=s[p];
      IF (c>="0") & (c<="9") THEN
        INC(num);
        ok:=FALSE;
      ELSIF (c>="A") & (c<="Z") THEN
        INC(lit);
        ok:=TRUE;
      ELSE EXIT END;

      INC(p);
    END;
    ps:=p;
    ssid:=16;
    IF s[p]="-" THEN
      INC(p);
      IF p>HIGH(s) THEN RETURN TRUE END;

      c:=s[p];
      IF (c>="0") & (c<="9") THEN
        ssid:=ORD(c)-ORD("0");
        INC(p);
        IF p>HIGH(s) THEN RETURN TRUE END;

        c:=s[p];
        IF (c>="0") & (c<="9") THEN
          ssid:=ssid*10+ORD(c)-ORD("0");
          INC(p);
        END;
      END;
    ELSE ssid:=0 END;
    ok:=ok & (ssid<16) & (num>0) & (num<=2) & (lit>=2) & (num+lit<=6);

    IF NOT ok THEN                                      (* not a call + ssid *)
      IF NOT star THEN
        WHILE (p<=HIGH(s)) & (s[p]<>":") DO
          IF s[p]="*" THEN RETURN FALSE END;            (* star after not call *) 

          INC(p);
        END;
        calls:=0;
      ELSIF calls=0 THEN RETURN FALSE END;              (* star but no calls *)

      IF (ps>=5) & (s[ps-5]="R") & (s[ps-4]="E") & (s[ps-3]="L") & (s[ps-2]="A") & (s[ps-1]="Y")
      OR (s[ps-4]="E") & (s[ps-3]="C") & (s[ps-2]="H") & (s[ps-1]="O")
      OR (s[ps-4]="G") & (s[ps-3]="A") & (s[ps-2]="T") & (s[ps-1]="E") THEN RETURN TRUE END;

      c:=s[ps-1];
      RETURN (c>="0") & (c<="9") & (ssid+calls>=ORD(c)-ORD("0"))    (* N-n possible or not *)

    ELSE INC(calls) END;
    IF (p<=HIGH(s)) & (s[p]="*") THEN
      star:=TRUE;
      INC(p);
    END;
    IF p>HIGH(s) THEN RETURN TRUE END;

    IF s[p]="," THEN INC(p) ELSE RETURN s[p]=":" END

  END;
END pathchk;


PROCEDURE HashCh(c:CHAR);
VAR b:CARD8;
BEGIN
  IF c<>" " THEN
--crc16
    b:=CAST(CARD8, CAST(SET8, c) / hashl);
    hashl:=CRCL[b] / hashh;
    hashh:=CRCH[b];
--fletcher
    INC(hash2, ORD(c));
    INC(hash3, hash2);
  END;
END HashCh;


PROCEDURE AprsIs(VAR buf:ARRAY OF CHAR; datafilt, msgfilt:GFILTSET; logcall-:ARRAY OF CHAR; 
                 udpchan:CARDINAL; txenabled, passvalid:BOOLEAN; VAR poscall:POSCALL):RES;

VAR i,p,len,pins,pssid,psum0,psum1,ilen,ha,payload,micedest,qpos:CARDINAL;
    hashl,
    hashh :SET8;
    hf    :CARD16;
    qtext :ARRAY[0..31] OF CHAR;
    ungat :BOOLEAN;
    postyp:CHAR;
    unset :GFILTSET;
    com   :FRAMEBUF;

  PROCEDURE callchk(withstar, iscall:BOOLEAN):INTEGER;
  VAR i, j, num, lit:CARDINAL;
      c   :CHAR;
      u   :GATEFILT;
  BEGIN
    pssid:=0;
    FOR u:=MIN(GATEFILT) TO MAX(GATEFILT) DO
      j:=0;
      i:=p;
      WHILE ungates[u][j]=buf[i] DO
        INC(i);
        INC(j);
        IF (ungates[u][j]="*") OR ((ungates[u][j]=0C) & ((buf[i]=",") OR (buf[i]=":"))) THEN INCL(unset, u) END;
      END;
    END;
    IF iscall THEN                                                      (* we want a callsign *)
      num:=0;
      lit:=0;
      c:=buf[p];
      IF (c>="A") & (c<="Z") OR (c="^") THEN INC(lit) ELSIF (c<"0") OR (c>"9") THEN RETURN -1 END;

      INC(p);
      LOOP
        c:=buf[p];
        IF (c>="0") & (c<="9") THEN INC(num) ELSIF (c>="A") & (c<="Z")  OR (c="^")
        THEN INC(lit) ELSE EXIT END;

        INC(p);
      END;
      IF (lit<2) OR (num=0) OR (num>2) THEN RETURN -1 END;

      pssid:=p;
      IF buf[p]="-" THEN
        INC(p);
        IF buf[p]="1" THEN 
          INC(p);
          IF (buf[p]>="0") & (buf[p]<="5") THEN INC(p) END;
        ELSIF (buf[p]<"1") OR (buf[p]>"9") THEN RETURN -1 ELSE INC(p) END;

      END;

    ELSIF (buf[p]="q") & (buf[p+1]="A") & (buf[p+2]>="A") THEN          (* qAx *)
      qpos:=p+2;
      INC(p, 3);

    ELSE                                                                (* we skip any text *)
      LOOP
        c:=buf[p];
        IF c="-" THEN pssid:=p END;
        IF (c<=" ") OR (c=">") OR (c="*") OR (c=",") OR (c=":") THEN EXIT END;
        INC(p);
      END;
    END;

    IF pssid=0 THEN pssid:=p END;
    IF (buf[p]="*") & withstar THEN INC(p) END;
    RETURN 0
  END callchk;

  PROCEDURE Iconstruct;
  VAR i,j,k:CARDINAL;
  BEGIN
    IF (p<=4) OR (buf[p-2]<>"I") THEN RETURN END;       (* ,CALL,I: *)
    i:=p-4;
    WHILE buf[i]<>"," DO                                (* hop back call *)  
      IF i=0 THEN RETURN END;

      DEC(i);
    END;
    k:=i;                                               (* "," before call *)
    INC(i);
    j:=0;
    WHILE (j<=HIGH(logcall)) & (logcall[j]<>0C) DO
      IF logcall[j]<>buf[i] THEN RETURN END;

      INC(i);
      INC(j);
    END;                                                (* logcall = call,I *)
    pins:=k;
    i:=p-1;
    p:=k+1;                                             (* payload *)
    LOOP
      buf[k]:=buf[i];
      IF (i>=HIGH(buf)) OR (buf[i]=0C) THEN EXIT END;

      INC(k);
      INC(i);
    END;                                                (* delete ,call,I *)
    qtext:=",qAR,"; Append(qtext, logcall);             (* insert ,qAR,call *)
(*
OE0AAA-9>T8SV40,WIDE1-1,DB0WGS,I:test
OE0AAA-9>T8SV40,WIDE1-1:test
OE0AAA-9>T8SV40,WIDE1-1,qAR,DB0WGS:test 
*)

  END Iconstruct;

BEGIN
  hashl:=SET8{};
  hashh:=SET8{};
  hash2:=0;
  hash3:=0;
  p:=0;
  pins:=0;
  pssid:=0;                                            (* for savety *)
  len:=0;
  poscall.pos.lat:=0.0;
  poscall.pos.long:=0.0;
  WHILE (len<HIGH(buf)) & (buf[len]<>0C) & (buf[len]<>CR) DO INC(len) END;
  IF (len=0) OR (len+(SIZE(qtext)+3)>HIGH(buf)) THEN RETURN resLEN END;

  unset:=GFILTSET{};
  qpos:=0;
  LOOP                                                           (* thirdparty loop *)
    psum0:=p;
    IF callchk(FALSE, rfcallchk & (udpchan<>0) OR callsrc)<>0 THEN RETURN resSRCCAL END;  (* src call *)

    IF buf[p]<>">" THEN RETURN resSRCCAL END;

    i:=0; 
    WHILE (i<HIGH(poscall.call)) & (i<p) DO poscall.call[i]:=buf[i]; INC(i) END;
    poscall.call[i]:=0C;    

    INC(p);
    micedest:=p;  
    IF callchk(FALSE, FALSE)<>0 THEN RETURN resDESTCAL END;                    (* dest call *)

    psum1:=pssid;
    WHILE buf[p]="," DO
      INC(p);
      IF callchk(TRUE, FALSE)<>0 THEN RETURN resVIACAL END;                   (* via calls *)
    END;
    IF buf[p]<>":" THEN RETURN resVIACAL END;

    IF pins=0 THEN pins:=p END;
    INC(p);
    IF buf[p]<>cTHIRDPARTY THEN EXIT END;

    INC(p);
  END;
  
  IF p>=len THEN RETURN resLEN END; 

  qtext[0]:=0C;
  IF qpos>0 THEN                                                              (* qA *)
    IF CAP(buf[qpos])="X" THEN RETURN resQAZ                                  (* qAZ *) 
    ELSIF CAP(buf[qpos])="I" THEN Append(qtext, ","); Append(qtext, servercall) END;  (* qAI *)
  ELSE
    IF udpchan<>0 THEN
      Append(qtext, ",");
      IF txenabled THEN Append(qtext, qau) ELSE Append(qtext, "qAO") END;
      Append(qtext, ",");
      Append(qtext, servercall);
    ELSIF logcall[0]<>0C THEN
      IF cmpfrom(buf, 0, logcall) THEN qtext:=",qAC," ELSE qtext:=",qAS," END;
      Append(qtext, servercall);
      Iconstruct;
    END;
  END;

(*
IO.WrStr(" <");FOR i:=0 TO Length(buf)-1 DO IO.WrHex(ORD(buf[i]),3) END;
IO.WrStr("> "); IO.WrLn; IO.WrCard(pins, 10); IO.WrCard(p, 10); IO.WrLn;
*)           
  payload:=p;
  poscall.typ:=buf[p];
  IF buf[p]="?" THEN RETURN resQUERY END;

  IF (udpchan<>0) OR passvalid THEN
    Getmsg(buf, udpchan, unset*msgfilt=GFILTSET{}, ungat);
    IF ungat THEN RETURN resUNGATE END;

  END;
<*IF SONDE THEN*>
  IF heardtimeobj>0 THEN AddObject(buf, udpchan) END; 
<*END*>
  IF unset*datafilt<>GFILTSET{} THEN RETURN resUNGATE END;

  IF nogatebadvia & (udpchan<>0) & NOT pathchk(buf) THEN RETURN resBADPATH END;

-- make 2 hash values of dupe relevant bytes
  FOR i:=psum0 TO psum1-1 DO HashCh(buf[i]); END;
  WHILE (p<len) & (buf[p]<>15C) & (buf[p]<>12C) DO HashCh(buf[p]); INC(p) END;
  ha:=(ORD(CAST(CHAR, hashl)) + ORD(CAST(CHAR, hashh))*256) MOD HASHSIZE;
  hf:=VAL(CARD16,hash2) + VAL(CARD16,hash3)*256;            (* 2nd hash is fletcher sum *)
  WITH timehash[ha] DO
    IF htime+dupetime>systime THEN
      IF hsum=hf THEN RETURN resDUP END;                    (* a duplicate, else a hash collision *)

    END;
    IF (udpchan<>0) OR passvalid THEN                       (* a unvalid frame will not dupe a valid *)
      htime:=systime;
      hsum:=hf;
    END;
  END;

  GetPos(poscall.pos, vspeed, vcourse, valt, vsym, vsymt, buf, micedest, payload, com, postyp); 
  IF (udpchan=0) & NOT passvalid THEN RETURN resNOPASS END;
  
  buf[p]:=15C; INC(p);
  buf[p]:=12C; INC(p);
  buf[p]:=0C;  INC(p);

  ilen:=Length(qtext);
  IF ilen>0 THEN
    WHILE p>pins DO DEC(p); buf[p+ilen]:=buf[p] END;
    i:=0;

    WHILE i<ilen DO buf[p]:=qtext[i]; INC(p); INC(i) END;
  END;
  RETURN resOK
END AprsIs;

PROCEDURE GetFilters(VAR filters:FILTERS; s-:ARRAY OF CHAR; p:CARDINAL; pongto:pTCPSOCK);

  PROCEDURE getfix(VAR x:REAL; mul:REAL):BOOLEAN;
  VAR i:CARDINAL;
      h:FRAMEBUF;
  BEGIN
    IF s[p]="/" THEN 
      INC(p);
      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
(*
IO.WrFixed(x, 4,10); IO.WrStr("   fix<"); IO.WrStr(h); IO.WrStrLn(">");
*)
        x:=x*mul;
        RETURN TRUE
      END;
    END;
    RETURN FALSE
  END getfix;

  PROCEDURE getcalls(VAR table:ARRAY OF MONCALL);
  VAR i,j:CARDINAL;
  BEGIN
    INC(p);
    j:=0;
    WHILE s[p]="/" DO
      INC(p);
      i:=0;
      WHILE (p<=HIGH(s)) & (s[p]>" ") & (s[p]<>"/") DO
        IF (j<=HIGH(table)) & (i<=HIGH(table[0])) THEN
          table[j][i]:=s[p];
          IF table[j][i]="|" THEN table[j][i]:="/" END;     (* make | to / *)
        END;
        INC(p);
        INC(i);
      END;
      IF i<HIGH(table[0]) THEN table[j][i]:=0C END;
      INC(j);
    END;
  END getcalls;

  PROCEDURE gettyps(VAR t:ARRAY OF CHAR);
  TYPE CHSET=SET OF [0C..177C];
  VAR i,j:CARDINAL;
  BEGIN
    INC(p);
    j:=0;
    t[0]:=0C;
    IF s[p]="/" THEN
      INC(p);
      WHILE (j<HIGH(t)) & (p<=HIGH(s)) & (s[p]>" ") DO
        IF (s[p] IN CHSET{"3","p","o","i","m","q","s","t","u","n","w"}) & (InStr(t, s[p])<0) THEN
          t[j]:=s[p];
          t[j+1]:=0C;        
          INC(j);
        END;
        INC(p);
      END;
    END;
  END gettyps;

VAR not:BOOLEAN;
    pongstr:FRAMEBUF;

BEGIN
  skipblank(s,p);
  IF cmpfrom(s, p, "filter") THEN 
    INC(p,6);
    not:=FALSE;
    filters.typ:=0C;                                       (* re-init if new filter comes *)
    FILL(ADR(filters.viacalls), 0C, SIZE(filters.viacalls));
    FILL(ADR(filters.entrycalls), 0C, SIZE(filters.entrycalls));
    FILL(ADR(filters.prefixes), 0C, SIZE(filters.prefixes));
    FILL(ADR(filters.bud), 0C, SIZE(filters.bud));
    FILL(ADR(filters.objects), 0C, SIZE(filters.objects));
    FILL(ADR(filters.typs), 0C, SIZE(filters.typs));
    FILL(ADR(filters.destcalls), 0C, SIZE(filters.destcalls));
    FILL(ADR(filters.msgs), 0C, SIZE(filters.msgs));
    FILL(ADR(filters.q), 0C, SIZE(filters.q));
    FILL(ADR(filters.symbols), 0C, SIZE(filters.symbols));

    IF s[p]=" " THEN
      skipblank(s,p);
      WHILE s[p]>=" " DO
        IF s[p]=" " THEN not:=FALSE END;
        skipblank(s,p);
        IF s[p]="m" THEN
          INC(p);
          IF getfix(filters.radius, 1.0) THEN filters.typ:="m" ELSE RETURN END;

        ELSIF s[p]="r" THEN
          INC(p);
          IF NOT getfix(filters.base.lat, RAD) THEN RETURN END;
          IF NOT getfix(filters.base.long, RAD) THEN RETURN END;
          IF NOT getfix(filters.radius, 1.0) THEN RETURN END;
          IF NOT posvalid(filters.base) THEN RETURN END;
          filters.typ:="r";

        ELSIF s[p]="a" THEN
          INC(p);
          IF NOT getfix(filters.base.lat, RAD) THEN RETURN END;
          IF NOT getfix(filters.base.long, RAD) THEN RETURN END;
          IF NOT getfix(filters.edge.lat, RAD) THEN RETURN END;
          IF NOT getfix(filters.edge.long, RAD) THEN RETURN END;
          IF NOT posvalid(filters.base) THEN RETURN END;
          IF NOT posvalid(filters.edge) THEN RETURN END;
          filters.typ:="a";

        ELSIF s[p]="d" THEN
          getcalls(filters.viacalls);
          filters.notvia:=not;

        ELSIF s[p]="e" THEN
          getcalls(filters.entrycalls);
          filters.notentry:=not;

        ELSIF s[p]="u" THEN
          getcalls(filters.destcalls);
          filters.notdestcall:=not;

        ELSIF s[p]="p" THEN
          getcalls(filters.prefixes);
          filters.notprefix:=not;

        ELSIF s[p]="b" THEN
          getcalls(filters.bud);
          filters.notbud:=not;

        ELSIF s[p]="o" THEN
          getcalls(filters.objects);
          filters.notobject:=not;

        ELSIF s[p]="g" THEN
          getcalls(filters.msgs);
          filters.notmsgs:=not;

        ELSIF s[p]="q" THEN
          getcalls(filters.q);
          filters.notq:=not;
          filters.q[1]:="";                    (* only 1 word *)

        ELSIF s[p]="s" THEN
          WITH filters DO
            getcalls(symbols);
            notsymbols:=not;
            IF (symbols[0][0]=0C) & ((symbols[1][0]<>0C) OR (symbols[2][0]<>0C)) THEN symbols[0][0]:=" " END;
--            IF (symbols[1][0]=0C) & (symbols[2][0]<>0C) THEN symbols[1][0]:=" " END;
            symbols[3]:="";              (* only 3 words *)
          END;

        ELSIF s[p]="t" THEN
          gettyps(filters.typs);
          filters.nottyps:=not;

        ELSIF s[p]="-" THEN
          not:=TRUE;
          INC(p);

        ELSE RETURN END;
      END;
    END;

  ELSIF (pongto<>NIL) & cmpfrom(s, p, "ping ") THEN
    Assign(pongstr, s);
    pongstr[p+1]:="o";                    (* ping -> pong *)
    WHILE (p<HIGH(pongstr)+2) & (pongstr[p]>=" ") DO INC(p) END;
    pongstr[p]:=CR;
    pongstr[p+1]:=LF;
    pongstr[p+2]:=0C;
    Sendtcp(pongto, pongstr);
    IF maxpongtime>0 THEN
      IF pongto^.pongtime+maxpongtime>systime THEN pongto^.pingout:=FALSE END; (* pingintervall ok *)
      pongto^.pongtime:=systime+maxpongtime;
    END;
  END;
END GetFilters;

PROCEDURE saypongout(pt:pTCPSOCK);
VAR s, h:FRAMEBUF;
BEGIN
  s:="# ping timeout ";
  IntToStr(systime+maxpongtime-pt^.pongtime, 0, h);
  Append(s,h);
  Append(s, "s - data forwarding stopped"+CR+LF+0C);
  Sendtcp(pt, s); 
END saypongout;


PROCEDURE Auth(mbuf-:ARRAY OF CHAR; pu:pTCPSOCK):BOOLEAN;
VAR i,j,vport:CARDINAL;
    h, h1:FRAMEBUF;
    pmh:pHEARD;
BEGIN
  WITH pu^ DO
    i:=0;
    WHILE mbuf[i]<=" " DO INC(i) END;
    IF mbuf[i]="#" THEN
      GetFilters(filters, mbuf, i+1, NIL);
      RETURN TRUE

    END;
    IF mbuf[i]<>"u" THEN RETURN FALSE END;                   (* quick test *)

    IF cmpfrom(mbuf,i,"user ") THEN
      INC(i,5);
      skipblank(mbuf,i);
      j:=0;
      WHILE (j<HIGH(user.call)) & (mbuf[i]>" ") DO user.call[j]:=CAP(mbuf[i]); INC(i); INC(j); END;
      user.call[j]:=0C;

      skipblank(mbuf,i);

      IF cmpfrom(mbuf,i,"pass ") THEN
        INC(i,5);
        skipblank(mbuf,i);
        j:=0;
        WHILE (mbuf[i]>="0") & (mbuf[i]<="9") & (j<32768) DO 
          j:=j*10+ORD(mbuf[i])-ORD("0"); 
          INC(i); 
        END;
        passvalid:=(Length(user.call)>=3) & (j=call2pass(user.call));

        skipblank(mbuf,i);
      END;

      IF cmpfrom(mbuf,i,"vers ") THEN
        INC(i,5);
        skipblank(mbuf,i);
        j:=0;
        WHILE (mbuf[i]>=" ") & NOT cmpfrom(mbuf, i, "filter") DO
          IF j<HIGH(vers) THEN vers[j]:=mbuf[i]; INC(j) END; 
          INC(i);
        END;
        WHILE (j>0) & (vers[j-1]=" ") DO DEC(j) END;
        vers[j]:=0C;
      END;

      GetFilters(filters, mbuf, i, NIL);

      pmh:=heardtcp;
      IF NOT posvalid(user.pos) & (FindUserHeard(pmh, user.call, vport)>0) & (pmh<>NIL)
      THEN user.pos:=pmh^.position END;


      Assign(h, "# logresp ");  Append(h, user.call);
      IF passvalid THEN Append(h, " verified,") END;
      Append(h, " server "); Append(h, servercall);
      FiltToStr(filters, h1); 
      IF h1[0]<>0C THEN Append(h, " filter "); Append(h, h1) END;
      Assign(h1,h);
      IF vers[0]<>0C THEN Append(h1, " vers: "); Append(h1, vers); END;
      logline(resLOG, h1);

      Append(h, CR+LF);
      Sendtcp(pu, h);

    END;  
  END;
  RETURN TRUE
END Auth;


PROCEDURE closetcp(VAR w:pTCPSOCK; fin:BOOLEAN);
VAR pb:pWWWBUF;
BEGIN
  WITH w^ DO
    WHILE txbuf<>NIL DO
      pb:=txbuf;
      txbuf:=txbuf^.next;
      DEALLOCATE(pb, SIZE(pb^));
      IF NOT fin & (txbuf<>NIL) THEN RETURN END;

    END;
    IF fd>=0 THEN Close(fd) END;
    fd:=-1;
  END;
END closetcp;


PROCEDURE sendwww(VAR w:pTCPSOCK; VAR b:WWWB; len:INTEGER; push:BOOLEAN);
VAR pb, pp:pWWWBUF;
BEGIN
  IF len=0 THEN RETURN END;
  ALLOCATE(pb, SIZE(pb^));
  IF pb=NIL THEN RETURN END;

  pb^.buf:=b;
  pb^.tlen:=len;
  pb^.push:=push;
  pb^.next:=NIL;
  IF w^.txbuf=NIL THEN w^.txbuf:=pb
  ELSE
    pp:=w^.txbuf;
    WHILE pp^.next<>NIL DO pp:=pp^.next END;
    pp^.next:=pb;
  END;
END sendwww;


PROCEDURE Www(wsock:pTCPSOCK);
CONST RELURL="?reload=";

      sortTIME="t";
      sortCALL="c";
      sortPORT="p";
      sortHEARD="h";
      sortJUNK="j";
      sortDIST="d";
      sortALT="a";
      sortMHZ="m";
      sortUP="u";
      sortDOWN="d";
      sortTABLE="dvno";


VAR wbuf : WWWB;
    h1   : ARRAY[0..255] OF CHAR;
    fdw,
    res  : INTEGER;
    tt,ut: TIME;
    ss   : pTCPSOCK;
    us   : pUDPSOCK;
    flen,
    i    : CARDINAL;
    serverlink:ARRAY[0..1023] OF CHAR;


  PROCEDURE egmalt(a:INTEGER; pos-:POSITION; needegm:BOOLEAN):INTEGER;
  VAR ae:INTEGER;
      ok:BOOLEAN;
  BEGIN
<*IF SRTM THEN*>
    ok:=TRUE;
    ae:=0;
    IF needegm THEN ae:=VAL(INTEGER, egm96(pos, ok)) END;
    IF ok THEN RETURN a-ae ELSE RETURN -10000 END;

<*ELSE*>
    IF needegm THEN RETURN -10000 ELSE RETURN a END
<*END*>
  END egmalt;


<*IF SRTM THEN*>
  PROCEDURE og(a:INTEGER; pos-:POSITION; VAR s:ARRAY OF CHAR);
  VAR resolution, as:REAL;
  BEGIN
    s[0]:=0C;
    as:=getsrtm(pos, 1, resolution);
    IF (as<10000.0) & (as>-1000.0) THEN IntToStr(a-VAL(INTEGER, as), 1, s) END;
  END og;
<*END*>

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

  PROCEDURE escape(s-:ARRAY OF CHAR; VAR b:ARRAY OF CHAR);
  VAR i:CARDINAL;
      c:CHAR;
  BEGIN
    i:=0;
    b[0]:=0C;
    WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
      c:=s[i];
      IF (CAP(c)>="A") & (CAP(c)<="Z") OR (c>="0") & (c<="9") OR (c="-") THEN Append(b, c)
      ELSE Append(b, "%"); Append(b, hex(ORD(c) DIV 16)); Append(b, hex(ORD(c))) END;
      INC(i);
    END;
  END escape;

  PROCEDURE unhex(c:CHAR):INTEGER;
  BEGIN
    c:=CAP(c);
    IF (c>="0") & (c<="9") THEN RETURN ORD(c)-ORD("0")
    ELSIF (c>="A") & (c<="F") THEN RETURN ORD(c)-(ORD("A")-10)
    ELSE RETURN -1 END;
  END unhex;

  PROCEDURE deesc(s-:ARRAY OF CHAR; VAR b:ARRAY OF CHAR);
  VAR i, e:CARDINAL;
      c:CHAR;
      v, w:INTEGER;
  BEGIN
    i:=0;
    e:=0;
    b[0]:=0C;
    WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
      c:=s[i];
      IF e=0 THEN
        IF c="%" THEN e:=1 END;
      ELSIF e=1 THEN v:=unhex(c); IF v>=0 THEN e:=2 ELSE e:=0 END;
      ELSIF e=2 THEN
        w:=unhex(c); IF w>=0 THEN c:=CHR(v*16+w) END;
        e:=0;
      END;
      IF e=0 THEN Append(b, c) END;
      INC(i);
    END;
  END deesc;


  PROCEDURE Appwww(s-:ARRAY OF CHAR);
  VAR wlen, slen, i:CARDINAL;
  BEGIN
    wlen:=Length(wbuf);
    slen:=Length(s);
    i:=0;
    WHILE i<slen DO 
      IF wlen>=HIGH(wbuf) THEN 
        sendwww(wsock, wbuf, wlen, FALSE);
        wlen:=0;
      END; 
      wbuf[wlen]:=s[i];
      INC(i);
      INC(wlen);
    END;
    wbuf[wlen]:=0C;
  END Appwww;


  PROCEDURE AppCall(c:ARRAY OF CHAR; ungate,center:BOOLEAN; link-:ARRAY OF CHAR);
  VAR b:ARRAY[0..4095] OF CHAR;
      ce:ARRAY[0..100] OF CHAR;
      i, j, k:CARDINAL;
  BEGIN
    escape(c, ce);
    Appwww('<TD style=text-align:');
    IF center THEN Appwww('center>') ELSE Appwww('left>') END;
    j:=0;
    i:=0;
    WHILE link[i]>=" " DO
      IF link[i]="$" THEN
        INC(i);
        IF link[i]="c" THEN
          k:=0;
          WHILE (k<=HIGH(ce)) & (ce[k]<>0C) & (j<HIGH(b)) DO b[j]:=ce[k]; INC(j); INC(k) END;
        ELSIF link[i]="$" THEN
          b[j]:="$";
          IF j<HIGH(b) THEN INC(j) END;
        END;  
      ELSE
        b[j]:=link[i];
        IF j<HIGH(b) THEN INC(j) END;
      END;
      INC(i);   
    END;        
    b[j]:=0C;    

    IF b[0]<>0C THEN
      Appwww('<a href=');
      Appwww(b);
      Appwww('>');
    END;

    IF ungate THEN Appwww('#') END;
    Appwww(c);

    IF b[0]<>0C THEN Appwww('</a>') END;

    Appwww('</TD>');
  END AppCall;

  PROCEDURE AppMaplink(pos:POSITION; link-:ARRAY OF CHAR);
  VAR b:ARRAY[0..4095] OF CHAR;
      la,lo:ARRAY[0..100] OF CHAR;
      i, j, k:CARDINAL;
  BEGIN
    j:=0;
    i:=0;
    FixToStr(pos.long/RAD,6,lo);
    FixToStr(pos.lat/RAD,6,la);
    WHILE link[i]>=" " DO
      IF link[i]="$" THEN
        INC(i);
        IF link[i]="L" THEN
          k:=0;
          WHILE (lo[k]<>0C) & (j<HIGH(b)) DO b[j]:=lo[k]; INC(j); INC(k) END
        ELSIF link[i]="B" THEN
          k:=0;
          WHILE (la[k]<>0C) & (j<HIGH(b)) DO b[j]:=la[k]; INC(j); INC(k) END
        ELSIF link[i]="$" THEN
          b[j]:="$";
          IF j<HIGH(b) THEN INC(j) END;
        END;  
      ELSE
        b[j]:=link[i];
        IF j<HIGH(b) THEN INC(j) END;
      END;
      INC(i);   
    END;        
    b[j]:=0C;    

    IF b[0]<>0C THEN
      Appwww('<a href=');
      Appwww(b);
      Appwww('>');
    END;
    Appwww("[");Appwww(la); Appwww(","); Appwww(lo);Appwww("]");
    IF b[0]<>0C THEN Appwww('</a>') END;
  END AppMaplink;

  PROCEDURE AppTime(t:TIME; tab:BOOLEAN);
  VAR  h1:ARRAY[0..255] OF CHAR;
  BEGIN
    IF tab THEN Appwww("<td>") END;
    IF (systime<t) OR (t=0) THEN t:=0 ELSE t:=systime-t END;
    TimeToStr(t, h1);
    Appwww(h1);
    IF tab THEN Appwww("</td>") END;
  END AppTime;

  PROCEDURE AppMinSec(t:TIME);
  VAR  h1:ARRAY[0..20] OF CHAR;
  BEGIN
(*
    Appwww("<td>");
*)
    IF (systime<t) OR (t=0) THEN t:=0 ELSE t:=systime-t END;
    IF t DIV 3600>0 THEN
      IntToStr(t DIV 3600,1,h1);
      Appwww(h1); Appwww("h");
      t:=t MOD 3600;
    END;
    IF t DIV 60>0 THEN
      IntToStr(t DIV 60,1,h1);
      Appwww(h1); Appwww("m");
      t:=t MOD 60;
    END;
    IntToStr(t,1,h1);
    IF h1[1]=0C THEN Appwww("&nbsp;") END;
    Appwww(h1); Appwww("s");
(*
    Appwww("</td>");
*)
  END AppMinSec;

  PROCEDURE AppInt(n:INTEGER);
  VAR  h1:ARRAY[0..255] OF CHAR;
  BEGIN
    Appwww("<td>");
    IntToStr(n, 1, h1);
    Appwww(h1);
    Appwww("</td>");
  END AppInt;

  PROCEDURE AppTxt(style-, s-:ARRAY OF CHAR);
  VAR c:CHAR;
      i:INTEGER;
      h1:ARRAY[0..255] OF CHAR;
  BEGIN
    Appwww(style);
    FOR i:=0 TO VAL(INTEGER, Length(s))-1 DO
      c:=s[i];
      CASE c OF
        " ",".",",","0".."9","A".."Z","a".."z":Appwww(c);
       |0C..37C:;
      ELSE Appwww("&#"); IntToStr(ORD(c), 1, h1); Appwww(h1); Appwww(";"); END;
    END;
    Appwww('</td>');
  END AppTxt;

  PROCEDURE setcol(c, n:CARDINAL; VAR h1:ARRAY OF CHAR);
  BEGIN
    IF n>100 THEN n:=100 END;
    INC(n,155);
    h1[c]:=hex(n DIV 16);
    h1[c+1]:=hex(n MOD 16);
  END setcol;

  PROCEDURE redgreen(c:INTEGER; VAR h1:ARRAY OF CHAR);
  BEGIN
    IF c<0 THEN c:=0 END;
    IF c<100 THEN setcol(0, c, h1); setcol(2, 100, h1);
    ELSE
      IF c>200 THEN c:=200 END;
      setcol(0, 100, h1); setcol(2, 200-c, h1);
    END;
  END redgreen;

  PROCEDURE green(cnt:CARDINAL; maxt:TIME; driving:BOOLEAN; VAR h1:ARRAY OF CHAR);
  VAR t:TIME;
  BEGIN
    t:=systime-uptime;
    IF t>maxt THEN t:=maxt END;
    IF driving THEN cnt:=cnt*2000 ELSE cnt:=cnt*20000 END;
    redgreen(cnt DIV (t+300), h1);
  END green;

  PROCEDURE wcard64(hi, lo:CARDINAL);
  VAR h1:ARRAY[0..15] OF CHAR;
  BEGIN
    IF hi>0 THEN CardToStr(lo DIV 1024 + hi*4194304, 1, h1); Append(h1, "k");
    ELSE CardToStr(lo, 1, h1) END;
    Appwww('<TD style="text-align:right">');
    Appwww(h1);
    Appwww("</TD>");
  END wcard64;

  PROCEDURE wint(n:INTEGER);
  VAR h1:ARRAY[0..15] OF CHAR;
  BEGIN
    IntToStr(n,  1, h1);
    Appwww('<TD style="text-align:right">');
    Appwww(h1);
    Appwww("</TD>");
  END wint;

  PROCEDURE wintint(n, k:INTEGER);
  VAR h1:ARRAY[0..15] OF CHAR;
  BEGIN 
    IntToStr(n,  1, h1);
    Appwww('<TD style="text-align:right">'); 
    Appwww(h1);
    Appwww("<BR>");
    IntToStr(k,  1, h1);
    Appwww(h1);
    Appwww("</TD>");
  END wintint;

  PROCEDURE chkwwwfn(fn-:ARRAY OF CHAR):BOOLEAN;
  VAR i:CARDINAL;
  BEGIN
    IF (wwwdir[0]=0C) OR (fn[0]=DIRSEP) THEN RETURN FALSE END;

    i:=0;
    LOOP
      IF (i+2>=HIGH(fn)) OR (fn[i]=0C) THEN EXIT END;
      IF (fn[i]<=" ") OR (fn[i]>=200C) THEN RETURN FALSE END;
      IF (fn[i]=".") & (fn[i+1]=".") & (fn[i+2]=DIRSEP) THEN RETURN FALSE END;

      INC(i);
    END;
    RETURN TRUE
  END chkwwwfn;

  PROCEDURE openfile(fn:ARRAY OF CHAR; VAR fd:INTEGER; VAR flen:CARDINAL):BOOLEAN;
  VAR h:ARRAY[0..4096] OF CHAR;
      hh:ARRAY[0..1] OF CHAR;
(*
      s:stat_t;
*)
      i:CARDINAL;
  BEGIN
    i:=Length(fn);
    IF (i=0) OR (fn[i-1]=DIRSEP) OR NOT chkwwwfn(fn) THEN RETURN FALSE END;

    Assign(h, wwwdir);                                      (* wwwdir has trailing "/" *)
    Append(h, fn);
    fd:=OpenNONBLOCK(h);
    IF fd<0 THEN RETURN FALSE END;
--    IF (fd<0) OR (RdBin(fd,hh,1)<>1) THEN RETURN FALSE END; (* test read if regular file *)
   
--    Seek(fd, 0);
(*
    fstat(fd, s);
    IF CAST(BITSET, s.st_mode)*CAST(BITSET,170000B)<>CAST(BITSET,100000B) THEN RETURN FALSE END;
*)
    flen:=Size(fd);
    IF flen>=wwwsizelimit THEN RETURN FALSE END;

    RETURN TRUE
  END openfile;

  PROCEDURE strgt(a-, b-:ARRAY OF CHAR):BOOLEAN;
  VAR i:CARDINAL;
  BEGIN
    i:=0;
    REPEAT
      IF a[i]>b[i] THEN RETURN FALSE END;
      IF a[i]<b[i] THEN RETURN TRUE END;

      INC(i);
    UNTIL (i>HIGH(a)) OR (i>HIGH(b)) OR (a[i]=0C) OR (b[i]=0C);
    RETURN FALSE
  END strgt;


  PROCEDURE appsorturl(table:CARDINAL; s-:ARRAY OF CHAR);
  VAR h:ARRAY[0..1] OF CHAR;
      tab:CARDINAL;
  BEGIN
    FOR tab:=0 TO HIGH(wsock^.sortby) DO
      h[0]:=0C;
      IF (s[0]<>0C) & (tab=table) THEN h[0]:=s[0]; h[1]:=s[1];     (* modified sort *)
      ELSIF wsock^.sortby[tab][0]<>0C THEN          (* resend unmodified *)
        h[0]:=wsock^.sortby[tab][0];
        h[1]:=wsock^.sortby[tab][1];
      END;
      IF h[0]<>0C THEN                              (* append only active sort switches *)
        Appwww(SORTURL[tab]);
        Appwww(h);
      END;
    END;
  END appsorturl;

  PROCEDURE appreloadurl(t:CARDINAL);
  VAR h:ARRAY[0..31] OF CHAR;
  BEGIN
    IF t<>0 THEN
      Appwww(RELURL);
      IntToStr(t, 1, h);
      Appwww(h);
    END;
  END appreloadurl;

  PROCEDURE klick(path, text:ARRAY OF CHAR; table:CARDINAL; sort:CHAR; th:BOOLEAN);
  VAR s:ARRAY[0..1] OF CHAR;
  BEGIN 
    s[0]:=0C;
    IF sort<>0C THEN
      Assign(s, wsock^.sortby[table]);
      IF s[0]=sort THEN
        IF s[1]<>sortUP THEN s[1]:=sortUP ELSIF s[1]<>sortDOWN THEN s[1]:=sortDOWN END;
      ELSE s[0]:=sort; s[1]:=sortUP END;
    END;
    IF th THEN Appwww('<th>') END;
    Appwww('<a href="'); Appwww(path);
    appsorturl(table, s);
    appreloadurl(wsock^.reload);
    Appwww('">'); Appwww(text); Appwww('</a> ');
    IF th THEN Appwww('</th>') END;
  END klick; 

  PROCEDURE klickraw(path, text:ARRAY OF CHAR);
  BEGIN
    Appwww('<a href="'); Appwww(path);
    appreloadurl(wsock^.reload);
    Appwww('">'); Appwww(text); Appwww('</a>');
  END klickraw;


  PROCEDURE iconf(sym, symt:CHAR; VAR fn:ARRAY OF CHAR; VAR overlay:CHAR):BOOLEAN;
  VAR h:ARRAY[0..255] OF CHAR;
      i:CARDINAL;
  BEGIN
    i:=ORD(sym);
    IF (i<33) OR (i>127) THEN RETURN FALSE END;
    Assign(fn, ICONDIR+"/");
    IntToStr(i+(100-33), 3, h); 
    overlay:=0C;
    CASE symt OF
      "0".."9","A".."Z": h[0]:="2"; overlay:=symt;
     |"\": h[0]:="2";
     |"/":;
      ELSE RETURN FALSE;
    END;
    Append(fn, h); Append(fn, ".gif");
    Assign(h, wwwdir);
    Append(h, fn);
    RETURN Exists(h)
  END iconf;

  PROCEDURE sortindex(ph:pHEARD; maxtime:TIME; sortby-:ARRAY OF CHAR; VAR withqual:CARDINAL):CARDINAL; (* make LONGREAL of sort key *)
  VAR homevalid  :BOOLEAN;
      i, cj, cnt :CARDINAL;
      s, c       :CHAR;
      xs         :LONGREAL;

  BEGIN
    cnt:=0;
    withqual:=0;
    xs:=0.0;
    homevalid:=posvalid(home);
    s:=sortby[0];
    WHILE ph<>NIL DO
      CASE s OF
       sortTIME: xs:=xs+1.0;                              (* sort by time as it is *)

      |sortCALL:  xs:=0.0;                                (* sort by call *)
          FOR i:=0 TO HIGH(ph^.call) DO
            c:=ph^.call[i];
            xs:=xs*128.0+LFLOAT(ORD(c)); 
          END;

      |sortPORT:  xs:=LFLOAT(ph^.fromrx);                 (* sort by port *)

      |sortHEARD: xs:=LFLOAT(MHcount(ph, maxtime, cj));   (* sort by junk count *)

      |sortJUNK: i:=MHcount(ph, maxtime, cj);             (* sort by count *)
                 xs:=LFLOAT(cj);

      |sortDIST:                                          (* sort by km *)
          IF homevalid & posvalid(ph^.position) THEN xs:=distance(home, ph^.position);
          ELSE xs:=0.0 END;

      |sortALT: xs:=LFLOAT(ph^.altitude);                 (* sort by altitude *)

      |sortMHZ: xs:=LFLOAT(ph^.mhz);                      (* sort by freq *)

      ELSE END;

      IF sortby[1]="d" THEN ph^.sortval:=-xs ELSE ph^.sortval:=xs END;
      IF (withqual=0) & ((ph^.txd<>0) OR (ph^.level>MINLEVEL) OR (ph^.quali<>0)) THEN withqual:=3 END; (* modem infos *)
      IF ph^.snr>MIN(INT8) THEN withqual:=4 END;                                (* with snr field *)
      IF ABS(ph^.afc)<MAXAFC THEN withqual:=5 END;                              (* with afc field *)
      IF ph^.mhtime+maxtime>systime THEN INC(cnt) END;
      ph:=ph^.next;
    END;
    RETURN cnt
  END sortindex;


  PROCEDURE getlinkfile(VAR b:ARRAY OF CHAR; fn-:ARRAY OF CHAR);
  VAR fd, len:INTEGER;
  BEGIN
    Assign(b, wwwdir); Append(b, fn);
    fd:=OpenRead(b);
    b[0]:=0C;
    IF fd>=0 THEN
      len:=RdBin(fd, b, SIZE(b)-1);
      IF len<0 THEN len:=0 END;
      b[len]:=0C;
      Close(fd);
    END;
  END getlinkfile;


  PROCEDURE apppos(pos:POSITION; withloc:BOOLEAN);
  VAR h:ARRAY[0..31] OF CHAR;
  BEGIN
    IF posvalid(pos) THEN
      FixToStr(pos.lat/RAD,5,h);
      Appwww(" "); Appwww(h);
      FixToStr(pos.long/RAD,5,h);
      Appwww("/"); Appwww(h);
      IF withloc THEN postoloc(h, pos); Appwww(" "); Appwww(h) END;
    ELSE Appwww(' (NoPos)') END;
  END apppos;

  PROCEDURE altok(a:INTEGER):BOOLEAN;
  BEGIN RETURN (a>-10000) & (a<1000000) END altok;


  PROCEDURE appmhcnt(n:CARDINAL; maxtime:TIME; dir, net, obj, jnk, drive:BOOLEAN;
                     call:ARRAY OF CHAR; port:CARDINAL);
  VAR  h1, h2, h3,hc:ARRAY[0..31] OF CHAR;
       nc:CARDINAL;
  BEGIN
    nc:=n;
    IF jnk THEN nc:=nc*10 END;                                     (* more red if junk *)
    Appwww('<td style="background-color:#');
    h1:="80FF80"; green(nc, maxtime, drive, h1); Appwww(h1); Appwww('">');
    IntToStr(n, 1, h1);
    IF (rawlines=0) OR (n=0) THEN Appwww(h1);                      (* not a link *)
    ELSE 
      h2:="raw?";
      IF dir THEN Append(h2, "d");
      ELSIF net THEN Append(h2, "n")
      ELSIF obj THEN Append(h2, "o")
      ELSE Append(h2, "v") END;
      IF jnk THEN Append(h2, "j") ELSE Append(h2, "c") END;
      IntToStr(port, 1, h3);
      Append(h2, h3);
      Append(h2, "=");
      escape(call, hc);
      Append(h2, hc);
      klickraw(h2, h1);
    END;
    Appwww('</td>');
  END appmhcnt;

  PROCEDURE showmh(ph0:pHEARD; dir,net:BOOLEAN; maxtime:TIME; title:ARRAY OF CHAR;
                   sortby-:SORTBY);
  VAR withport,
      withicon   :BOOLEAN;
      table,
      withqual,
      ci, cj, cnt:CARDINAL;
      hch        :CHAR;
      ph, phs    :pHEARD;
      xs         :LONGREAL;
      as,
      resolution,
      ele, dist3 :REAL;
      haz, hele  :ARRAY[0..20] OF CHAR;
      callink    :ARRAY[0..1023] OF CHAR;
  BEGIN
    getlinkfile(callink, CALLINKFN);
    table:=TABVIA; IF net THEN table:=TABNET ELSIF dir THEN table:=TABDIR END;
    cnt:=sortindex(ph0, maxtime, sortby[table], withqual);

    withport:=(udpsocks<>NIL) & (udpsocks^.next<>NIL);
    Assign(h1, wwwdir); Append(h1, ICONDIR); withicon:=Exists(h1);    

    Appwww('<table id=mheard border=0 align=center CELLPADDING=3 CELLSPACING=1'
          +' BGCOLOR=#FFFFFF><tr class=tab-mh-titel BGCOLOR=#A9EEFF><th colspan=');
    IntToStr(8+ORD(withicon)+ORD(withport)+ORD(dir)*withqual+ORD(net)+ORD(srtmdir[0]<>0C)+ORD(dir)+ORD(dir & (homealt>-1000.0)), 1, h1); Appwww(h1);
    Appwww('>');
    CardToStr(cnt, 1, h1); Appwww(h1);
    Appwww(title);
    IF maxtime MOD 3600=0 THEN IntToStr(maxtime DIV 3600, 1, h1); Append(h1, "h");
    ELSE IntToStr(maxtime DIV 60, 1, h1); Append(h1, "min") END; 
    Appwww(h1);
--    Appwww('</th></tr><tr class=tab-mh-head BGCOLOR=#E0C080><th>Call</th>');

    Appwww('</th></tr><tr class=tab-mh-head BGCOLOR=#E0C080>');
    klick("mh", "Call", table, sortCALL, TRUE);

    IF withicon THEN Appwww('<th>Icon</th>') END;
--    IF withport THEN Appwww('<th>Port</th>') END;
    IF withport THEN klick("mh", "Port", table, sortPORT, TRUE) END;

    klick("mh", "Ago", table, sortTIME, TRUE);

    IF dir THEN
      IF withqual>0 THEN Appwww('<th>Txd</th><th>q&#37;</th><th>Lev</th>') END;
      IF withqual>=4 THEN Appwww('<th>SNR</th>') END;
      IF withqual=5 THEN Appwww('<th>AFC</th>') END;
    END;
    IF net THEN  Appwww('<th>Position</th>') END;
    klick("mh", "Pack", table, sortHEARD, TRUE);
    klick("mh", "Junk", table, sortJUNK, TRUE);
--    Appwww('</th><th>Junk</th><th>');
    klick("mh", "QRB km", table, sortDIST, TRUE);
    IF dir THEN Appwww('<th>Az</th>') END;
    IF dir & (homealt>-1000.0) THEN Appwww('<th>Ele</th>') END;
    klick("mh", "Alt", table, sortALT, TRUE);
--    Appwww('</th><th>Alt</th>');
    IF srtmdir[0]<>0C THEN Appwww('<th>OG</th>') END;
    Appwww('<th>Data</th><th>Path</th></tr>');

    LOOP
      phs:=ph0;
      xs:=MAX(LONGREAL);
      ph:=NIL;
      WHILE phs<>NIL DO
        IF phs^.sortval<xs THEN xs:=phs^.sortval; ph:=phs END;
        phs:=phs^.next;
      END;
      IF ph=NIL THEN EXIT END;
 
      ph^.sortval:=MAX(LONGREAL);
      IF ph^.mhtime+maxtime>systime THEN

        ci:=MHcount(ph, maxtime, cj);
        IF cj>ci THEN cj:=ci END; 
        Appwww('<tr style="background-color:#90FF90; text-align:right">');
        AppCall(ph^.call, ph^.ungate, FALSE, callink);
        IF withicon THEN
          Appwww('<td');
          IF iconf(ph^.sym, ph^.symt, h1, hch) THEN
            Appwww(' style="background-image:url('); Appwww(h1);
            Appwww('); background-repeat:no-repeat;background-position:center center;');
            IF hch<>0C THEN Appwww('text-align:center">'); Appwww(hch) ELSE Appwww('">') END;
          ELSE Appwww('>') END; 
          Appwww('</td>');
        END;

        IF withport THEN
          Appwww('<td>');
          getportname(ph^.fromrx, h1); Appwww(h1);
          Appwww('</td>');
        END;

        Appwww('<td>'); AppMinSec(ph^.mhtime); Appwww('</td>');
        IF dir & (withqual>0) THEN
-- txdel
          Appwww('<td style="background-color:#');
          h1:="80FF80"; 
          redgreen(VAL(INTEGER, ph^.txd)-50, h1);
          Appwww(h1); Appwww('">');
          IF ph^.txd<>0 THEN IntToStr(ph^.txd, 1, h1); Appwww(h1) END;
          Appwww('</td><td>');
--quality
          IF ph^.quali<>0 THEN IntToStr(ph^.quali, 1, h1); Appwww(h1) END;
-- level
          Appwww('</td><td style="background-color:#');
          h1:="80FF80";
          IF ph^.level>MINLEVEL THEN redgreen((VAL(INTEGER, Min(ABS(ph^.level+15),15))-5)*10, h1) END;
          Appwww(h1); Appwww('">');
          IF ph^.level>MINLEVEL THEN IntToStr(ph^.level, 1, h1); Appwww(h1) END;
          IF withqual>=4 THEN
--SNR
            Appwww('</td><td>');
            IF ph^.snr>MIN(INT8) THEN IntToStr(ph^.snr, 1, h1); Appwww(h1) END;
--AFC
            IF withqual=5 THEN
              Appwww('</td><td>');
              IF ABS(ph^.afc)<MAXAFC THEN IntToStr(ph^.afc, 1, h1); Appwww(h1) END;
            END;
          END;
          Appwww('</td>');
        END;

        IF net THEN Appwww('<td>'); apppos(ph^.position, FALSE); Appwww('</td>') END;
--pack count
        appmhcnt(ci-cj, maxtime, dir, net, FALSE, FALSE, ph^.datatyp=tSPEED, ph^.call, ph^.fromrx);
--Junk count
        appmhcnt(cj, maxtime, dir, net, FALSE, TRUE, FALSE, ph^.call, ph^.fromrx);
--dist
        h1[0]:=0C;
        haz[0]:=0C;
        hele[0]:=0C;
        IF posvalid(ph^.position) THEN
          IF posvalid(home) THEN
            FixToStr(distance(home, ph^.position)+0.05, 2, h1);
--az
            IntToStr(VAL(INTEGER, azimuth(home, ph^.position)+0.5), 1, haz); Append(haz, DEGSYM);
<*IF SRTM THEN*>
            IF altifromsrtm & NOT altok(ph^.altitude) & (srtmdir[0]<>0C) THEN
              as:=getsrtm(ph^.position, 1, resolution);
              IF (as<10000.0) & (as>-1000.0) THEN
                ph^.altitude:=TRUNC(as+0.5);
                ph^.altfromsrtm:=TRUE;
              END;
            END;
<*END*>
--ele
            IF (homealt>-1000.0) & altok(ph^.altitude) THEN                 (* elevation *)
              ele:=-100.0;
              elevation(ele, dist3, home, homealt, ph^.position, VAL(REAL, ph^.altitude));
              IF ABS(ele)<=90.0 THEN FixToStr(ele, 3, hele); Append(hele, DEGSYM) END;
            END;
          END;
        END;

        Appwww('<td>'); Appwww(h1); Appwww('</td><td>');
        IF dir THEN
          Appwww(haz); Appwww('</td><td>');
          IF homealt>-1000.0 THEN Appwww(hele); Appwww('</td><td>') END;
        END;
        IF altok(ph^.altitude) THEN IntToStr(ph^.altitude, 1, h1); Appwww(h1) END;
        Appwww('</td><td>'); 
<*IF SRTM THEN*>
        IF srtmdir[0]<>0C THEN
          IF altok(ph^.altitude) THEN
            IF ph^.altfromsrtm THEN Appwww("srtm");
            ELSE og(ph^.altitude, ph^.position, h1); Appwww(h1) END;
          END; 
          Appwww('</td><td>');
        END;
<*END*>
        IF ph^.datatyp=tCELSIUS THEN FixToStr(ph^.data, 2, h1); Append(h1, DEGSYM+"C");
        ELSIF ph^.datatyp=tSPEED THEN  FixToStr(ph^.data, 0, h1); Append(h1, "kmh");
        ELSE h1:="" END;
        Appwww(h1); 
        Appwww('</td>');

        AppTxt('<td style=text-align:left>', ph^.head);
        Appwww("</tr>"+CR+LF);
      END;
    END;
    Appwww("</table>&nbsp;");

  END showmh;

<*IF SONDE THEN*>
  PROCEDURE showobj(maxtime:TIME; sortby-:SORTBY);
  VAR 
      ph0        :pHEARD;
      withport,
      withicon   :BOOLEAN;
      withqual,
      ci, cj, cnt:CARDINAL;
      hch        :CHAR;
      ph, phs    :pHEARD;
      xs         :LONGREAL;
      ele, dist3 :REAL;
      truealt    :INTEGER;
      hlat, hlong, halt, hclb, hdir, hmhz, ha, hog, htd, haz, hele:ARRAY[0..20] OF CHAR;
      callink    :ARRAY[0..1023] OF CHAR;
  BEGIN
    getlinkfile(callink, OBJECTLINKFN);
    ph0:=heardobj;
    cnt:=sortindex(ph0, maxtime, sortby[TABOBJ], withqual);

    withport:=udpsocks<>NIL;
    Assign(h1, wwwdir); Append(h1, ICONDIR); withicon:=Exists(h1);    

    Appwww('<table id=mheard border=0 align=center CELLPADDING=3 CELLSPACING=1'
          +' BGCOLOR=#FFFFFF><tr class=tab-mh-titel BGCOLOR=#A9EEFF><th colspan=');
    IntToStr(14+ORD(withicon)+ORD(withport)+ORD(srtmdir[0]<>0C)+ORD(homealt>-1000.0), 1, h1); Appwww(h1);
    Appwww('>');
    CardToStr(cnt, 1, h1); Appwww(h1);
    Appwww(" Heard Objects Since Last ");
    IF maxtime MOD 3600=0 THEN IntToStr(maxtime DIV 3600, 1, h1); Append(h1, "h");
    ELSE IntToStr(maxtime DIV 60, 1, h1); Append(h1, "min") END; 
    Appwww(h1);

    Appwww('</th></tr><tr class=tab-mh-head BGCOLOR=#E0C080>');
    klick("mh", "Object", TABOBJ, sortCALL, TRUE);

    IF withicon THEN Appwww('<th>Icon</th>') END;
    IF withport THEN klick("mh", "Port", TABOBJ, sortPORT, TRUE) END;

    klick("mh", "Ago", TABOBJ, sortTIME, TRUE);
    klick("mh", "Pack", TABOBJ, sortHEARD, TRUE);
    klick("mh", "QRB km", TABOBJ, sortDIST, TRUE);
    Appwww('<th>Az</th>');
    IF homealt>-1000.0 THEN Appwww('<th>Ele</th>') END;
    Appwww('<th>Lat</th><th>Long</th>');
    klick("mh", "Alt", TABOBJ, sortALT, TRUE);
    IF srtmdir[0]<>0C THEN Appwww('<th>OG</th>') END;
    Appwww('<th>Clb</th><th>Dir</th>');
    klick("mh", "MHz", TABOBJ, sortMHZ, TRUE);
    Appwww('<th>dt</th><th>Data</th><th>Path</th></tr>');

    LOOP
      phs:=ph0;
      xs:=MAX(LONGREAL);
      ph:=NIL;
      WHILE phs<>NIL DO
        IF phs^.sortval<xs THEN xs:=phs^.sortval; ph:=phs END;
        phs:=phs^.next;
      END;
      IF ph=NIL THEN EXIT END;
 
      ph^.sortval:=MAX(LONGREAL);
      IF ph^.mhtime+maxtime>systime THEN

        ci:=MHcount(ph, maxtime, cj);
        IF cj>ci THEN cj:=ci END; 
        Appwww('<tr style="background-color:#90FF90; text-align:right">');
        IF ph^.clb<>0.0 THEN AppCall(ph^.call, ph^.ungate, FALSE, callink);  (* sonde/adsb *)  
        ELSE Appwww('<td>'); Appwww(ph^.call); Appwww('</td>'); END;         (* other object *)
        IF withicon THEN
          Appwww('<td');
          IF iconf(ph^.sym, ph^.symt, h1, hch) THEN
            Appwww(' style="background-image:url('); Appwww(h1);
            Appwww('); background-repeat:no-repeat;background-position:center center;');
            IF hch<>0C THEN Appwww('text-align:center">'); Appwww(hch) ELSE Appwww('">') END;
          ELSE Appwww('>') END; 
          Appwww('</td>');
        END;

        IF withport THEN
          Appwww('<td>');
          getportname(ph^.fromrx, h1); Appwww(h1);
          Appwww('</td>');
        END;

        Appwww('<td>'); AppMinSec(ph^.mhtime); Appwww('</td>');

--pack count
        appmhcnt(ci-cj, maxtime, FALSE, FALSE, TRUE, FALSE, ph^.datatyp=tSPEED, ph^.call, ph^.fromrx);
        hlat[0]:=0C;
        hlong[0]:=0C;
        halt[0]:=0C;
        hclb[0]:=0C;
        hdir[0]:=0C;
        hmhz[0]:=0C;
        hog[0]:=0C;
        htd[0]:=0C;
        h1[0]:=0C;
        haz[0]:=0C;
        hele[0]:=0C;
        IF posvalid(ph^.position) THEN
          FixToStr(ph^.position.lat*(1.0/RAD), 6, hlat);
          FixToStr(ph^.position.long*(1.0/RAD), 6, hlong);
          IF posvalid(home) THEN
          FixToStr(distance(home, ph^.position)+0.05, 2, h1);
            truealt:=-10000; 
            IF altok(ph^.altitude) THEN
              truealt:=egmalt(ph^.altitude, ph^.position, ph^.clb<>0.0);
            END;
            ele:=-100.0;
            IF (homealt>-1000.0) & altok(truealt) THEN                 (* elevation *)
              elevation(ele, dist3, home, homealt, ph^.position, VAL(REAL, truealt));
              FixToStr(dist3+0.005, 3, h1)
            ELSE FixToStr(distance(home, ph^.position)+0.05, 2, h1) END;
            IntToStr(VAL(INTEGER, azimuth(home, ph^.position)+0.5), 1, haz); Append(haz, DEGSYM);
            IF ABS(ele)<=90.0 THEN FixToStr(ele, 3, hele); Append(hele, DEGSYM) END;
            IF altok(truealt) THEN
              IntToStr(truealt, 1, halt);
              Append(halt, "m");
<*IF SRTM THEN*>
              IF srtmdir[0]<>0C THEN og(truealt, ph^.position, hog) END;
<*END*>
            END;

            IF ph^.clb<>0.0 THEN
              FixToStr(ph^.clb, 2, ha);
              IF ha[0]<>"-" THEN hclb:="+" END;
              Append(hclb, ha);
            END;
            IF ph^.dir>0 THEN IntToStr(ph^.dir, 1, hdir) END;
            IF ph^.objtimediff<DAYSEC THEN
              IF ABS(ph^.objtimediff)<1000 THEN IntToStr(ph^.objtimediff, 1, htd); Append(htd, "s");
              ELSE IntToStr(ph^.objtimediff DIV 60 , 1, htd); Append(htd, "m") END;
            END;
          END;
        END;
        IF ph^.mhz>0.0 THEN FixToStr(ph^.mhz+0.0005, 4, hmhz) END;

        Appwww('<td>'); Appwww(h1);
        Appwww('</td><td>'); Appwww(haz);
        IF homealt>-1000.0 THEN Appwww('</td><td>'); Appwww(hele) END;
        Appwww('</td><td>'); Appwww(hlat);
        Appwww('</td><td>'); Appwww(hlong);
        Appwww('</td><td>'); Appwww(halt);
        IF srtmdir[0]<>0C THEN Appwww('</td><td>'); Appwww(hog) END;

        Appwww('</td><td style="background-color:#');
        h1:="80FF80";
        redgreen(50-5*VAL(INTEGER, ph^.clb), h1);
        Appwww(h1); Appwww('">');
        Appwww(hclb);
        Appwww('</td><td>'); Appwww(hdir);
        Appwww('</td><td>'); Appwww(hmhz);
        Appwww('</td><td>'); Appwww(htd);
        Appwww('</td><td>');  
        IF ph^.datatyp=tCELSIUS THEN FixToStr(ph^.data, 2, h1); Append(h1, DEGSYM+"C");
        ELSIF ph^.datatyp=tSPEED THEN  FixToStr(ph^.data, 0, h1); Append(h1, "kmh");
        ELSE h1:="" END;
        Appwww(h1); 

        AppTxt('</td><td style=text-align:left>', ph^.head);
        Appwww("</tr>"+CR+LF);
      END;
    END;
    Appwww("</table>&nbsp;");

  END showobj;
<*END*>


  PROCEDURE listraw(s-:ARRAY OF CHAR);
  VAR ph         :pHEARD;
      pr         :pRAWTEXT;
      ju         :CARDINAL; 
      i, j, port :CARDINAL; 
      rawcall    :MONCALL;
      ch         :CHAR;
      dir,
      via,
      attr       :BOOLEAN;
      call, h    :ARRAY[0..4095] OF CHAR;
      maplink    :ARRAY[0..1023] OF CHAR;


    PROCEDURE ap(s-:ARRAY OF CHAR);
    VAR ii:CARDINAL;
    BEGIN
      ii:=0;
      WHILE (ii<=HIGH(s)) & (s[ii]<>0C) DO h[j]:=s[ii]; INC(j); INC(ii) END;
    END ap;

  BEGIN

    getlinkfile(maplink, MAPLINKFN);
    dir:=FALSE;
    via:=FALSE;
    IF InStr(s,"?d")=3 THEN ph:=hearddir; dir:=TRUE;
    ELSIF InStr(s,"?v")=3 THEN ph:=heardvia; via:=TRUE;
    ELSIF InStr(s,"?n")=3 THEN ph:=heardtcp;
<*IF SONDE THEN*>
    ELSIF InStr(s,"?o")=3 THEN ph:=heardobj;
<*END*>
    ELSE ph:=NIL END;
    ju:=ORD(s[5]="j");
    i:=6;
    port:=0;
    WHILE (s[i]>="0") & (s[i]<="9") DO port:=port*10+ORD(s[i])-ORD("0"); INC(i) END;
    call:="";
    IF s[i]="=" THEN
      INC(i);
      WHILE (i<=HIGH(s)) & (s[i]>=" ") & (NOT rfcallchk OR (s[i]>="0") & (s[i]<="9")
      OR (CAP(s[i])>="A") & (CAP(s[i])<="Z")
      OR (s[i]="^") OR (s[i]="-")
<*IF SONDE THEN*>
      OR (ph=heardobj)
<*END*>
      ) DO
        Append(call, s[i]);
        INC(i);
      END;
    END;

    Appwww('<title>');
    Appwww(call);
    Appwww('</title></head><body><div id="wrapper-junk">'+CR+LF);
    deesc(call, rawcall);
    WHILE ph<>NIL DO
      IF (ph^.fromrx=port) & ((rawcall[0]=0C) OR StrCmp(rawcall, ph^.call)) THEN
        pr:=ph^.rawtext[ju];
        WHILE pr<>NIL DO
          Appwww('<div class="junk-mh">');

          DateToStr(pr^.htime, h);
          h[4]:=h[5]; h[5]:=h[6]; h[6]:=h[8]; h[7]:=h[9];
          h[8]:=":";
          h[9]:=h[11]; h[10]:=h[12]; h[11]:=h[14]; h[12]:=h[15]; h[13]:=h[17]; h[14]:=h[18];
          h[15]:=" "; h[16]:=0C;
          Appwww('<span class="junk-ts">');
          Appwww(h);
          Appwww("</span>");
          i:=0;
          j:=0;
          LOOP
            ch:=pr^.text[i];
            IF ch=0C THEN EXIT END;


            IF ch="<" THEN    h[j]:="&"; INC(j); h[j]:="l"; INC(j); h[j]:="t"; INC(j); h[j]:=";"; INC(j); 
            ELSIF ch=">" THEN h[j]:="&"; INC(j); h[j]:="g"; INC(j); h[j]:="t"; INC(j); h[j]:=";"; INC(j); 
            ELSIF ch="&" THEN h[j]:="&"; INC(j); h[j]:="a"; INC(j); h[j]:="m"; INC(j); h[j]:="p"; INC(j); h[j]:=";"; INC(j); 
            ELSIF ch='"' THEN h[j]:="&"; INC(j); h[j]:="q"; INC(j); h[j]:="u"; INC(j); h[j]:="o"; INC(j); h[j]:="t"; INC(j); h[j]:=";"; INC(j); 
            ELSIF ch="'" THEN h[j]:="&"; INC(j); h[j]:="a"; INC(j); h[j]:="p"; INC(j); h[j]:="o"; INC(j); h[j]:="s"; INC(j); h[j]:=";"; INC(j); 
            ELSIF ch="/" THEN h[j]:="&"; INC(j); h[j]:="#"; INC(j); h[j]:="4"; INC(j); h[j]:="7"; INC(j); h[j]:=";"; INC(j); 
            ELSIF (ch<" ") OR (ch>=CHR(127)) THEN 
              ap('<span class="junk-bin">');
              h[j]:="&"; INC(j); h[j]:="l"; INC(j); h[j]:="t"; INC(j); h[j]:=";"; INC(j); 
              h[j]:=hex(ORD(ch) DIV 16); INC(j); h[j]:=hex(ORD(ch) MOD 16); INC(j);
              h[j]:="&"; INC(j); h[j]:="g"; INC(j); h[j]:="t"; INC(j); h[j]:=";"; INC(j);
              ap("</span>");
            ELSE h[j]:=ch; INC(j);  END;
            IF j>HIGH(h)-50 THEN
              h[j]:=0C;
              Appwww(h);
              j:=0;
            END;
            INC(i);
            IF i>HIGH(pr^.text) THEN EXIT END;
          END;
          IF j>0 THEN h[j]:=0C; Appwww(h); END;
          IF ju=1 THEN
            Appwww('<span class="junk-reason">&lt;');
            Appwww("no or invalid position");
            Appwww('&gt;</span>');
          ELSIF via & NOT pathchk(pr^.text) THEN
            Appwww('<span class="junk-reason">&lt;');
            Appwww("unknown call of transmitter");
            Appwww('&gt;</span>');
          END;
          attr:=TRUE;
          IF dir THEN
            IF pr^.txd>0 THEN
              IF attr THEN Appwww('<span class="junk-txd"> ('); attr:=FALSE ELSE Appwww(' ') END;
              Appwww('txd='); IntToStr(pr^.txd, 0, h); Appwww(h); Appwww('ms');
            END;
            IF pr^.quali>0 THEN
              IF attr THEN Appwww('<span class="junk-txd"> ('); attr:=FALSE ELSE Appwww(' ') END;
              Appwww('q=');
              IntToStr(pr^.quali, 0, h); Appwww(h);Appwww('%');
            END;
            IF pr^.snr>MIN(INT8) THEN
              IF attr THEN Appwww('<span class="junk-txd"> ('); attr:=FALSE ELSE Appwww(' ') END;
              Appwww('snr=');
              IntToStr(pr^.snr, 0, h); Appwww(h);Appwww('dB');
            END;
            IF ABS(pr^.afc)<MAXAFC THEN
              IF attr THEN Appwww('<span class="junk-txd"> ('); attr:=FALSE ELSE Appwww(' ') END;
              Appwww('afc=');
              IntToStr(pr^.afc, 0, h); Appwww(h);Appwww('Hz');
            END;
          END;
          IF posvalid(pr^.position) THEN
            IF posvalid(home) THEN
              IF attr THEN Appwww('<span class="junk-txd"> ('); attr:=FALSE ELSE Appwww(' ') END;
              FixToStr(distance(home, pr^.position)+0.05, 2, h); Appwww(h);Appwww('km');
            END;
            IF attr THEN Appwww('<span class="junk-txd"> ('); attr:=FALSE ELSE Appwww(' ') END;
            AppMaplink(pr^.position, maplink);
          END;
          IF NOT attr THEN Appwww(')</span>') END;
          Appwww("</div>"+CR+LF);
          pr:=pr^.next;
        END; 
      END;
      ph:=ph^.next;
    END;

    Appwww("</div></body></html>"+CR+LF);
  END listraw;


  PROCEDURE getreload(VAR s:ARRAY OF CHAR; VAR r:CARDINAL);
  VAR i,j,len:INTEGER;
      n:CARDINAL;
  BEGIN  
    n:=0;
    i:=InStr(s, RELURL);
    IF i>=0 THEN 
      len:=Length(s);
      j:=i;
      INC(i,Length(RELURL));
      WHILE (i<len) & (s[i]>="0") & (s[i]<="9") DO n:=n*10 + ORD(s[i])-ORD("0"); INC(i) END; 
      WHILE i<=len DO s[j]:=s[i]; INC(i); INC(j) END;      
    END;
    IF n>0 THEN r:=n END;
  END getreload;

  PROCEDURE getmh(VAR s:ARRAY OF CHAR; VAR sortby:SORTBY);
  VAR i,j,len,t:INTEGER;
  BEGIN
    FOR t:=0 TO HIGH(sortby) DO
      sortby[t][0]:=0C;
      sortby[t][1]:=0C;
      i:=InStr(s, SORTURL[t]);
      IF i>=0 THEN
        len:=Length(s);
        j:=i;
        INC(i,Length(SORTURL[t]));
        sortby[t][0]:=s[i]; INC(i);
        sortby[t][1]:=s[i]; INC(i);
        WHILE i<=len DO s[j]:=s[i]; INC(i); INC(j) END;
      END;
--WrStr(" <<<");WrStr(sortby[t]);WrStrLn(">>> ");
    END;
  END getmh;

  PROCEDURE appreload(t:CARDINAL);
  VAR h:ARRAY[0..31] OF CHAR;
  BEGIN
    IF t<>0 THEN
      Appwww('<meta http-equiv="refresh" content="');
      IntToStr(t*60, 1, h);
      Appwww(h);
      Appwww('">');
    END;
  END appreload;

  PROCEDURE reloadklick;
  VAR h1:ARRAY[0..15] OF CHAR; 
  BEGIN
(*
    Appwww('<form method="get">reload min:<input type="text" value="');
*)
    Appwww('Reload (min):<input type="text" value="');
    IntToStr(wsock^.reload, 1, h1); Appwww(h1); 
    Appwww('" name="reload" size="4" maxlength="3"><input type="submit" value="set reload time"/></form>');
  END reloadklick;

  PROCEDURE klicks(withindex:BOOLEAN);
  BEGIN
(*
    Appwww('<div style="text-align:center" class="nav">');
*)
    Appwww('<div style="text-align:center" class="nav"><form method="get">');

<*IF PROXY THEN*>
    klick("./"+CONNECTS, "CONNECTS", 0, 0C, FALSE);
<*ELSE*>
    klick(CONNECTS, "CONNECTS", 0, 0C, FALSE);
<*END*>
    klick("mh", "HEARD", 0, 0C, FALSE);
    IF withindex THEN klick(INDEXHTML, "INDEX", 0, 0C, FALSE);
    ELSE klick(INFOHTML, "INFO", 0, 0C, FALSE);
    END;
    reloadklick;
    Appwww('</div>');
  END klicks;

  PROCEDURE conthead(flen:INTEGER);
  VAR h:ARRAY[0..30] OF CHAR;
  BEGIN
    wbuf:='HTTP/1.0 200 OK'+CR+LF;
    IF flen>=0 THEN
      Appwww('Content-Length: ');
      IntToStr(flen, 1, h);
      Append(h, CR+LF+CR+LF);
      Appwww(h);
    ELSE
      Appwww('Content-Type: text/html; charset=iso-8859-1'+CR+LF+CR+LF
             +'<html><head><link href="style.css" rel="stylesheet" type="text/css"><meta charset="utf-8">');
      appreload(wsock^.reload);
    END;
(*
    IF ascii THEN Append(wbuf, STYLE+'</head><body>'+CR+LF);
    ELSE Append(wbuf, "<html><head>") END;
    appreload(wsock^.reload);
*)
  END conthead;


  PROCEDURE title(VAR cnt:CARDINAL; maintit:BOOLEAN; comment-, msgvia-:ARRAY OF CHAR);
  VAR h:ARRAY[0..31] OF CHAR;
  BEGIN
    INC(cnt);
    Appwww('<title>');
    Appwww(servercall);
    Appwww(comment);
    Appwww(' - dxlAPRS Toolchain</title></head>'+CR+LF
          +'<body><div style="text-align:center"><h3>'+CR+LF);
    IF maintit THEN
      IF servercall[0]<>0C THEN Appwww("Server "); Appwww(servercall) END;
      IF tcpbindport[0]<>0C THEN Appwww("  Port "); Appwww(tcpbindport) END;
      Appwww(" ["+VERS+"] Maxusers ");
      IntToStr(maxusers, 1, h); Appwww(h);
      Appwww(" http#");
    ELSE
      IF msgvia[0]<>0C THEN Appwww(" MsgCall "); Appwww(msgvia) ELSE Appwww(servercall) END;

      apppos(home, TRUE);
      IF homealt>-10000.0 THEN
        IntToStr(VAL(INTEGER, homealt), 1, h); Appwww(" "); Append(h, "m(NN)"); Appwww(h);
      END;
      Appwww(" ["+VERS+"] http#");
    END;
    IntToStr(cnt, 1, h);
    Appwww(h);
    Appwww(" Uptime "); AppTime(uptime, FALSE);
    IF rfcallchk THEN Appwww(" CallCheck On ") ELSE Appwww(" CallCheck Off "); END;
    IF nogatebadvia & maintit THEN
      Appwww("<BR>(only Frames with a Callsign of the sender in it will be gated)");
    END;
    Appwww("</h3></div>"+CR+LF);
  END title;

  PROCEDURE opendir(path-:ARRAY OF CHAR):BOOLEAN;
  CONST LTAB=10;                            (* file len columns *)
        DIRLIST=".dirlist";                 (* file to enable dirlist *) 

  TYPE FN=ARRAY[0..100] OF CHAR;
  VAR fn,
      parent,
      dir  :ARRAY[0..4096] OF CHAR;
      h    :ARRAY[0..1000] OF CHAR;
      big  :CHAR;
      fl,
      dn,
      i, j :CARDINAL;
      ii,
      fd   :INTEGER;
      isfile,
      isdir,
      done :BOOLEAN;
      pdir :DIRCONTEXT;
      pl   :FN;
      fns  :ARRAY[0..1000] OF FN;
  BEGIN
    IF NOT chkwwwfn(path) THEN RETURN FALSE END;

    Assign(dir, path);
    i:=Length(dir);
    IF (i>0) & (dir[i-1]=DIRSEP) THEN dir[i-1]:=0C END;  (* remove trailing "/" *)
    Assign(fn, wwwdir);   
    Append(fn, dir);
    Append(fn, DIRSEP+DIRLIST);
    IF NOT Exists(fn) THEN RETURN FALSE END;    (* dir has no file ".dirlist" *)

    Assign(fn, wwwdir);
    Append(fn, dir);
    IF OpenDir(fn, pdir)<0 THEN RETURN FALSE END;
 
    Append(dir, DIRSEP);
    dn:=0;
    LOOP
      ReadDirLine(fn, pdir);
      IF fn[0]=0C THEN EXIT END;

      IF fn[0]<>"." THEN                                         (* not "." ".." files *)
        Assign(fns[dn], fn);
        INC(dn);
        IF dn>HIGH(fns) THEN EXIT END;
      END;
    END;
    CloseDir(pdir);

--check parent dir
    Assign(parent, dir);
    ii:=VAL(INTEGER, Length(parent))-2;
    WHILE (ii>0) & (parent[ii]<>DIRSEP) DO DEC(ii) END;              (* go to parent dir *)
    IF ii>=0 THEN parent[ii]:=0C END;
    Assign(fn, wwwdir);
    Append(fn, parent);
    Append(fn, DIRSEP+DIRLIST);
    IF (parent[0]<>0C) & Exists(fn) & (dn<HIGH(fns)) THEN 
      fns[dn]:="";
      INC(dn);
    END; 

--sort files on name
    REPEAT       (* bubble sort *)
      i:=1;
      done:=TRUE;
      WHILE i<dn DO
        IF strgt(fns[i], fns[i-1]) THEN
          pl:=fns[i-1];
          fns[i-1]:=fns[i];
          fns[i]:=pl;
          done:=FALSE;
        END;
        INC(i);
      END;
    UNTIL done;

    conthead(-1);
    Appwww("<H2>Index of /");
    Appwww(dir);
    Appwww("</H2><pre>");

    j:=0;
    WHILE j<dn DO
      isfile:=FALSE;
      isdir:=FALSE; 
      h:="";
      big:=" ";
      IF fns[j]<>"" THEN
        Assign(fn, wwwdir);
        Append(fn, dir);
        Append(fn, fns[j]);
        fd:=OpenNONBLOCK(fn);
        IF fd>=0 THEN
          isfile:=TRUE;
          fl:=Size(fd);        
          Close(fd);
          IF fl<1000000 THEN
            CardToStr(fl, 1, h);
            Append(h, "B");
          ELSE
            FixToStr(FLOAT(fl)*0.000001, 3, h);
            Append(h, "M");
          END;
          IF fl>wwwsizelimit THEN big:="!" END;
        ELSE
          isdir:=OpenDir(fn, pdir)>=0;
          IF isdir THEN CloseDir(pdir) END;
          Append(fn, DIRSEP+DIRLIST);
          IF NOT Exists(fn) THEN isdir:=FALSE END;
          h:="dir";
        END; 
      ELSE
        isdir:=TRUE;
        h:="parent dir";
      END;
      IF isfile OR isdir THEN 
        fn:="                       ";
        i:=Length(h);
        IF i<=LTAB THEN fn[LTAB-i]:=0C END;
        Append(fn, h);
        Append(fn, big);
        Append(fn, '<A HREF="/');
        IF fns[j]="" THEN Append(fn, parent)
        ELSE 
          Append(fn, dir);
          Append(fn, fns[j]);
        END;
        IF isdir THEN Append(fn, DIRSEP) END;
        Append(fn, '">');
        IF fns[j]="" THEN Append(fn, parent) ELSE Append(fn, fns[j]) END;
        IF isdir THEN Append(fn, DIRSEP) END;
        Append(fn, '</A>'+CR+LF);
        Appwww(fn);
(*   3.3M  Nov 14 21:03  <A HREF="/tmp/20240815_161645.jpg">20240815_161645.jpg</A> *)
(*                  146B <A HREF="/icon/170.gif">170.gif</A> *)

      END;
      INC(j);
    END;


    RETURN TRUE
  END opendir;


VAR withindex:BOOLEAN;

BEGIN  (* Www *)
  res:=tcp.readsock(wsock^.fd, wbuf, SIZE(wbuf));
  i:=0;
  LOOP
    IF VAL(INTEGER,i)>=res THEN
      IF res<=0 THEN Close(wsock^.fd); wsock^.fd:=-1 END;
      RETURN
    END;

    WITH wsock^ DO
      get[wwwst]:=wbuf[i];    
      IF wwwst<HIGH(get) THEN INC(wwwst); 
      ELSE
        get[wwwst-4]:=get[wwwst-3];
        get[wwwst-3]:=get[wwwst-2];
        get[wwwst-2]:=get[wwwst-1];
        get[wwwst-1]:=get[wwwst];
      END;
      get[wwwst]:=0C;
(*
IO.WrCard(wwwst, 10); FOR tt:=0 TO wwwst DO IO.WrHex(ORD(get[tt]), 3); END; IO.WrLn;
*)
      IF (wwwst>=4) & (get[wwwst-4]=CR) & (get[wwwst-3]=LF) & (get[wwwst-2]=CR) 
      & (get[wwwst-1]=LF) & cmpfrom(get, 0, "GET /") THEN EXIT END;

      INC(i);
    END; 
  END;
  WITH wsock^ DO
    i:=5;
    WHILE (i<=HIGH(get)) & (get[i]>" ") DO get[i-5]:=get[i]; INC(i) END;
    get[i-5]:=0C;
    getreload(get, reload);
    getmh(get, sortby);
  END;

  Assign(h1, wwwdir);
  Append(h1, INDEXHTML);
  withindex:=Exists(h1);
  IF withindex & (wsock^.get[0]=0C) THEN Assign(wsock^.get, INDEXHTML) END; 

  IF (wsock^.get[0]=0C) OR StrCmp(wsock^.get, CONNECTS) THEN
--    INC(httpcount);
    conthead(-1);
    title(httpcount, TRUE, " Status Report", "");
(*
    IF QWatch.qsize>0 THEN
      Appwww(" txq ");
      IntToStr(QWatch.qsize, 1, h1); Appwww(h1); Appwww("s");
    END;
*)
    klicks(withindex);

(* udp ports*)
    Appwww('<table id=connections BORDER="0" CELLPADDING=3 CELLSPACING=1 BGCOLOR=#000000 align=center SUMMARY="Connection Table">'+CR+LF
      +'<TR class=tab-con-titel VALIGN="BASELINE" BGCOLOR="#A999CC">'
      +'<TH COLSPAN=14 style="text-align:center">Server Connections</TH></TR>'+CR+LF
      +'<TR class=tab-con-head BGCOLOR="#CCCCFF">'+CR+LF+'<TH>Dir</TH><TH>IPnum</TH><TH>Port</TH><TH>Call/Port</TH>'
      +'<TH>V</TH> <TH>Software</TH> <TH NOWRAP>Range Filter</TH>'
      +'<TH>TxByte</TH> <TH>TxFr</TH><TH NOWRAP>bit/s</TH>'
      +'<TH>RxByte</TH> <TH>RxFr</TH><TH NOWRAP>bit/s</TH><TH>Up</TH></TR>');

    us:=udpsocks;
    WHILE us<>NIL DO
      IF us^.txbytes>0 THEN
        showpip(us^.ip, 0, h1);
        Appwww('<TR class=tab-con-udp BGCOLOR=#E0E0F0 style="text-align:center">'+CR+LF+'<TD>udp</TD><TD>');
        Appwww(h1); Appwww("</TD>");
        wint(us^.dport); 
        Appwww('<TD style="text-align:left">T:'); 
        Appwww(us^.portname);
        Appwww("</TD><TD></TD><TD></TD>");
        IF (us^.torfradius>=1.0) OR (us^.maxbytes>0) THEN 
          Appwww("<td>");
          IF us^.torfradius>=1.0 THEN
            IntToStr(TRUNC(us^.torfradius), 1, h1);
            Appwww(h1); Appwww("km ");
          END;
          IF us^.maxbytes>0 THEN
            IntToStr(us^.maxbytes, 1, h1);
            Appwww(h1); Appwww("B/s");
          END;

          Appwww("</td>");
        ELSE Appwww("<TD></TD>") END;
        wint(us^.txbytes);
        wint(us^.txframes);
        IF uptime<systime THEN ut:=systime-uptime ELSE ut:=1 END;
        wint(us^.txbytes DIV (ut DIV 8+1));
        wint(0);
        wint(0);
        wint(0); Appwww("<TD>");
        TimeToStr(ut, h1); Appwww(h1);
        Appwww("</TD></TR>");  
      END;
      FOR i:=0 TO HIGH(us^.stat) DO
        WITH us^.stat[i] DO  
          IF utime+UDPSHOWTIME>systime THEN
            showpip(uip, 0, h1);
            Appwww('<TR class=tab-con-udp BGCOLOR=#E0E0F0 style="text-align:center">'+CR+LF+'<TD>udp</TD><TD>');
            Appwww(h1); Appwww("</TD>");
            wint(uport);
            Appwww('<TD style="text-align:left">R:');
            Appwww(us^.portname);
            Appwww("</TD><TD></TD><TD></TD><TD></TD>");
            wint(0);
            wint(0);
            IF dtime<systime THEN ut:=systime-dtime ELSE ut:=1 END;
            wint(0);
            wint(rxbytes);
            wint(rxframes);
            wint(rxbytes DIV (ut DIV 8+1)); Appwww("<TD>");
            TimeToStr(ut, h1); Appwww(h1);
            Appwww("</TD></TR>");  
          END;
        END;
      END; 
      us:=us^.next;
    END;

(* tcp ports *)
    getlinkfile(serverlink, SERVERLINKFN);
    ss:=tcpsocks;
    WHILE ss<>NIL DO
      WITH ss^ DO
        IF (service=cISSERVER) OR (service=cISGATEWAY) THEN
          IF (connt>0) & (connt<systime) THEN tt:=systime-connt ELSE tt:=1 END;
(*
          Appwww('<TR class=tab-con-tcp style="text-align:center" ');
*)
          IF service=cISSERVER THEN 
            Appwww('<TR class=tab-con-in style="text-align:center" BGCOLOR="#C0E0C0"><TD>in'); 
          ELSE 
            Appwww('<TR class=tab-con-out style="text-align:center" BGCOLOR="#D0C0C0"><TD>out');
          END; 
          Appwww('</TD>');
          IF serverlink[0]=0C THEN                                    (* make klickable link *) 
            Appwww('<TD style="text-align:center">'); Appwww(ipnum); Appwww('</TD>');
          ELSE AppCall(ipnum, FALSE, TRUE, serverlink) END;
          Appwww('<TD style="text-align:right">');
          IF service=cISSERVER THEN Appwww(tcpbindport) ELSE Appwww(port) END;
          Appwww('</TD><TD style="text-align:left">');
          Appwww(user.call);

          IF (service=cISGATEWAY) & (qwatch.qsize>0) THEN
            Appwww(" q=");
            IntToStr(qwatch.qsize, 1, h1); Appwww(h1); Appwww("s");

          END;
          Appwww("</TD><TD>");
          IF connt>0 THEN 
            IF passvalid THEN Appwww("v") END; 
            IF posvalid(user.pos) THEN Appwww("p") END;
          END; 
          Appwww("</TD><TD WIDTH=50>");
          Appwww(vers); Appwww('</TD><TD WIDTH=50>');
          IF service=cISSERVER THEN FiltToStr(filters, h1) ELSE Assign(h1, outfilterst) END;
          Appwww(h1); Appwww('</TD>');
          wcard64(txbytesh, txbytes);
          IF losttxframes>0 THEN wintint(txframes, -VAL(INTEGER, losttxframes));
          ELSE wint(txframes) END;
          wint(bitsec64(txbytesh, txbytes, tt));
          wcard64(rxbytesh, rxbytes);
          IF lostrxframes>0 THEN wintint(rxframes, -VAL(INTEGER, lostrxframes));
          ELSE wint(rxframes) END;
          wint(bitsec64(rxbytesh, rxbytes, tt)); Appwww("<TD>");
          IF connt>0 THEN TimeToStr(tt, h1); Appwww(h1) END; Appwww("</TD></TR>");
        END;
        ss:=next;
      END;
    END;


    Appwww('</table></body></html>'+CR+LF);


  ELSIF StrCmp(wsock^.get,"mh") THEN
    conthead(-1);
    title(mhhttpcount, FALSE, " MHeard", "");
    klicks(withindex);

    IF heardtimew>0
    THEN showmh(hearddir, TRUE, FALSE, heardtimew, " Heard Stations Since Last ", wsock^.sortby) END;
    IF (heardtimevia>0) & (heardvia<>NIL)
    THEN showmh(heardvia, FALSE, FALSE, heardtimevia, " Via RF Heard Stations Since Last ", wsock^.sortby) END;
    IF (heardtimetcp>0) & (heardtcp<>NIL)
    THEN showmh(heardtcp, FALSE, TRUE, heardtimetcp, " Via TCP Connected Stations Since Last ", wsock^.sortby) END;
<*IF SONDE THEN*>
    IF heardtimeobj>0 THEN showobj(heardtimeobj, wsock^.sortby) END;
<*END*>
    Appwww("</body></html>"+CR+LF);


  ELSIF InStr(wsock^.get,"raw")=0 THEN
    conthead(-1);
    listraw(wsock^.get);

  ELSIF openfile(wsock^.get, fdw, flen) THEN
    conthead(flen);
    sendwww(wsock, wbuf, Length(wbuf), TRUE);
    WHILE flen>0 DO
      res:=RdBin(fdw, wbuf, SIZE(wbuf));
      IF res>0 THEN sendwww(wsock, wbuf, res, FALSE); DEC(flen, res) ELSE flen:=0 END;
    END;
    Close(fdw); 
    wbuf[0]:=0C;

  ELSIF opendir(wsock^.get) THEN
     Appwww('</pre></body></html>'+CR+LF);

  ELSE wbuf:='HTTP/1.1 404'+CR+LF END;

  IF wbuf[0]<>0C THEN sendwww(wsock, wbuf, Length(wbuf), FALSE) END;
END Www;

PROCEDURE Wwwtx(VAR w:pTCPSOCK);
VAR len, i:INTEGER;
BEGIN
  WITH w^ DO
    IF txbuf<>NIL THEN
      IF txbuf^.push THEN len:=tcp.sendsock(fd, txbuf^.buf, txbuf^.tlen)
      ELSE len:=tcp.sendmore(fd, txbuf^.buf, txbuf^.tlen) END;
      IF len>0 THEN
        FOR i:=len TO txbuf^.tlen-1 DO txbuf^.buf[i-len]:=txbuf^.buf[i] END; (* delete the sent *)
        DEC(txbuf^.tlen, len);
        IF connt=0 THEN connt:=systime END;
      ELSE txbuf^.tlen:=0 END;                                 (* should not happen *)
      IF txbuf^.tlen<=0 THEN closetcp(w, FALSE) END;
    END;
  END;
END Wwwtx;


PROCEDURE saybusy(VAR fd:INTEGER; s:ARRAY OF CHAR);
VAR res:INTEGER;
BEGIN
  IF fd>=0 THEN
    res:=tcp.sendsock(fd, s, Length(s));
    Close(fd);
    fd:=-1;
  END;
END saybusy;


PROCEDURE KillDoubleUser(u:pTCPSOCK);
VAR v:pTCPSOCK;
BEGIN
  v:=u^.next;
  WHILE v<>NIL DO
    IF (v^.service=cISSERVER) & (v^.user.call[0]<>0C) 
    & StrCmp(u^.user.call, v^.user.call) THEN 
      IF v^.passvalid & NOT u^.passvalid THEN saybusy(u^.fd, "# unvalidated double login"+CR+LF);
      ELSE saybusy(v^.fd, "# double login"+CR+LF) END;        (* kill older or the unvalid *)
    END;
    v:=v^.next;
  END;
END KillDoubleUser;


PROCEDURE tcpconn(VAR sockchain:pTCPSOCK; f:INTEGER; cservice:CHAR):BOOLEAN;
VAR cp:pTCPSOCK;
    h,h1,h2:FRAMEBUF;
    res:INTEGER;
BEGIN

  IF f<0 THEN RETURN FALSE END;

  ALLOCATE(cp, SIZE(cp^));
  IF cp=NIL THEN
    Close(f);
    IF verb THEN WrStrLn("tcp conn out of memory") END;
    RETURN FALSE

  END;
  FILL(cp, 0C, SIZE(cp^));
  WITH cp^ DO
    fd:=f;
    passvalid:=cservice=cISGATEWAY;
    service:=cservice;
    res:=udp.socknonblock(f);
    txbuf:=NIL;
  END;
  cp^.next:=sockchain;
  sockchain:=cp;


  IF cservice=cISGATEWAY THEN

    res:=keepalive(f, TRUE, KEEPALIVE_IDLE_IS, KEEPALIVE_INTERVALL_IS, KEEPALIVE_COUNT_IS);

    IF servercall[0]<>0C THEN
      Assign(h, "user ");
      Append(h, servercall);
      IF passwd[0]<>0C THEN Append(h, " pass "); Append(h, passwd) END;
      Append(h, " vers ");
      Append(h, VERS);
      IF actfilter[0]<>0C THEN Append(h, " filter "); Append(h, actfilter) END;
      Append(h, ""+CR+LF);
      Sendtcp(cp, h);
    END;
(*
cp^.txbytes:=4294967200;
cp^.txbytesh:=0;
cp^.rxbytes:=4294965296;
cp^.rxbytesh:=0;
*)

  ELSIF cservice=cISSERVER THEN

    res:=keepalive(f, TRUE, KEEPALIVE_IDLE_USER, KEEPALIVE_INTERVALL_USER, KEEPALIVE_COUNT_USER);
    res:=SIZE(h1);
    res:=tcp.getpeeripnum(f, h1, res);
    IF res>=0 THEN
(*
          tcp.ipnum2str(h1, h, SIZE(h));
*)
      tcp.ipnumport2str(h1, SIZE(h1), h, SIZE(h), h2, SIZE(h2));

      Assign(cp^.ipnum, h);
      Assign(cp^.port, h2);
      h1:="T:connect to: "; Append(h1, h); Append(h1, " "); Append(h1, h2);
      logline(resLOG, h1);
    END;

    Assign(h,"# "+VERS+CR+LF);
    Sendtcp(cp, h);
  END;
  RETURN TRUE
END tcpconn;


PROCEDURE Gateconn(VAR cp:pTCPSOCK);
VAR fd:INTEGER;
    p, act, try, kill:pTCPSOCK;
    h:FRAMEBUF;
    hh:ARRAY[0..20] OF CHAR;
    max:CARDINAL;
BEGIN
  act:=NIL;
  try:=NIL;
  p:=cp;
  WHILE p<>NIL DO
    IF p^.service=cISGATEWAY THEN
      IF p^.connt>0 THEN                                            (* we have gate connect *)
        IF act<>NIL THEN                                            (* we have 2 connects *)
          IF act^.gatepri>p^.gatepri THEN (* stop second best *)
            kill:=act; 
            act:=p;
          ELSE kill:=p END;                                         (* stop second best *)
          saybusy(kill^.fd, "# remove double connect"+CR+LF)  
        ELSE act:=p END;
      ELSE try:=p END;                                              (* trying to connect *)
    END;
    p:=p^.next;
  END;
  IF try=NIL THEN
    IF (gatesfn[0]<>0C) & (act=NIL)
    & Watchclock(readurlfiletime, gateconndelay) THEN readurlsfile(gatesfn) END;
--  IF gatesfn[0]<>0C THEN readurlsfile(gatesfn) END;
    IF act=NIL THEN max:=HIGH(gateways) ELSE max:=act^.gatepri END; (* try only better *)
    IF (trygate>=max) OR (trygate>HIGH(gateways)) 
    OR (gateways[trygate].url[0]=0C) THEN trygate:=0 END;           (* loop thru table *) 

    IF lastdnstime>systime THEN lastdnstime:=systime END;
    IF (trygate<max) & Watchclock(gateways[trygate].connecttime, gateconndelay)
    & (lastdnstime+gateways[trygate].resolvtime*5<=systime) THEN
      WITH gateways[trygate] DO
        IF url[0]<>0C THEN

--check dns time 
          spintime;
          lastdnstime:=systime;
--WrStrLn("start resolve");
          fd:=tcp.connectto(url, port);
          spintime;
          resolvtime:=systime-lastdnstime;
          IF resolvtime>5 THEN 
            h:="T:slow DNS "; IntToStr(resolvtime, 1, hh); Append(h, hh); Append(h, "s");
            logline(resDELAY, h);
            IF resolvtime>300 THEN resolvtime:=120 END;
          END;          
--check dns time

          IF fd>=0 THEN
            IF filterst[0]<>0C THEN Assign(actfilter, filterst)
            ELSE Assign(actfilter, serverrangefilter) END;
            IF tcpconn(cp, fd, cISGATEWAY) THEN
              Assign(cp^.ipnum, url);
              Assign(cp^.port, port);
              Assign(cp^.outfilterst, filterst);
              cp^.gatepri:=trygate;
              h:="T:connect to: "; Append(h, url); Append(h, " "); Append(h, port);
              logline(resLOG, h);
            END;
          END; 
        END;
      END;
    END;
    INC(trygate);

  END;
END Gateconn;

PROCEDURE WatchTXQ(sock:pTCPSOCK);
VAR qb, acked, rb, i, j, sent:INTEGER;
    rest:BOOLEAN;
BEGIN
  qb:=tcp.getunack(sock^.fd);                               (* tcp unack sendqueue in byte *)
  sent:=sock^.txbytes-sock^.qwatch.lasttb;                  (* last second sent bytes *)
  IF (qb<=0) OR (sent<0) THEN sock^.qwatch.qsize:=0;        (* all ack  or error so stop tracing *)
  ELSE                                                      (* we have unack bytes *)
    acked:=sock^.qwatch.lastqb-qb+sent;                     (* acked bytes in last s *)
    j:=0;
    rest:=FALSE;
    FOR i:=0 TO sock^.qwatch.qsize-1 DO
      rb:=sock^.qwatch.txbyte[i]-acked;
      sock^.qwatch.txbyte[j]:=rb;
      IF rb>0 THEN rest:=TRUE ELSE acked:=-rb END;
      IF rest THEN
        acked:=0;
        INC(j);
      END;
    END;
    sock^.qwatch.qsize:=j;
    IF sock^.qwatch.qsize<=HIGH(sock^.qwatch.txbyte) THEN
      sock^.qwatch.txbyte[sock^.qwatch.qsize]:=sent;
      INC(sock^.qwatch.qsize);
      IF sock^.qwatch.qsize>qmaxtime THEN 
        tcp.stoptxrx(sock^.fd, 2);                          (* delete unsent data *)
        saybusy(sock^.fd, CR+LF);                           (* close tcp immediately *) 
        sock^.slowlink:=TRUE;                               (* for log message *)
      END;
    END;
  END;
  sock^.qwatch.lastqb:=qb;
  sock^.qwatch.lasttb:=sock^.txbytes;
END WatchTXQ;


VAR listensock,
    wwwsock               : INTEGER;
    mbuf                  : FRAMEBUF;
    res, i                : INTEGER;
    ires                  : RES;
    acttcp, acttmp        : pTCPSOCK;
    actudp                : pUDPSOCK;
    usercnt, lenh         : CARDINAL; 
    poscall               : POSCALL;
    voidungate,
    rfhered               : BOOLEAN;
    keepconn, lasttime    : TIME;

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;
  END;
END addsock;


PROCEDURE ["C"] readigatefile(signum:INTEGER);
BEGIN
  IF signum=SIGHUP THEN
    sighup:=TRUE;
    IF verb THEN WrStrLn("got SIGHUP") END;
(*
  ELSIF signum=SIGUSR1 THEN
    reconnsig:=TRUE;
    IF verb THEN WrStrLn("got SIGUSR1") END;
*)
  END;
END readigatefile;


BEGIN

  viacall[0]:=0C;
  nettorfpath[0]:=0C;
--  heardtime:=7200;
  heardtimew:=86400;
  heardtimevia:=1800;
  heardtimetcp:=86400;
  heardtimeobj:=0;
  gateconndelay:=GATECONNDELAY;
  objmhfromtcp:=FALSE;
  home.lat:=0.0;
  home.long:=0.0;
  homealt:=-10000.0;

  rfquiet:=10;
  maxatonce:=2;
  hearddir:=NIL;
  heardvia:=NIL;
  heardtcp:=NIL;
  heardobj:=NIL;
  mhfilelines:=0;
<* IF SRTM THEN *>
  srtmmaxmem:=500000;
<* END *>
  Gencrctab;
  FILL(ADR(gateways), 0C, SIZE(gateways));
  realtime:=0;
  systime:=946728000;                                        (* start of systime about 1.1.2000 *) 
  qmaxtime:=15;
  ungates[gUNGATE]:="";
  ungates[gRFONLY]:="RFONLY*";
  ungates[gNOGATE]:="NOGATE*";
  ungates[gTCPIP]:="TCPIP*";
  ungates[gTCPXX]:="TCPXX*";
  ungates[gQ]:="q*";
  dupetime:=60;
  lastdnstime:=0;
  netbeaconfn[0]:=0C;
  maxusers:=200;
  logframename[0]:=0C;
  rawlogname[0]:=0C;
  logframes:=6;  
  tcpbindport[0]:=0C;
  servercall[0]:=0C; 
  passwd[0]:=0C;
  serverrangefilter[0]:=0C;
  actfilter[0]:=0C;
  rfhered:=FALSE;
  wwwbindport:="";
  wwwdir[0]:=0C;
  srtmdir[0]:=0C;
  wwwsizelimit:=1024*1024*10;
  udpsocks:=NIL;
  callsrc:=FALSE;
  mhperport:=FALSE;
  sighup:=FALSE;
  nogatebadvia:=FALSE;
  qas:=0;
  qasc:=0;
  maxpongtime:=DEFAULTPONGTIME;
  gatesfn[0]:=0C;
  rawlines:=50;
  rfcallchk:=TRUE;
  altifromsrtm:=FALSE;
  SORTURL[TABDIR]:="?sort=";
  SORTURL[TABVIA]:="?sortv=";
  SORTURL[TABNET]:="?sortn=";
  SORTURL[TABOBJ]:="?sorto=";

  signal(SIGHUP, readigatefile);
--  signal(SIGUSR1, readigatefile);
  qau:="qAR";
  parms;

  IF StrCmp(viacall,"-") THEN viacall[0]:=0C
  ELSIF viacall[0]=0C THEN viacall:=servercall END;
  msghttpcount:=0;
  mhhttpcount:=0;
  netmhout:=0;
  netmhin:=0;

  Assign(ungates[MIN(GATEFILT)], servercall);
  uptime:=systime;
  udpdonetime:=systime;
  keepconn:=0;
  trygate:=0;
  httpcount:=0;

  Netbeacon(mbuf, FALSE, TRUE);
  listensock:=-1;
  wwwsock:=-1;
  tcpsocks:=NIL;

  LOOP
    spintime;
    IF systime<>lasttime THEN
      IF (listensock<0) & (tcpbindport[0]<>0C) THEN            (* open listensocket tcp connects *)
        listensock:=tcp.waitconnect(tcpbindport,APRSLISTENSOCKS);
        IF verb & (listensock<0) THEN WrStr(CANTBIND); WrStrLn(tcpbindport) END;  
      END;
      IF (wwwsock<0) & (wwwbindport[0]<>0C) THEN               (* open listensocket www connects *)
        wwwsock:=tcp.waitconnect(wwwbindport,WWWLISTENSOCKS);
--        IF (wwwsock>=0) & (tcp.sockreuse(wwwsock)<0) & verb THEN WrStr("cant set sockopts to port "); WrStrLn(wwwbindport) END;  
        IF verb & (wwwsock<0) THEN WrStr(CANTBIND); WrStrLn(wwwbindport) END;
      END;
    END;

    fdclr;

    actudp:=udpsocks;
    WHILE actudp<>NIL DO addsock(actudp^.fd, FALSE); actudp:=actudp^.next END;
    addsock(listensock, FALSE);
    addsock(wwwsock, FALSE);

    IF systime<>lasttime THEN                                (* once a second is enough *)  
      IF mhfilelines>0 THEN MHtoFile END;
      rfhered:=(keeptime=0) OR (keepconn>systime);
      acttcp:=tcpsocks;
      WHILE acttcp<>NIL DO
        WITH acttcp^ DO
          IF beacont<systime THEN Timebeacon(acttcp) END;

          IF service=cISGATEWAY THEN
            IF sighup THEN
              readurlsfile(gatesfn);
              saybusy(fd, CR+LF);
              sighup:=FALSE; 
            ELSIF (keeptime>0) & (keepconn<=systime) THEN saybusy(fd, "# timeout"+CR+LF);
            ELSIF qmaxtime>0 THEN WatchTXQ(acttcp) END;

          ELSIF service=cISWWW THEN
            IF connt=0 THEN connt:=systime
            ELSIF connt+HTTPTIMEOUT<systime THEN saybusy(fd, "timeout"+CR+LF) END;

          ELSIF service=cISSERVER THEN 
            KillDoubleUser(acttcp); 
            keepconn:=systime+keeptime;                          (* connect to gateway *)
          END;

          acttcp:=next;
        END; 
      END;
    END;
    IF systime<>lasttime THEN
      IF rfhered THEN Gateconn(tcpsocks) ELSE trygate:=0 END;
    END;
    lasttime:=systime;

    usercnt:=0;
    acttcp:=tcpsocks;
    WHILE acttcp<>NIL DO
      addsock(acttcp^.fd, (acttcp^.tlen>0) OR (acttcp^.txbuf<>NIL));
      INC(usercnt);
      acttcp:=acttcp^.next;
    END;
    mbuf[0]:=0C;
    REPEAT UNTIL selectrw(2, 0)>=0;
    IF (listensock>=0) & issetr(listensock) THEN
      res:=SIZE(mbuf);
      res:=tcp.acceptconnect(listensock, mbuf, res);
      IF res>=0 THEN 
        IF (usercnt>=maxusers) OR NOT tcpconn(tcpsocks, res, cISSERVER) 
        THEN saybusy(res, "# server full"+CR+LF) END;
      END;
    END;

    IF (wwwsock>=0) & issetr(wwwsock) THEN
      res:=SIZE(mbuf);
      res:=tcp.acceptconnect(wwwsock, mbuf, res);
      IF res>=0 THEN
        IF (usercnt>=maxusers+1) OR NOT tcpconn(tcpsocks, res, cISWWW) 
        THEN saybusy(res, "server full"+CR+LF) END;
      END;
    END;

    spintime;
    actudp:=udpsocks;
    i:=1; 
    WHILE actudp<>NIL DO
      IF issetr(actudp^.fd) THEN
        WHILE getudp(actudp, mbuf, actudp^.ghosts) DO
          IF systime<udpdonetime+MAXINTERNALDELAY THEN (* last time all data read is no too long *)
            ires:=AprsIs(mbuf, GFILTSET{gUNGATE, gRFONLY, gNOGATE, gTCPIP, gTCPXX, gQ},
                        GFILTSET{gUNGATE, gRFONLY, gNOGATE, gTCPIP, gTCPXX, gQ},
                        0C, i, actudp^.dport<>0, FALSE, poscall);
            IF ires<=resOK THEN
              Sendall(mbuf, 0, poscall); 
              keepconn:=systime+keeptime;                              (* connect to gateway *)
            END;
          ELSE                                                         (*task was blocked too long *)
            IF verb THEN WrStrLn("AXUDP-frames thrown away - too long program delay") END;
            logline(resDELAY, "Frame discarded - too long program delay");
            ires:=resDELAY;
          END;
          IF verb OR (logframes>1) THEN showframe(ires, NIL, actudp, mbuf, poscall.pos) END;
        END;
      END;
      INC(i);
      actudp:=actudp^.next;
    END;
    spintime;
    udpdonetime:=systime;                            (* store fresh time of last all read input *)

    acttcp:=tcpsocks;
    WHILE acttcp<>NIL DO  

      IF (acttcp^.fd>=0) & issetw(acttcp^.fd) THEN
        WITH acttcp^ DO
          IF service=cISWWW THEN Wwwtx(acttcp) 
          ELSE
            sendtcpbuf(acttcp);
            IF connt=0 THEN connt:=systime END;
          END;
        END;
      END;

      IF (acttcp^.fd>=0) & issetr(acttcp^.fd) THEN
        IF acttcp^.service=cISWWW THEN Www(acttcp); 
        ELSE
          LOOP
            res:=Gettcp(acttcp^.fd, mbuf, acttcp^.rbuf, acttcp^.rpos);
            IF res<0 THEN
              Close(acttcp^.fd);
              acttcp^.fd:=-1;
              EXIT
            END;
            IF res<=0 THEN EXIT END;

            INC(acttcp^.rxframes);
            lenh:=Length(mbuf);
            INC(acttcp^.rxbytes, lenh); IF acttcp^.rxbytes<lenh THEN INC(acttcp^.rxbytesh) END;

            IF (acttcp^.pongtime>0) & (acttcp^.service=cISSERVER) THEN (* pingpong active *)
              IF acttcp^.pongtime<systime THEN                         (* pinpong enabled - stop transfer *)
                saypongout(acttcp);
                acttcp^.pingout:=TRUE;
                INC(acttcp^.lostrxframes); 
              END;
            END;

            IF acttcp^.passvalid OR (acttcp^.service=cISGATEWAY) OR NOT Auth(mbuf, acttcp) THEN 
              IF mbuf[0]="#" THEN
                GetFilters(acttcp^.filters, mbuf, 1, acttcp);
                ires:=resFILT;
              ELSE ires:=AprsIs(mbuf, GFILTSET{gUNGATE, gRFONLY},
                               GFILTSET{gUNGATE, gRFONLY, gNOGATE, gTCPXX},
                               acttcp^.user.call, 0, TRUE, acttcp^.passvalid, poscall) END;
              IF (ires<=resNOPASS) & posvalid(poscall.pos) & StrCmp(poscall.call, acttcp^.user.call) 
              & (poscall.typ IN CHSET{34C,35C,"!","$","'","/","=","@","_",140C}) THEN 
                acttcp^.user.pos:=poscall.pos;
                IF heardtimetcp>MHSTEPS THEN
                  AddHeard(heardtcp, heardtimetcp, poscall.call, 0, mbuf, voidungate, FALSE, FALSE, FALSE); (* store pos in mh to remember pos at next connect *)
                END;
              END;

              IF acttcp^.passvalid & NOT acttcp^.pingout THEN
                IF ires<=resOK THEN Sendall(mbuf, acttcp^.fd, poscall) END;      
                IF verb OR (logframes>1) THEN showframe(ires, acttcp, NIL, mbuf, poscall.pos) END;
              END; 
            END;
          END;
        END; 
      END;

      IF acttcp^.fd<0 THEN                                                (* connection lost *)
        IF (acttcp^.connt<>0) & (acttcp^.service<>cISWWW) THEN showlogout(acttcp) END;

        closetcp(acttcp, TRUE);                                           (* free www buffers *)
        IF acttcp=tcpsocks THEN tcpsocks:=tcpsocks^.next;
        ELSE
          acttmp:=tcpsocks;
          WHILE acttmp^.next<>acttcp DO acttmp:=acttmp^.next END;
          acttmp^.next:=acttcp^.next;
        END;
        DEALLOCATE(acttcp, SIZE(acttcp^));
        acttcp:=tcpsocks;

      ELSE acttcp:=acttcp^.next END;  

    END;
  END;
END udpgate4.