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

(* (C)OE5DXL 1993-2017, GPL3 *)

MODULE l2cat;   (* layer2 to std in/out or start a task*)

FROM Execlogin IMPORT StartLogin, tEXEC;
(*
FROM mlib IMPORT tcsetattr, tcgetattr, tcflag_t, 
                 TCSAFLUSH, TIOCMGET, TIOCMBIS, TIOCMBIC, TCSANOW, ISIG,
                 CS8, CLOCAL, CREAD, CRTSCTS, B1200, B2400, 
                 B4800, B9600, B19200, B38400, B57600, B115200, B230400, 
                 B460800, TIOCM_CD, TIOCM_DTR, TIOCSCTTY;
*)
FROM SYSTEM IMPORT ADR, ADDRESS, CARD8, INT16, CARD16, FILL, MOVE, CAST;
FROM signal IMPORT signal, SIGCHLD, sighandler_t, SIGTERM, SIGINT, SIGPIPE;
FROM Select IMPORT selectrwt, fdclr, fdsetr, fdsetw, issetr, issetw;
FROM cleanup IMPORT cleanup;
FROM aprsstr IMPORT Assign, Length, StrToCard, CardToStr, Delstr, GetIp2, IntToStr,
             Append, AppCRC, TimeToStr;
FROM osi IMPORT WrStr, WrStrLn, WrInt, WrCard, WrHex, WrLn, File, SOCKET, InvalidFd,
                Close, RdBin, openudp, bindudp, ALLOCATE, DEALLOCATE, time, WrBin, NextArg,
                OpenRW, usleep, Werr, OpenWrite;
FROM l2 IMPORT L2Init, L2Lock, Connect, Disconnect, Circuit, GetAdress,
               GetChar, GetStr, SendStr, SendRaw, GetStat, PortStat, Parm,
               GetMon, pCONNECT, GETSTAT, GETADRESS, CONNECT, pSTRING, Layer2, CALLTYP,
               CONNTYP, PARMS, SENDUI, MYCALLS, PORTSTAT, PORTS, SET16, EVENT, pLINK,
               Getudp2info, dbuf, CALLBACKPROC, l2verb, dupchk;
FROM frameio IMPORT UDPSOCK, udpsocks;
FROM unistd IMPORT write;
FROM deflate IMPORT CONTEXT, XCONTEXT, Initexpand, Initdeflate, Deflatbyte, Expandbyte,
                    FLUSHEOF, FLUSHQUICK;


CONST MAXCMDWORDS=64;
      NL=12C;
      PPPFLAG=07eH; 
      PPPESC=07dH;
      LF=012C;
      LOOPTIME=10000;
      MINRECONTIME=2000000;
      MAXRECONTIME=120000000;
      RCTIMEBASE=1000;
      FLUSHDELAY=3;                             (* LOOPTIMES wait sending out rest of buffer *)
 
TYPE  BYTESET=SET OF [0..7];
      SET8=BYTESET;
      EVENTS=SET OF EVENT;
      IOBUF=ARRAY[0..255] OF CHAR;
      JUNKBUF=RECORD
        buf      :IOBUF;
        len,
        time     :INTEGER;
      END;
      DEFLATBUF=RECORD
        outbuf       :ARRAY[0..20000] OF CHAR;  (* 20000 *)
        outlen       :INTEGER;
        xoutbuf      :ARRAY[0..4095] OF CHAR;
        pppbuf       :ARRAY[0..4095] OF CHAR;
        ppplen,
        xoutlen      :INTEGER;
        inp, xinp    :INTEGER;
        pppstate     :CHAR;
        deflatcontext:CONTEXT;
        expandcontext:XCONTEXT;
        done,
        pppframing   :BOOLEAN;
      END; 


      pTASK=POINTER TO TASK;
      TASK=RECORD
        next   :pTASK;
        inbuf, outbuf:IOBUF;
        inlen, outlen:INTEGER;
        junkbuf      :JUNKBUF;
        l2addr :GETADRESS;
        link   :pLINK;
        events :EVENTS;
        infd,
        outfd  :File; 
        state  :CARD8;
        crlfmode,
        detectdone,
        inignor:CARDINAL;
        pcdeflat:POINTER TO DEFLATBUF;
      END;


VAR  
    terminate, keepconnected, verb, verb2, usedeflat, pppmode, autodet:BOOLEAN;
    tasks:pTASK;
    sockc, convlfcr, convtopipe, montyp, axudpchk:CARDINAL;
    recontime, minrecontime, maxrecontime:CARDINAL;
    timesum, pppdiscard:INTEGER;
    mycall:ARRAY[0..7*16] OF CHAR;
    cmdline, pipename:ARRAY[0..4095] OF CHAR;
    connectto:ARRAY[0..255] OF CHAR;    (* if active connect to this server *)
    parms:PARMS;
    numpar:ARRAY[0..255] OF RECORD port,parmnum,val: INTEGER END; 
    pmon:pLINK;

<*IF DDEBUG THEN*> 
deb:ARRAY[0..4095] OF CHAR;
deb1,deb2:CARDINAL;
debufd, debcfd:INTEGER;
<*END*>

PROCEDURE Error(text:ARRAY OF CHAR);
BEGIN
  Werr(text); Werr(" error abort"+NL);
  HALT
END Error;

PROCEDURE NextArgs(VAR s:ARRAY OF CHAR);

CONST QUOT='"';
      SEP=" ";
VAR h:ARRAY[0..65535] OF CHAR;
    l:INTEGER;
BEGIN
  s[0]:=0C;
  l:=0;
  REPEAT
    NextArg(h);
    IF l=0 THEN
      IF h[0]=QUOT THEN Delstr(h, 0, 1) ELSE Append(s, h); RETURN END;

    END;
    l:=Length(h);
    IF l=0 THEN RETURN END;

    IF h[l-1]=QUOT THEN
      Delstr(h, l-1, 1);
      l:=0;
    END;
    Append(s, SEP);
    Append(s, h);
  UNTIL l=0;
END NextArgs;


PROCEDURE ShowHex(b-:ARRAY OF CHAR; len:INTEGER);

  PROCEDURE hx(n:CARDINAL);
  BEGIN IF n<10 THEN Werr(CHR(n+ORD("0"))) ELSE Werr(CHR(n+(ORD("A")-10))) END; END hx;

VAR i:INTEGER;
BEGIN
  IF len>0 THEN
    WrLn; Werr("<");
    FOR i:=0 TO len-1 DO Werr(" "); hx(ORD(b[i]) DIV 16 MOD 16); hx(ORD(b[i]) MOD 16); END;
    Werr(">"+NL);
  END;
END ShowHex;

PROCEDURE Whex(hd:ARRAY OF CHAR; bu-:ARRAY OF CHAR; len:INTEGER);
VAR i:INTEGER;
    b:CARDINAL;
    c:CHAR;
BEGIN
  Werr(hd);
  FOR i:=0 TO len-1 DO
    b:=ORD(bu[i]) DIV 16;
    IF b>=10 THEN Werr(CHR(b+(ORD("A")-10))) ELSE Werr(CHR(b+ORD("0"))) END;
    b:=ORD(bu[i]) MOD 16;
    IF b>=10 THEN Werr(CHR(b+(ORD("A")-10))) ELSE Werr(CHR(b+ORD("0"))) END;
    IF i MOD 32=31 THEN Werr(NL) ELSE Werr(" ") END;
  END; 
  Werr(NL);
END Whex;


PROCEDURE CallStr(c:ARRAY OF CHAR; n:CARDINAL; withssid:BOOLEAN; VAR s:ARRAY OF CHAR);
VAR i, p:CARDINAL;
BEGIN
  n:=n*7;
  p:=0;
  FOR i:=0 TO 5 DO
    IF c[i+n]#" " THEN s[p]:=c[i+n]; INC(p) END;
  END;
  s[p]:=0C;
  IF withssid THEN
    i:=ORD(c[n+6]) MOD 16;
    IF i#0 THEN
      s[p]:="-";
      INC(p);
      IF i>=10 THEN s[p]:=CHR(i DIV 10 + ORD("0")); INC(p) END;
      s[p]:=CHR(i MOD 10 + ORD("0"));
      INC(p);
    END;
    s[p]:=0C;
  END;
END CallStr;

PROCEDURE WerrCall(task:pTASK);
VAR h:ARRAY[0..255] OF CHAR;
BEGIN
  IF verb & (task<>NIL) THEN
    CallStr(task^.l2addr.adress, 0, TRUE, h);
    Werr(h);
  END;
END WerrCall;

PROCEDURE GetCall(from-:ARRAY OF CHAR; VAR p:CARDINAL; to:pSTRING);
VAR i, len:CARD16;
BEGIN
  len:=Length(from);
  WHILE (p<len) & (from[p]<=" ") DO INC(p) END;
  FOR i:=0 TO 5 DO
    IF (p<len) & (from[p]<>"-") & (from[p]<>" ") THEN
      to^[i]:=CAP(from[p]);
      INC(p);
    ELSE to^[i]:=" " END;
  END;
  i:=0;
  IF from[p]="-" THEN
    INC(p);
    IF (from[p]>="0") & (from[p]<="9") THEN i:=ORD(from[p])-48; INC(p) END;
    IF (from[p]>="0") & (from[p]<="9") THEN i:=i*10+ORD(from[p])-48; INC(p) END;
  END;
  to^[6]:=CHR(i MOD 16+48);
END GetCall;

PROCEDURE Event(VAR atask:ADDRESS; link:pLINK; event:EVENT);
VAR i   : CARDINAL;
    gadr: GETADRESS;
    ntask:pTASK;
    connect:CONNECT;
    ptask:pTASK;
    h:ARRAY[0..255] OF CHAR;
BEGIN
  IF event=eCONNREQ THEN
    IF connectto[0]<>0C THEN   (* we are in outgoing connect *)
      IF verb THEN
        GetAdress(link, ADR(gadr));
        CallStr(gadr.adress, 0, TRUE, h);
        Werr(" connreq ");
        Werr(h);
        Werr(NL);
      END;

      RETURN

    END;

    ALLOCATE(ntask, SIZE(ntask^));
    IF ntask=NIL THEN RETURN END;

    FILL(ntask, 0C, SIZE(ntask^)); 
    ntask^.infd:=-1;
    ntask^.outfd:=-1;
    ntask^.link:=link;
    ntask^.state:=1;
    ntask^.crlfmode:=convlfcr;
    ntask^.detectdone:=ORD(autodet);
    GetAdress(link, ADR(ntask^.l2addr));
    IF ntask^.l2addr.my>0 THEN                     (* not via digiall *)
      FILL(ADR(connect), 0C, SIZE(connect));
      connect.port:=ntask^.l2addr.port;
      connect.baud:=1;
      connect.cpid:=0F0H;
      connect.l2adr:=ADR(ntask^.l2addr.adress);
      connect.typ:=cCONNAK;
      ntask^.link:=Connect(ntask, ADR(connect));
      ntask^.next:=tasks;
      tasks:=ntask;
      IF verb THEN
        WerrCall(ntask);
        Werr(" connreq"+NL);
      END;  
    ELSE
      DEALLOCATE(ntask, SIZE(ntask^));
      IF verb THEN
        Werr(" via"+NL);
      END;
    END;

  ELSIF event=eFLEXDATA THEN

    GetAdress(link, ADR(gadr));

--WrStr(gadr.adress);
--WrInt(dbuf^.len, 10);
--WrStrLn(" flexdata");
  
  ELSIF event=eCONNECTED THEN

    IF verb THEN  WerrCall(atask); Werr(" connected!"+NL) END;
    IF atask<>NIL THEN ptask:=atask; ptask^.state:=1 END;

--  ELSIF event=eDISCONNECTED THEN


  ELSIF atask<>NIL THEN
--WrInt(ORD(event), 1);WrStrLn(":host got event");
    ptask:=atask;  
    INCL(ptask^.events, event);
  END;
END Event;

PROCEDURE GetWord(VAR s, w:ARRAY OF CHAR);
VAR i, j:CARDINAL;
    e:CHAR;
BEGIN
  i:=0;
  j:=0;
  e:=" ";
  IF s[0]='"' THEN
    e:='"';
    s[0]:=" ";
    i:=1;
  END;

  LOOP
    IF (i>HIGH(s)) OR (s[i]=0C) THEN EXIT END;
    IF s[i]=e THEN s[i]:=" "; EXIT END;
    IF j<HIGH(w) THEN
      w[j]:=s[i];
      INC(j);
    END;
    s[i]:=" ";
    INC(i);
  END;
  w[j]:=0C;
END GetWord;


PROCEDURE taskparms(s:ARRAY OF CHAR; VAR argbuf:ARRAY OF CHAR; VAR argwords:ARRAY OF ADDRESS);
VAR argp, argc, i:CARDINAL;
    h:ARRAY[0..1023] OF CHAR;
BEGIN
  FILL(ADR(argwords), 0C, SIZE(argwords));
  argc:=0;
  argp:=0;
  LOOP
    WHILE s[0]=" " DO Delstr(s, 0, 1) END;
    GetWord(s, h);
--WrStrLn(h);
    h[HIGH(h)]:=0C;
    IF h[0]=0C THEN EXIT END;

    argwords[argc]:=ADR(argbuf[argp]);
    i:=0;
    LOOP
      IF argp>=HIGH(argbuf) THEN               (*argbuffer full*)
        argbuf[HIGH(argbuf)]:=0C;
Werr("ArgBuf full!"+NL);
        EXIT

      END;
      argbuf[argp]:=h[i];
      INC(argp);
      IF h[i]=0C THEN EXIT END;

      INC(i);
    END;
    INC(argc);
    IF argc>=HIGH(argwords) THEN EXIT END;
  END;
  argwords[argc]:=NIL;
END taskparms;

PROCEDURE Makros(c, a:ARRAY OF CHAR; VAR s:ARRAY OF CHAR);
CONST M="%";

VAR i:CARDINAL;
    h:ARRAY[0..15] OF CHAR; 
    m:BOOLEAN; 
BEGIN
  s[0]:=0C;
  i:=0;
  m:=FALSE;
  WHILE (i<=HIGH(c)) & (c[i]<>0C) DO
    IF m THEN
      IF c[i]=M THEN Append(s, M);
      ELSIF c[i]="m" THEN CallStr(a, 1, TRUE, h); Append(s, h);
      ELSIF c[i]="u" THEN CallStr(a, 0, TRUE, h); Append(s, h);
      ELSIF c[i]="U" THEN CallStr(a, 0, FALSE, h); Append(s, h);
      ELSE Append(s, M); Append(s, c[i]); END;
      m:=FALSE;
    ELSIF c[i]=M THEN m:=TRUE ELSE Append(s, c[i]) END;
    INC(i);
  END;
END Makros;


PROCEDURE Login(VAR fd:File; l2adr:ARRAY OF CHAR);
VAR cmdvec : tEXEC;
    argbuf, argstr:  ARRAY[0..8191] OF CHAR;
    argwords:ARRAY[0..MAXCMDWORDS] OF ADDRESS;
    p:POINTER TO ARRAY[0..1000] OF CHAR;
    ret:INTEGER;

BEGIN
--args:="/bin/login login";
 
  Makros(cmdline, l2adr, argstr);
  taskparms(argstr, argbuf, argwords);

--p:=argwords[0];WrLn;WrInt(CAST(CARDINAL, argwords[0]), 15);WrInt(CAST(CARDINAL, p), 15);WrLn;
--WrStrLn(p^);p:=argwords[1];WrStrLn(p^);WrStrLn(argbuf);

  fd:=-1; 
  cmdvec.cmdfn:=argwords[0];
  cmdvec.args:=ADR(argwords[1]);
  IF verb THEN Werr("start: "); Werr(cmdline); Werr(NL); END;
  IF cmdvec.cmdfn<>NIL THEN fd:=StartLogin(cmdvec) END;
(*
  IF fd>=0 THEN
    ret:=tcgetattr(fd, tio);
    tio.c_lflag:=CAST(tcflag_t, CAST(BITSET, tio.c_lflag) + CAST(BITSET, ISIG));
    ret:=tcsetattr (fd, TCSAFLUSH, tio);
  END;
*)
  IF (fd>=2) & (fd<=255) THEN 
    IF verb THEN
      Werr("login fd=");
      IntToStr(fd,1,argbuf);
      Werr(argbuf); Werr(NL);
    END;
  ELSE
    IF verb THEN Werr("login fd error"+NL); END;
    fd:=InvalidFd;
  END;
END Login;

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


PROCEDURE Parms;
VAR err:BOOLEAN;
    h,hh:ARRAY[0..1023] OF CHAR;
    VAR i,j,k,p,l2parcnt:CARDINAL;
BEGIN
  err:=FALSE;
  sockc:=0;
  FOR i:=0 TO HIGH(numpar) DO numpar[i].port:=0 END;
  l2parcnt:=0;
  LOOP
    NextArg(h);
    IF h[0]=0C THEN EXIT END;
    IF (h[0]="-") & (h[2]=0C) THEN

      IF h[1]="C" THEN                                (* -C ax25 destination *)
        NextArgs(h);
        i:=0;
        j:=0;
        WHILE (j<9*7) & (i<Length(h)) DO
          GetCall(h, i, ADR(connectto[j]));
          INC(j, 7);
          IF j=7 THEN j:=14 END;                      (* insert mycall here later *)
        END;
        connectto[j]:=0C;

      ELSIF h[1]="c" THEN                             (* -c comand line *)
        NextArgs(cmdline);
--        keepconnected:=TRUE;

      ELSIF h[1]="p" THEN                             (* -p pipe *)
        NextArg(pipename);

      ELSIF h[1]="i" THEN                             (* -i mycall *)
        NextArgs(h);
        j:=7;                                         (* first call is digi call, insert later *) 
        i:=0;
        REPEAT
          GetCall(h, i, ADR(mycall[j]));
          INC(j, 7);
        UNTIL (j>=HIGH(mycall)) OR (h[i]<>" ");          
        IF j<=HIGH(mycall) THEN mycall[j]:=0C END;
        FOR i:=0 TO 6 DO mycall[i]:=mycall[i+7] END;  (* first mycall is digi call*)

      ELSIF h[1]="j" THEN                             (* -j <num> convert cr lf to pipe *)
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, convtopipe) OR (convtopipe>6) THEN
          err:=TRUE;
          WrStrLn("-j <0..6>");
        END;

      ELSIF h[1]="m" THEN                             (* -j <num> convert cr lf to pipe *)
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, montyp) THEN
          err:=TRUE;
          WrStrLn("-m <0..1>");
        END;

      ELSIF h[1]="w" THEN                             (* -w <num> check axudp dupes *10ms *)
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, axudpchk) OR (axudpchk>31) THEN
          err:=TRUE;
          WrStrLn("-w <0..31>");
        END;

      ELSIF h[1]="D" THEN                             (* -D <n> discard frame len *)
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, j) THEN
          err:=TRUE;
          WrStrLn("-D <0..1500>");
        END;
        pppdiscard:=j;

      ELSIF h[1]="r" THEN                             (* -j <num> convert cr lf to pipe *)
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, j) OR (j>4000000) THEN
          err:=TRUE;
          WrStrLn("-r <ms> (max 4000000)");
        ELSE minrecontime:=j*RCTIMEBASE END;
        keepconnected:=TRUE;

      ELSIF h[1]="R" THEN                             (* -r <ms> min reconn time *)
        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, j) OR (j>4000000) THEN
          err:=TRUE;
          WrStrLn("-R <ms> (max 4000000)");
        ELSE maxrecontime:=j*RCTIMEBASE END;
        keepconnected:=TRUE;

      ELSIF h[1]="n" THEN                             (* -R <ms> max reconn time *)
        NextArg(h);
        IF h[0]="a" THEN p:=PORTS+1
        ELSE
          i:=0;
          IF NOT GetNum(h, 0C, i, p) OR (p>PORTS) THEN
            err:=TRUE;
            WrStrLn("-n <port> <parameter> <value>");
          END;
        END;

        NextArg(h);
        CASE h[0] OF
          "t": j:=17; (* txwait *)
         |"d": j:=20; (* dwait *)
         |"o": j:=23; (* maxframes *)
         |"f": j:=24; (* t1 *)
         |"F": j:=25; (* t3 *)
         |"I": j:=26; (* ipoll *)
         |"n": j:=27; (* retr *)
         |"h": j:=24; (* halfduplex *)
        ELSE
          i:=0;
          IF NOT GetNum(h, 0C, i, j) OR (j>HIGH(numpar)) THEN
            err:=TRUE;
            WrStrLn("-n <port> <parameter> <value>");
          END;
        END;

        NextArg(h);
        i:=0;
        IF NOT GetNum(h, 0C, i, k) THEN err:=TRUE; WrStrLn("-n <port> <parameter> <value>") END;
        IF NOT err THEN
          IF l2parcnt>HIGH(numpar) THEN Error("parameter table full") END;

          numpar[l2parcnt].port:=p;
          numpar[l2parcnt].parmnum:=j;
          numpar[l2parcnt].val:=k;
          INC(l2parcnt);
        END; 
      ELSIF h[1]="U" THEN
        NextArg(h);
        IF sockc>HIGH(udpsocks) THEN Error("too many ports") END;

        WITH udpsocks[sockc] DO
          IF GetIp2(h, ipnum, toport, fromport, checkip)<0
          THEN Error("-U wrong ip:port:port number") END;
          fd:=openudp();
          IF (fd<0) OR (bindudp(fd, fromport)<0) THEN
            h:="-U cannot open udp port ";
            IntToStr(fromport, 0, hh); Append(h, hh);
            Error(h);
          END;
        END;
        INC(sockc);

      ELSIF h[1]="a" THEN autodet:=TRUE;
      ELSIF h[1]="P" THEN pppmode:=TRUE; usedeflat:=TRUE;
      ELSIF h[1]="d" THEN usedeflat:=TRUE;
      ELSIF h[1]="v" THEN verb:=TRUE;
      ELSIF h[1]="V" THEN verb:=TRUE; verb2:=TRUE;
      ELSIF h[1]="l" THEN convlfcr:=1;                (* -l convert lf to cr *)  
      ELSIF h[1]="L" THEN convlfcr:=2;                (* -L strip lf *)

      ELSIF h[1]="h" THEN
        WrLn;
        WrStrLn(' -a                                autodetect deflate + ppp on first bytes');
        WrStrLn('                                     ppp + deflate:"!p",deflate;"!d"');
        WrStrLn('                                     LF to CR:"!l", strip LF:"!L", transparent:"!8"');
        WrStrLn(' -C <destination>                  slave connect destination -C "OE0AAA-12 OE5XBL"');
        WrStrLn('                                     if no "-C" run as server waiting for connect');
        WrStrLn(' -c <cmdline>                      execute command on connect -c "/bin/bash bash %m %u"');
        WrStrLn('                                     %m=mycall %u=usercall %U=same no SSID %%=%');
        WrStrLn('                                     if no "-c" data path is stdin/stdout');
        WrStrLn(' -D <bytes>                        discard longer ppp frames if pr tx buffer full');
        WrStrLn(' -d                                deflate on');
        WrStrLn(" -h                                this");
        WrStrLn(' -i <mycall> <mycall> ...          connectable calls -i "OE0AAA OE0AAA-15"');
        WrStrLn('                                     first mycall is digi and used to connect out');
        WrStrLn(' -j <1..6>                         1:del LF, 2:del LF+CR>LF, 3:CR>LF, 4:del CR');
        WrStrLn('                                     5:del CR+LF>CR, 6:LF>CR in stream from pr');
        WrStrLn(" -l                                convert LF to CR in stream to pr");
        WrStrLn(" -L                                strip LF in stream to pr");
        WrStrLn(' -m <0..2>                         ax25 Monitor to stderr (2 with info)');
        WrStrLn(' -n <port> <parm> <value>          layer 2 parms, "-n a" set on all ports');
        WrStrLn("                                     parm t:txwait d:dwait o:maxfr f:t1 F:t3");
        WrStrLn("                                     parm I:ipoll n:retr h:halfdup");
        WrStrLn(' -P                                ppp + deflate on');
        WrStrLn(' -p <filename>                     data to/from this device/pipe -p /dev/ttyS0');
        WrStrLn(' -R <ms>                           enable slave "keep connected" with max reconnet delay');
        WrStr  ('                                     (max 4000000ms) (');
        WrInt(maxrecontime DIV RCTIMEBASE, 1); WrStrLn(")");
        WrStrLn(' -r <ms>                           enable slave "keep connected" with min reconnet delay');
        WrStr  ('                                     and doubles delay each conn try till "-R"  (');
        WrInt(minrecontime DIV RCTIMEBASE, 1); WrStrLn(")");
        WrStrLn(" -U <x.x.x.x:destport:listenport>  axudp (autodetect axudp2)");
        WrStrLn("                                     listenport=0 uses a free port");
        WrStrLn("                                     repeat -U for more ports");
        WrStrLn(" -v                                verbous");
        WrStrLn(" -V                                more verbous");
        WrStrLn(" -w <n>                            check dupe axudp frames last n frames or n*10ms");
        WrLn;
        HALT

      ELSIF h[1]="-" THEN Error("- - ?");
      ELSIF h[1]=0C THEN Error("-  ?");

      ELSE err:=TRUE END;
    ELSE err:=TRUE END;
    IF err THEN EXIT END;
  END;
  IF err THEN Werr(">"); Werr(h); Werr("< use -h"+LF); HALT END;

  IF connectto[0]<>0C THEN           (* insert mycall as it is valid after whole cmd line *)
    IF mycall[7]=0C THEN Error("need -i <call> for -C ") END;

    MOVE(ADR(mycall[7]), ADR(connectto[7]), 7);
  ELSE keepconnected:=TRUE END;
  IF sockc=0 THEN Error("need at least one -U ...") END;

END Parms;


PROCEDURE Connectto;
VAR
    ntask:pTASK;
    connect:CONNECT;
BEGIN
  ALLOCATE(ntask, SIZE(ntask^));
  IF ntask=NIL THEN RETURN END;

  FILL(ntask, 0C, SIZE(ntask^));
  ntask^.infd:=-1;
  ntask^.outfd:=-1;
--  GetAdress(link, ADR(ntask^.l2addr));
  FILL(ADR(connect), 0C, SIZE(connect));
  connect.port:=1;
  connect.baud:=1;
  connect.cpid:=0F0H;
  connect.l2adr:=ADR(connectto);
  connect.l3adr:=NIL;
  connect.typ:=cNORMAL;
  ntask^.link:=Connect(ntask, ADR(connect));

  ntask^.state:=5;
  ntask^.next:=tasks;
  ntask^.crlfmode:=convlfcr;
  tasks:=ntask;
END Connectto;


PROCEDURE ["C"] killdisc(signum:INTEGER);
BEGIN
  IF verb THEN Werr("sigint"+NL) END;
--  IF (tasks<>NIL) & (tasks^.state=2) THEN WrStrLn("disc!"); Disconnect(tasks^.link, TRUE);
--  ELSE HALT(signum) END;
  IF terminate THEN HALT ELSE terminate:=TRUE END;

END killdisc;


PROCEDURE initcompress(pt:pTASK);
BEGIN
--IntToStr(SIZE(pt^.pcdeflat^), 1, deb); Werr(deb);Werr("=mem");
  ALLOCATE(pt^.pcdeflat, SIZE(pt^.pcdeflat^));
  IF pt^.pcdeflat=NIL THEN Error("alloc compres memory") END;

  Initdeflate(pt^.pcdeflat^.deflatcontext);
  Initexpand(pt^.pcdeflat^.expandcontext);
  pt^.pcdeflat^.outlen:=0;
  pt^.pcdeflat^.xoutlen:=0;
  pt^.pcdeflat^.inp:=0;
  pt^.pcdeflat^.xinp:=0;
  pt^.pcdeflat^.done:=FALSE;
  IF pppmode THEN       (* ppp per comand line *)
    pt^.pcdeflat^.pppframing:=TRUE;
    IF verb THEN Werr("init ppp + compression"+NL) END;
  ELSIF verb THEN Werr("init compression"+NL) END;
  pt^.pcdeflat^.pppstate:=0C;

END initcompress;


PROCEDURE pppcrc(VAR b:ARRAY OF CHAR; len:INTEGER):BOOLEAN;
VAR crc1, crc2:CHAR;
    ok:BOOLEAN; 
BEGIN
--ShowHex(b, len);
  IF len<2 THEN RETURN FALSE END;

  DEC(len, 2);
  crc1:=b[len];
  crc2:=b[len+1];
  AppCRC(b, len);
  ok:=(crc1=b[len]) & (crc2=b[len+1]);
  IF NOT ok THEN Werr(" crc-err "+NL); END;
  RETURN ok
END pppcrc;


PROCEDURE compress(pt:pTASK);
VAR i:INTEGER;
BEGIN
  WITH pt^ DO
    IF pcdeflat^.pppframing THEN
      LOOP
        IF pcdeflat^.inp>=inlen THEN    (* out of data *)
          pcdeflat^.inp:=0;
          inlen:=0;
          EXIT

        END;  
--IF verb2 THEN WrHex(ORD(inbuf[pcdeflat^.inp]), 3) END;
        IF (pcdeflat^.pppstate=0C) & (inbuf[pcdeflat^.inp]=CHR(PPPFLAG)) THEN   (* hunt mode *)
          pcdeflat^.pppstate:=1C;                                               (* in frame *)  
          pcdeflat^.ppplen:=0;
        ELSIF pcdeflat^.pppstate=1C THEN
          IF inbuf[pcdeflat^.inp]=CHR(PPPESC) THEN pcdeflat^.pppstate:=2C;  (* escaped char follows *)

          ELSIF inbuf[pcdeflat^.inp]=CHR(PPPFLAG) THEN                      (* frame complete *) 
            IF pcdeflat^.ppplen>0 THEN
              IF pppcrc(pcdeflat^.pppbuf, pcdeflat^.ppplen) THEN            (* frame good *)
--IntToStr(pcdeflat^.ppplen, 7, deb);Werr(deb);Werr("=c ");
                IF (pcdeflat^.ppplen<=pppdiscard) OR SendStr(link, 0, NIL) THEN
                  FOR i:=0 TO pcdeflat^.ppplen-1 DO
                    Deflatbyte(pcdeflat^.deflatcontext, pcdeflat^.pppbuf[i], 0C,
                    pcdeflat^.outbuf, pcdeflat^.outlen);
                  END;
                  Deflatbyte(pcdeflat^.deflatcontext, 0C, FLUSHEOF, pcdeflat^.outbuf, pcdeflat^.outlen);
                ELSIF verb THEN Werr("ppp frame discarded"+NL) END; 
              ELSE Werr("ppp frame crc error"+NL) END;
--IntToStr(pcdeflat^.outlen, 7, deb);Werr(deb);Werr("=co ");

              pcdeflat^.ppplen:=0;
            END;
            INC(pcdeflat^.inp);
            EXIT 

          ELSE 
            pcdeflat^.pppbuf[pcdeflat^.ppplen]:=inbuf[pcdeflat^.inp];
            IF pcdeflat^.ppplen<HIGH(pcdeflat^.pppbuf) THEN INC(pcdeflat^.ppplen) END;        
          END;
 
        ELSIF pcdeflat^.pppstate=2C THEN                                       (* stuffed byte *)
          pcdeflat^.pppbuf[pcdeflat^.ppplen]:=CAST(CHAR, CAST(SET8, inbuf[pcdeflat^.inp])/SET8{5});
          IF pcdeflat^.ppplen<HIGH(pcdeflat^.pppbuf) THEN INC(pcdeflat^.ppplen) END;
          pcdeflat^.pppstate:=1C;
        END;

        INC(pcdeflat^.inp);
      END;
    ELSE
      WHILE (pcdeflat^.inp<inlen) & (pcdeflat^.outlen<SIZE(pcdeflat^.outbuf)-16400) DO
        Deflatbyte(pcdeflat^.deflatcontext, inbuf[pcdeflat^.inp], 0C,
                   pcdeflat^.outbuf, pcdeflat^.outlen);
        INC(pcdeflat^.inp);
      END;
      IF pcdeflat^.inp>=inlen THEN             (* inbuffer empty so send compressed block *)
        Deflatbyte(pcdeflat^.deflatcontext, 0C, FLUSHEOF, pcdeflat^.outbuf, pcdeflat^.outlen);  (* flush *)
        pcdeflat^.inp:=0;
        inlen:=0;
      END;
    END; 
--ShowHex(pcdeflat^.outbuf, pcdeflat^.outlen); WrStrLn("");
  END;
END compress;

PROCEDURE expand(pt:pTASK);
VAR done:BOOLEAN;
    pb:ARRAY[0..3000] OF CHAR;
    i, j:INTEGER; 
BEGIN
  WITH pt^ DO
--ShowHex(outbuf, outlen);

    LOOP
--IF pcdeflat^.xoutlen>=SIZE(pcdeflat^.xoutbuf)-300 THEN Werr(" outfull ") END;
      IF (pcdeflat^.xinp>=outlen) OR (pcdeflat^.xoutlen>=SIZE(pcdeflat^.xoutbuf)-300)
      OR (pcdeflat^.xoutlen<0) THEN EXIT END;

--WrHex(ORD(outbuf[pcdeflat^.xinp]), 3);INC(deb1);
      Expandbyte(pcdeflat^.expandcontext, outbuf[pcdeflat^.xinp], 
                 pcdeflat^.xoutbuf, pcdeflat^.xoutlen, done);
--IF pcdeflat^.xoutlen<0 THEN Werr(" expand error"+NL) END;
--Werr("(");IntToStr(pcdeflat^.xoutlen, 1, deb);Werr(deb);Werr(")");

      INC(pcdeflat^.xinp);

      IF done & pcdeflat^.pppframing THEN                   (* rebuild ppp frame *)

--IntToStr(deb1, 7, deb);Werr(deb);Werr("=xi ");deb1:=0;
--IntToStr(pcdeflat^.xoutlen, 7, deb);Werr(deb);Werr("=x ");
--WrStrLn("done");ShowHex(pcdeflat^.xoutbuf, pcdeflat^.xoutlen);

        IF pppcrc(pcdeflat^.xoutbuf, pcdeflat^.xoutlen) THEN
--WrStrLn("");WrStr("Y:"); ShowHex(pcdeflat^.xoutbuf, pcdeflat^.xoutlen); WrStrLn("");
          pb[0]:=CHR(PPPFLAG);
          j:=1;
          FOR i:=0 TO pcdeflat^.xoutlen-1 DO  
            IF (pcdeflat^.xoutbuf[i]=CHR(PPPFLAG)) OR (pcdeflat^.xoutbuf[i]=CHR(PPPESC))
              OR (pcdeflat^.xoutbuf[i]<" ") THEN (* stuff *)
              pb[j]:=CHR(PPPESC);
              IF j<HIGH(pb) THEN INC(j) END;
              pb[j]:=CAST(CHAR, CAST(SET8, pcdeflat^.xoutbuf[i])/SET8{5});
            ELSE pb[j]:=pcdeflat^.xoutbuf[i] END;
            IF j<HIGH(pb) THEN INC(j) END;
          END;
          pb[j]:=CHR(PPPFLAG);  
          INC(j);
          i:=0;
          WHILE (i<HIGH(pcdeflat^.xoutbuf)) & (i<j) DO
            pcdeflat^.xoutbuf[i]:=pb[i];
            INC(i);
          END;
          pcdeflat^.xoutlen:=i;
          pcdeflat^.done:=TRUE;
--WrStrLn("");WrStr("X:"); ShowHex(pcdeflat^.xoutbuf, pcdeflat^.xoutlen); WrStrLn("");

          EXIT

        ELSE pcdeflat^.xoutlen:=-1 END;        (* crc error *)
      END;

    END;
    IF pcdeflat^.xinp>=outlen THEN             (* outbuffer empty *)
      pcdeflat^.xinp:=0;
      outlen:=0;
    END;
  END;
END expand;


PROCEDURE wrpipe(fd:File; VAR b:ARRAY OF CHAR; VAR blen:INTEGER);
VAR len, i:INTEGER;
BEGIN 

--WrStrLn("");WrStr("P:"); ShowHex(b, blen); WrStrLn("");

  len:=write(fd, b, blen);
  IF len>blen THEN len:=blen END;
  IF len>0 THEN
    DEC(blen, len);
    FOR i:=0 TO blen-1 DO b[i]:=b[i+len] END;
--    IF blen>0 THEN MOVE(ADR(b[len]), ADR(b), blen) END;
  END;
END wrpipe;


PROCEDURE sendjunk(link:pLINK; VAR junk:JUNKBUF);
BEGIN
  IF (junk.len=256) OR (junk.len>=0) & (junk.time<=0) THEN
    IF SendStr(link, junk.len, ADR(junk.buf)) THEN
<*IF DDEBUG THEN*>
--WrBin(debcfd, junk.buf, junk.len);
<*END*>
      junk.len:=0;
    END;
  END;
END sendjunk;


PROCEDURE wrl2(link:pLINK; VAR b:ARRAY OF CHAR; VAR blen:INTEGER; VAR junk:JUNKBUF);
VAR len, i, j:INTEGER;
BEGIN

--WrStr("L:"); WrInt(blen, 1); WrStr(" ");
  IF blen=0 THEN RETURN END;

  IF junk.len<256 THEN
    len:=0;
    WHILE (junk.len<256) & (len<blen) DO junk.buf[junk.len]:=b[len]; INC(junk.len); INC(len) END;
    j:=len;
    i:=0;
    WHILE j<blen DO b[i]:=b[j]; INC(j); INC(i) END;
    DEC(blen, len);
    junk.time:=FLUSHDELAY;
  END;
  sendjunk(link, junk); 
END wrl2;

PROCEDURE wrclose(pt:pTASK; fd:INTEGER; c:ARRAY OF CHAR);
VAR s:ARRAY[0..99] OF CHAR;
BEGIN
  WerrCall(pt);
  IntToStr(fd,1,s);
  Werr(c);
  Werr(s);
  Werr(NL);
END wrclose;

PROCEDURE crlf(VAR b:ARRAY OF CHAR; VAR len:INTEGER; mode:CARDINAL);
VAR i,j:INTEGER;
BEGIN
  IF mode>0 THEN                        (* convert LF to pr *)
    i:=0;
    j:=0;
    WHILE i<len DO
      IF b[i]=12C THEN
        IF mode=1 THEN b[j]:=15C; INC(j); END;
      ELSE b[j]:=b[i]; INC(j); END;
      INC(i);
    END;
    len:=j;
  END; 
END crlf;

PROCEDURE crlfp(VAR b:ARRAY OF CHAR; VAR len:INTEGER; mode:CARDINAL); (*1 del lf, 2 del lf cr>lf, 3 cr>lf, 4 del cr, 5 del cr lf>cr, 6 lf>cr *)
VAR i,j:INTEGER;
BEGIN
  IF mode>0 THEN                        (* convert LF to pr *)
    i:=0;
    j:=0;
    WHILE i<len DO
      IF mode=1 THEN 
        IF b[i]<>12C THEN b[j]:=b[i]; INC(j); END;
      ELSIF mode=2 THEN
        IF b[i]=15C THEN b[j]:=12C; INC(j) ELSIF b[i]<>12C THEN b[j]:=b[i]; INC(j) END;
      ELSIF mode=3 THEN
        IF b[i]=15C THEN b[j]:=12C ELSE b[j]:=b[i] END;
        INC(j); 
      ELSIF mode=4 THEN
        IF b[i]<>15C THEN b[j]:=b[i]; INC(j); END;
      ELSIF mode=5 THEN
        IF b[i]=12C THEN b[j]:=15C; INC(j) ELSIF b[i]<>15C THEN b[j]:=b[i]; INC(j) END;
      ELSIF mode=6 THEN
        IF b[i]=12C THEN b[j]:=15C ELSE b[j]:=b[i] END;
        INC(j);
      END;

      INC(i);
    END;
    len:=j;
  END;
END crlfp;


PROCEDURE detect(pt:pTASK);  (* startet task first sends command on stdout *)
VAR i, j:INTEGER;
BEGIN
  WITH pt^ DO
    WHILE (inlen>0) & (detectdone>0) DO
      i:=0;
      IF detectdone=1 THEN
        IF inbuf[0]="!" THEN
          detectdone:=2;
          i:=1;
        ELSE detectdone:=0 END;
      ELSIF detectdone=2 THEN 
        IF inbuf[0]="d" THEN
          initcompress(pt);
          i:=1;
          IF verb THEN Werr("task switched deflate on"+NL) END;
        ELSIF inbuf[0]="p" THEN
          initcompress(pt);
          pcdeflat^.pppframing:=TRUE;
          i:=1;
          IF verb THEN Werr("task switched ppp + deflate on"+NL) END;
        ELSIF inbuf[0]="l" THEN
          crlfmode:=1;
          i:=1;
          IF verb THEN Werr("task switched LF to CR on"+NL) END;
        ELSIF inbuf[0]="L" THEN
          crlfmode:=2;
          i:=1;
          IF verb THEN Werr("task switched delete LF on"+NL) END;
        ELSIF inbuf[0]="8" THEN
          i:=1;
          IF verb THEN Werr("task switched transparent"+NL) END;
        END;
        detectdone:=0;
      ELSE detectdone:=0 END;

      IF i>0 THEN                                           (* delete command *)
        j:=0;
        WHILE i<inlen DO inbuf[j]:=inbuf[i]; INC(i); INC(j) END;
        inlen:=j;
      END;

    END;
  END;
END detect;


PROCEDURE Monitor;

VAR rxbuf:ARRAY [0..2047] OF CHAR;
    getadress:GETADRESS;

PROCEDURE AppendTime(VAR s:ARRAY OF CHAR);
VAR h:ARRAY[0..30] OF CHAR;
BEGIN
  TimeToStr(time() MOD 86400, h);
  Append(s, " - ");
  Append(s, h);
END AppendTime;


PROCEDURE MonHead(l:pLINK; ilen:INTEGER; info-:ARRAY OF CHAR);
CONST UA = SET16{0,1,5,6};
      DM = SET16{0,1,2,3};
      SABM=SET16{0,1,2,3,5};
      DISC=SET16{0,1,6};
      FRMR=SET16{0,1,2,7};
      UI = SET16{0,1};
      RR = SET16{0};
      REJ= SET16{0,3};
      RNR= SET16{0,2};
      LF=15C;
      LINELEN=78;
      oneline=FALSE;

VAR i,p,c:INTEGER;
    com:CARDINAL;
    cmd:SET16;
    pf,cr:BOOLEAN;
    ch:CHAR;
    PF:ARRAY[0..3] OF CHAR;
    s:ARRAY[0..20] OF CHAR;
--    udp2:ARRAY[0..99] OF CHAR;

  PROCEDURE WriteHex(c:CHAR);
    PROCEDURE Nibble(n:CARD16);
    BEGIN
      rxbuf[p]:=CHR(48+n+7*ORD(n>9));INC(p);
    END Nibble;

  BEGIN
    Nibble(ORD(c) DIV 16);
    Nibble(ORD(c) MOD 16);
  END WriteHex;

  PROCEDURE ShowCall(cp:CARD16; hbit:BOOLEAN);
  VAR i:CARDINAL;
      c:CHAR;
  BEGIN
    FOR i:=cp TO cp+5 DO
      c:=getadress.adress[i];
      IF c<>" " THEN
        IF c>" " THEN rxbuf[p]:=c;INC(p) ELSE WriteHex(c) END;
      END;
    END;
    i:=ORD(getadress.adress[cp+6]) MOD 16;
    IF i<>0 THEN
      rxbuf[p]:="-";INC(p);
      IF i>9 THEN rxbuf[p]:=CHR(48+i DIV 10);INC(p) END;
      rxbuf[p]:=CHR(48+i MOD 10);INC(p);
    END;
    IF hbit AND (6 IN CAST(SET16, ORD(getadress.adress[cp+6]))) THEN
      rxbuf[p]:="*";INC(p);
    END;
  END ShowCall;


BEGIN
  GetAdress(l, ADR(getadress));
  IntToStr(getadress.port, 1, rxbuf);
  Append(rxbuf, ":fm ");
  p:=Length(rxbuf);
  ShowCall(7,FALSE);
  rxbuf[p]:=" ";INC(p);
  rxbuf[p]:="t";INC(p);
  rxbuf[p]:="o";INC(p);
  rxbuf[p]:=" ";INC(p);
  ShowCall(0,FALSE);
  rxbuf[p]:=" ";INC(p);
  i:=14;
  WHILE (i+7<HIGH(getadress.adress)) AND (getadress.adress[i]<>0C) DO
    IF i=14 THEN
      rxbuf[p]:="v";INC(p);
      rxbuf[p]:="i";INC(p);
      rxbuf[p]:="a";INC(p);
      rxbuf[p]:=" ";INC(p);
    END;
    ShowCall(i,TRUE);
    rxbuf[p]:=" ";INC(p);
    INC(i,7);
  END;
  rxbuf[p]:="c";INC(p);
  rxbuf[p]:="t";INC(p);
  rxbuf[p]:="l";INC(p);
  rxbuf[p]:=" ";INC(p);
  cmd:=CAST(SET16, getadress.my);
  com:=ORD(6 IN CAST(SET16, ORD(getadress.adress[6])))
       +  2*ORD(6 IN CAST(SET16, ORD(getadress.adress[13])));
  pf:=4 IN cmd;
  cmd:=cmd - SET16{4};
  IF cmd * SET16{0,1,2,3} = RR THEN
    PF:="RR  ";
    PF[2]:=CHR(48+CAST(CARD16, cmd) DIV 32);
  ELSIF cmd * SET16{0,1,2,3} = RNR THEN
    PF:="RNR ";
    PF[3]:=CHR(48+CAST(CARD16, cmd) DIV 32);
  ELSIF cmd * SET16{0,1,2,3} = REJ THEN
    PF:="REJ ";
    PF[3]:=CHR(48+CAST(CARD16, cmd) DIV 32);
  ELSIF cmd * SET16{0} = SET16{} THEN
    PF:="I   ";
    PF[2]:=CHR(48+(CAST(CARD16, cmd) DIV 2) MOD 8);
    PF[1]:=CHR(48+CAST(CARD16, cmd) DIV 32);
  ELSIF cmd = UI THEN PF:="UI  "
  ELSIF cmd = DM THEN PF:="DM  "
  ELSIF cmd = SABM THEN PF:="SABM"
  ELSIF cmd = DISC THEN PF:="DISC"
  ELSIF cmd = UA THEN PF:="UA  "
  ELSIF cmd = FRMR THEN PF:="FRMR"
  ELSE WriteHex(CHR(getadress.my)) END;
  FOR i:=0 TO 3 DO IF PF[i]<>" " THEN rxbuf[p]:=PF[i];INC(p) END END;
  PF:="v^-+";
  cr:=TRUE;
  IF (com=0) OR (com=3) THEN rxbuf[p]:="v"; INC(p); rxbuf[p]:="1";INC(p)
  ELSE rxbuf[p]:=PF[com MOD 2 + 2*ORD(pf)]; INC(p) END;

  IF getadress.cpid<=255 THEN
    rxbuf[p]:=" ";INC(p);
    rxbuf[p]:="p";INC(p);
    rxbuf[p]:="i";INC(p);
    rxbuf[p]:="d";INC(p);
    rxbuf[p]:=" ";INC(p);
    WriteHex(CHR(getadress.cpid));
  END;

  IF NOT (4 IN CAST(SET16, ORD(getadress.adress[13]))) THEN
    rxbuf[p]:=" ";INC(p);
    rxbuf[p]:="d";INC(p);
    rxbuf[p]:="a";INC(p);
    rxbuf[p]:="m";INC(p);
    rxbuf[p]:="a";INC(p);
    rxbuf[p]:=" ";INC(p);
  END;
(*
  Getudp2info(l, udp2);
  IF udp2[0]<>0C THEN
    rxbuf[p]:=" ";
    INC(p);
    i:=0;
    WHILE (p<HIGH(rxbuf)) & (udp2[i]<>0C) DO rxbuf[p]:=udp2[i]; INC(p); INC(i) END;
  END;
*)
  rxbuf[p]:=0C;

  IF (ilen>0) & (montyp=1) THEN 
    IntToStr(ilen, 1, s);
    Append(rxbuf, " ");
    Append(rxbuf, s);
    Append(rxbuf, "B");
  END;  

  AppendTime(rxbuf);
  IF (ilen>0) & (montyp>1) THEN
    p:=Length(rxbuf);
    rxbuf[p]:=NL; INC(p);
    FOR i:=0 TO ilen-1 DO
      IF (info[i]>=" ") & (info[i]<177C) THEN rxbuf[p]:=info[i] ELSE rxbuf[p]:="." END;
      INC(p);
    END;
    rxbuf[p]:=0C;
  END;
  Werr(rxbuf); Werr(NL);
END MonHead;

VAR ilen: INTEGER;
    ibuf:ARRAY[0..299] OF CHAR;
BEGIN
  IF pmon=NIL THEN pmon:=GetMon() END;
  IF pmon<>NIL THEN
    ilen:=GetStr(pmon,256,ADR(ibuf));

    MonHead(pmon, ilen, ibuf);
    Disconnect(pmon,TRUE);              (*release buffer*)
  END;
END Monitor;

PROCEDURE sleeprecon;
VAR s:ARRAY[0..20] OF CHAR;
BEGIN
  IF NOT terminate THEN
    IF verb THEN 
      IntToStr(recontime DIV 1000,1,s);
      Werr(" delay ");
      Werr(s);
      Werr("ms before next connect"+NL);
    END;
    usleep(recontime);
  END;
  IF recontime>maxrecontime DIV 2 THEN recontime:=maxrecontime ELSE recontime:=recontime*2 END;
END sleeprecon;


VAR i,j:CARDINAL;
    ts, timeout:CARDINAL;
    txbuf:ARRAY[0..1023] OF CHAR;
    ret:INTEGER;
    eventproc:CALLBACKPROC;
    hc:ARRAY[0..MYCALLS*7] OF CHAR;
    pt, pth:pTASK;
    len, pp0, pp1:INTEGER;
    sockset:SET16;
    connect:CONNECT;
    l2tick:BOOLEAN;

BEGIN
  FILL(ADR(udpsocks), 0C, SIZE(udpsocks));
  cmdline:="";
  pipename:="";
  connectto:="";
  FILL(ADR(mycall), 0C, SIZE(mycall));
  convlfcr:=0;
  convtopipe:=0;
  terminate:=FALSE;
  keepconnected:=FALSE;
  usedeflat:=FALSE;
  verb2:=FALSE;
  verb:=FALSE;
  pppmode:=FALSE;
  autodet:=FALSE;
  pppdiscard:=MAX(INTEGER);
  montyp:=0;
  minrecontime:=MINRECONTIME;
  maxrecontime:=MAXRECONTIME;
  axudpchk:=0;
  Parms;

<*IF DDEBUG THEN*>
--debufd:=OpenWrite("debrx");
debcfd:=OpenWrite("debtx");
<*END*>

  pmon:=NIL;
  eventproc:=Event;
  sockset:=SET16{};
  FOR i:=0 TO sockc DO INCL(sockset, i) END;  
  L2Init(1000, sockset, eventproc);
  l2verb:=verb;
  dupchk:=axudpchk;

  signal(SIGCHLD, cleanup (*CleanWho*));

(*
  MOVE(ADR(mycall), ADR(hc[0*7]), 7);          (* via call *)
  MOVE(ADR(mycall), ADR(hc[1*7]), 7);          (* connect call *)
  hc[2*7]:=0C;
*)
  parms.test:=FALSE;
  parms.parm:=0;         (* mycalls *)
  parms.port:=1;
  parms.str:=ADR(mycall);
  Parm(ADR(parms));

  FOR i:=0 TO HIGH(numpar) DO
    parms.test:=FALSE;
    parms.port:=i;
    parms.parm:=10;
    parms.val:=montyp;
    Parm(ADR(parms));

    IF numpar[i].port>0 THEN                   (* port configured *)

      pp0:=numpar[i].port;
      pp1:=pp0; 
      IF pp0>PORTS THEN                        (* set parameter to all ports *)
        pp0:=1;
        pp1:=PORTS;
      END;
      REPEAT   

        parms.test:=FALSE;
        parms.port:=pp0;
        parms.parm:=numpar[i].parmnum;
        parms.val:=numpar[i].val;
        IF verb2 THEN
          WrStr("set port "); WrInt(parms.port, 1);
          WrStr(" parmnum "); WrInt(parms.parm, 1); 
          WrStr(" to value "); WrInt(parms.val, 1);
          WrStrLn("");
        END; 
        Parm(ADR(parms));
        INC(pp0);
      UNTIL pp0>pp1;
    END;
  END;
  IF connectto[0]<>0C THEN
    signal(SIGTERM, killdisc);
    signal(SIGINT, killdisc);
    signal(SIGPIPE, killdisc);
  END;


  recontime:=minrecontime;
  tasks:=NIL;
  timesum:=0;
  LOOP
    IF tasks=NIL THEN
      IF terminate THEN HALT

      ELSIF connectto[0]<>0C THEN
        LOOP
          Connectto;
          IF terminate OR (tasks<>NIL) THEN EXIT END;

          sleeprecon;
        END;
      END;

    END;

    fdclr;
    pt:=tasks;
    WHILE pt<>NIL DO
      IF pt^.state=1 THEN
--        recontime:=minrecontime;
        IF cmdline[0]<>0C THEN                                (* start task *)
          Login(pt^.infd, pt^.l2addr.adress);
          pt^.outfd:=pt^.infd; 
--WrInt(pt^.fd, 1); WrStrLn(" fd");
          IF pt^.infd>=0 THEN
--ioctl(pt^.fd, TIOCSCTTY, ADR(iocbuf)); 
            pt^.state:=2;
          ELSE
            pt^.state:=3;
            IF verb THEN Werr("task start failed"+NL) END;
          END;
        ELSIF pipename[0]<>0C THEN                            (* use pipe *)
          pt^.infd:=OpenRW(pipename);
          pt^.outfd:=pt^.infd;
          IF pt^.infd>=0 THEN pt^.state:=2;
          ELSE
            pt^.state:=3;
            IF verb THEN Werr("pipe open error"+NL) END;
          END;  
        ELSE pt^.state:=2; pt^.infd:=0; pt^.outfd:=1; END;    (* use stdin stdout *)
 
        IF usedeflat THEN initcompress(pt) ELSE pt^.pcdeflat:=NIL END;

      ELSIF pt^.state=2 THEN
        IF terminate OR (eDISCONNECTED IN pt^.events) OR (eBUSY IN pt^.events) THEN
          pt^.state:=3;
          IF verb THEN
            WerrCall(pt);
            Werr(" layer2 disconnect"+NL);
          END;
          IF (cmdline[0]=0C) & (connectto[0]=0C) THEN HALT END;

        END;
        IF (pt^.infd>=0) & (pt^.inlen=0) & (pt^.inignor=0) THEN fdsetr(pt^.infd) END;
        IF pt^.inignor>0 THEN DEC(pt^.inignor) END; 

      ELSIF pt^.state=3 THEN
        IF verb THEN WerrCall(pt); Werr(" disconnect"+NL) END;

        IF cmdline[0]<>0C THEN  
          IF (pt^.infd>=0) & (pt^.infd<>pt^.outfd) THEN
            IF verb THEN wrclose(pt, pt^.infd, " close in pipe ") END; 
            Close(pt^.infd);
          END;
          IF pt^.outfd>=0 THEN
            IF verb THEN wrclose(pt, pt^.outfd, " close out pipe ") END;
            Close(pt^.outfd);
          END;
          pt^.infd:=-1;
          pt^.outfd:=-1;
          fdclr;
        END;
      
        Disconnect(pt^.link, FALSE);
        pt^.state:=4;
      END;

      IF (pt^.state=4) OR (pt^.state=5) THEN
        IF terminate OR (eDISCONNECTED IN pt^.events) OR (eBUSY IN pt^.events) THEN
          IF verb THEN WerrCall(pt); Werr(" deallocate link"+NL) END;
          Disconnect(pt^.link, TRUE);
          IF verb THEN WerrCall(pt); Werr(" disconnect close layer2"+NL) END;

          IF tasks=pt THEN tasks:=pt^.next;
          ELSE
            pth:=tasks;
            WHILE pth^.next<>pt DO pth:=pth^.next END;
            pth^.next:=pt^.next;
          END;  
          IF pt^.pcdeflat<>NIL THEN DEALLOCATE(pt^.pcdeflat, SIZE(pt^.pcdeflat^)) END;        
          DEALLOCATE(pt, SIZE(pt^));
          pt:=NIL;
          IF tasks=NIL THEN
            IF NOT keepconnected THEN terminate:=TRUE;
            ELSIF connectto[0]<>0C THEN sleeprecon END;

          END;
        ELSE pt:=pt^.next END;
      ELSE pt:=pt^.next END;
    END; 
    
    ts:=0;
    timeout:=LOOPTIME;
    ret:=selectrwt(ts, timeout);
    INC(timesum, LOOPTIME-timeout);

    IF timesum>=LOOPTIME THEN
--    IF timeout<=0 THEN
      Layer2;
      IF montyp>0 THEN Monitor END;
      DEC(timesum,LOOPTIME);
      l2tick:=TRUE;
    ELSE l2tick:=FALSE END;

    pt:=tasks;
    WHILE pt<>NIL DO
      IF (pt^.state=2) & (pt^.infd>=0) THEN
--WrInt(pt^.state, 1); WrStrLn(" st");
        IF issetr(pt^.infd) THEN
          IF pt^.inlen=0 THEN
            IF NOT terminate THEN                      (* read blocks after a SIGINT - why ever *)  
              pt^.inlen:=RdBin(pt^.infd, pt^.inbuf, SIZE(pt^.inbuf));
              IF pt^.inlen=0 THEN pt^.inignor:=20 END; (* read from pipe why ever *)
            END;
          END;
          IF verb2 & (pt^.inlen>0) THEN Whex("IN ",pt^.inbuf, pt^.inlen) END;
<*IF DDEBUG THEN*>
WrBin(debcfd, pt^.inbuf, pt^.inlen);
<*END*>
--WrStrLn("");WrStr("I:"); ShowHex(pt^.inbuf, pt^.inlen);

        END;
        IF pt^.inlen>0 THEN
          IF NOT pt^.detectdone>0 THEN detect(pt) END;         (* switch option with first bytes in stdin *)

          IF pt^.pcdeflat<>NIL THEN                            (* compress *)
            IF pt^.pcdeflat^.outlen=0 THEN compress(pt) END;
            wrl2(pt^.link, pt^.pcdeflat^.outbuf, pt^.pcdeflat^.outlen, pt^.junkbuf);
--            IF pt^.pcdeflat^.pppframing THEN pt^.junkbuf.time:=0 END;
          ELSE
            crlf(pt^.inbuf, pt^.inlen, pt^.crlfmode);
            wrl2(pt^.link, pt^.inbuf, pt^.inlen, pt^.junkbuf);
          END;
        ELSIF pt^.inlen<0 THEN
          IF pt^.junkbuf.len>0 THEN                             (* send rest *)
            pt^.junkbuf.time:=0; 
            sendjunk(pt^.link, pt^.junkbuf);
          ELSE
            pt^.state:=3;
            IF verb THEN Werr("read pipe from task broken"+NL) END;
          END;
        END;


        IF pt^.state=2 THEN  
          LOOP
            IF pt^.outlen>0 THEN
              IF verb2 THEN Whex("OUT ",pt^.outbuf, pt^.outlen) END;

              IF pt^.pcdeflat<>NIL THEN               (* decompress *)
                IF NOT pt^.pcdeflat^.done THEN
                  expand(pt);
                  IF pt^.pcdeflat^.xoutlen<0 THEN     (* expand or crc error *)
                    pt^.state:=3;
                    IF verb THEN Werr("deflate or crc error"+NL) END;
                    EXIT

                  END;
                END;
                IF NOT pt^.pcdeflat^.pppframing OR pt^.pcdeflat^.done THEN              
                  IF pt^.pcdeflat^.xoutlen>0 THEN 
                    wrpipe(pt^.outfd, pt^.pcdeflat^.xoutbuf, pt^.pcdeflat^.xoutlen);
                  END;
                  IF pt^.pcdeflat^.xoutlen=0 THEN pt^.pcdeflat^.done:=FALSE END;
                END;
              ELSE
                crlfp(pt^.outbuf, pt^.outlen, convtopipe);
                wrpipe(pt^.outfd, pt^.outbuf, pt^.outlen);
              END;
            END;
            IF (pt^.outlen=0) & (pt^.detectdone=0) THEN    (* protokoll detect must be done *)
              pt^.outlen:=GetStr(pt^.link, SIZE(pt^.outbuf), ADR(pt^.outbuf));
              IF pt^.outlen<=0 THEN EXIT END;

<*IF DDEBUG THEN*>
--WrBin(debufd, pt^.outbuf, pt^.outlen);
<*END*>
            ELSE EXIT END;
          END;
        END;
      END;

      IF l2tick & (pt^.junkbuf.len>0) THEN
        IF pt^.junkbuf.time>0 THEN DEC(pt^.junkbuf.time)
        ELSE sendjunk(pt^.link, pt^.junkbuf) END;            (* flush pr sendbuffer *)
      END;

      pt:=pt^.next;
    END;
  END;

END l2cat.