      REM PLW-MAIN
*PIC-LAN
*
*ALL
*PC
*N
*
*
*
******************************************************************************
******************************************************************************
***                                                                        ***
*** (C) Copyright 1990-2005 Doug Dumitru, All Rights Reserved.             ***
***                                                                        ***
*** This program is licensed under the terms of the GNU General Public     ***
*** License, version 2.0 with attached notices.                            ***
***                                                                        ***
*** The full text can be found in the LICENSE.TXT file in the              ***
*** PLIP.BP database file (the /usr/qmweb/PLIP.BP/PLIP.BP directory).      ***
***                                                                        ***
******************************************************************************
******************************************************************************
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.COMMON
      INCLUDE PL.COMMON.DEFS
      INCLUDE PL.DEFS
      INCLUDE PLIP.COMMON
      INCLUDE PLW.COMMON
      INCLUDE PL.INIT.INCLUDE
*
      X = @(0,0)
*
      IF SYSTEM(31) <> '0' OR SYSTEM(32) = '' THEN
         display 'This version of QMWeb is licensed under the GPL and is setup'
         display 'for use with the GPL version of the OpenQM database runtime.'
         display 'Modification and distribution of this software for use in'
         display 'conjunction with a non-GPL licensed runtime is a violation'
         display 'of the GPL prohibition against linking with closed-source'
         display 'runtime libraries.'
         display
         display 'Please contact EasyCo LLC (http://easyco.com) for availability'
         display 'of commercial licenses for this software.'
         stop
      END

      EXECUTE 'OPTION DUMP.ON.ERROR ON'

      IF SYSTEM(25) THEN
         CALL CSUB.SIGNAL.IGNORE(1)  ;* SIGHUP
         CALL CSUB.SIGNAL.IGNORE(13) ;* SIGPIPE
         CALL CSUB.SIGNAL.IGNORE(17) ;* SIGCHLD
      END
      E.FLG = '(E)'
      PRFIN = ''
*
      RELEASE
*
      CALL PLIP.INIT.SUB
*
      EQUATE FINGER.PORT         TO 79
      EQUATE HTTP.PORT           TO 80
*
      EV.LIST = '1.2' : VM : '2.1' : VM : '2.3' : VM : '2.4' : VM : '2.5' : VM : '3.1' : VM : '3.3' : VM : '3.4' : VM : '3.5'
*
      EQUATE SPINNER TO '|/-\'
*
      BSS3 = STR(BS,3)
*
      PL$CRLFCRLF = CR : LF : CR : LF
      PL$LFLF = LF : LF
*
      MAT DATA$ARRAY = ''
      MAT PR$ARRAY = ''
      MAT PLS$VARS = ''
*
      GOSUB 50500
*
      RELEASE
*
      PL$V.PORT.NO = ''
      CALL PLW.INIT('RUN')
*
      O.CFG = ''
      GOSUB 92000
*
      PL_READU DUMMY FROM PL$LOCK.FD , 'V.PORT.NO*' : PL$V.PORT.NO ELSE NULL
*
      IF PLIP$INIT.SUBS <> '' THEN
         PL_PRINT 'Executing INIT subroutines ...'
         I1 = DCOUNT(PLIP$INIT.SUBS,VM)
         FOR I = 1 TO I1
            SUB.NAME = PLIP$INIT.SUBS<1,I>
            PL_PR '   ' : SUB.NAME : ' ...'
            CALL @SUB.NAME
            PL_PRINT ''
         NEXT I
         PL_PRINT ''
      END
*
      PRINT 'Running,  press <X> to exit ...'
      PRINT ''
*
      EXIT.FLG = NO
      RESTART.FLG = NO
      SPINNER.CNT = 1
      RESTART.CTR = 0
      LAST.IDLE.TM = PL_NOW()
      SLEEP.TM = PL_NOW()
*
      IF NOT(PL$V.PORT.NO) THEN
         IF NOT(PL$RESTART.FLG) THEN
            PL_TCP_INIT_Q ELSE NULL
            PL_TCP_ADD_Q -1 , PNO.CHK , MSG.AUTH , 0 ELSE NULL
            PL_TCP_ADD_Q -1 , PNO.CHK , MSG.SUB.CLEANUP , 0 ELSE NULL
            IF PLW$EXT <> '' THEN
               PL_TCP_ADD_Q -1 , PNO.CHK , MSG.EXT , 0 ELSE NULL
            END
         END
      END
*
      PL_TCP_ADD_Q PL$V.PORT.NO , PNO.CHK , MSG.CONFIG , 0 ELSE NULL
      PL_TCP_ADD_Q PL$V.PORT.NO , PNO.CHK , MSG.EXITFLG , 5 ELSE NULL
*
      LAST.EXIT.CHK = PL_NOW()
*
      LOOP
         A.FLG = NO
         D.FLG = NO
*$*DISPLAY '===>' :
         PL_TCP_GET_Q PL$V.PORT.NO , P.NO , MSG , TP , ST THEN
*$*DISPLAY '[' : PL$V.PORT.NO : ',' : P.NO : ',' : MSG : ',' : TP : ',' : ST : ']'
            D.FLG = YES
            BEGIN CASE
               CASE P.NO = 0 AND MSG = MSG.ACTIVITY AND TP = 0 AND ST = 0
               CASE P.NO = PNO.CHK ;* Local event
                  ON MSG GOSUB 50100,50200,50300,99999,50500,50600,50700,50800,99999,99999,51100,51200,99999,51400,51500
               CASE YES ;* activity
                  GOSUB 40000
                  IF ST$PLCB <> '' THEN
                     RELEASE PL$CONN.FD , ST$PLCB 'R%8'
                  END
                  MAT ST$ARRAY = ''
                  PR$PLCB = ''
                  PL_PRSTATE ''
            END CASE
         END
         READU DUMMY FROM PL$LOCK.FD , 'V.PORT.NO*' : PL$V.PORT.NO LOCKED
            STOP
         END ELSE NULL
         IF PL_NOW() - LAST.EXIT.CHK >= 10 THEN GOSUB 50300
         IF PLIP$RESTART.CTR THEN
            IF RESTART.CTR >= PLIP$RESTART.CTR THEN
               RESTART.FLG = YES
            END
         END
         IF RESTART.FLG THEN
            PL_PRINT ''
            PL_PRINT 'Process ' : PL$V.PORT.NO : ' is restarting.'
            RELEASE
            WRITEV '' ON PL$PROC.FD , 'CFG*' : PL$V.PORT.NO , 12
            EXECUTE 'PHANTOM PLW-MAIN RESTART ' : PL$V.PORT.NO
            STOP
         END
      UNTIL EXIT.FLG DO
         NW = PL_NOW()
         BEGIN CASE
            CASE A.FLG
               SLEEP.TM = PR$NOW
               PRINT '+ ' :
            CASE D.FLG
               PRINT '+ ' :
            CASE YES
         END CASE
         IF ( PR$NOW <> NW ) OR ( PR$STATE <> '' ) THEN
            PR$NOW = NW
            PL_PRSTATE ''
         END
         PRINT SPINNER[SPINNER.CNT,1] : BSS3 : PRFIN :
         SPINNER.CNT = SPINNER.CNT + 1
         IF SPINNER.CNT > 4 THEN SPINNER.CNT = 1
      REPEAT
*
      LOCK 20
      SELECT PL$CONN.FD
      SELECTE TO SEL.VAR
      EOF = NO
      LOOP
         READNEXT ID FROM SEL.VAR ELSE EOF = YES
      UNTIL EOF DO
         IF ID MATCHES '8N' THEN
            PLCB = ID + 0
            ID = PLCB 'R%8'
            MATREADU ST$ARRAY FROM PL$CONN.FD , ID LOCKED NULL THEN
*               NULL
*            END THEN
               PL_PRINT PLCB 'R#4' : ' KILLED on exit'
               GOSUB 990000
            END ELSE
               RELEASE PL$CONN.FD , PLCB 'R%8'
            END
         END
      REPEAT
      UNLOCK 20
*
      PL_PRINT ''
      PL_PRINT 'PicLan-IP THREAD on port ' : PORT.NO : ' shutdown.'
*
      DELETE PL$PROC.FD , PL$V.PORT.NO
      DELETE PL$PROC.FD , 'CFG*' : PL$V.PORT.NO
*
      STOP
*
200   REM Process event
*
      O.FLG = NO
      IF ST$POST.LEN AND LEN(ST$IBUF) < ST$POST.LEN THEN
         LOOP
            PL_TCP_READ D FROM ST$PLCB , PLIP$MAX.IO.LEN ELSE
               PL_PRINT ST$PLCB 'R#4' : ' Error reading from connection  CLOSED'
               GOSUB 990000
               RETURN
            END
            IF D <> '' THEN
               ST$IBUF = ST$IBUF : D
            END
         WHILE D <> '' AND LEN(ST$IBUF) < ST$POST.LEN DO REPEAT
      END ELSE
         CALL PLW.GET.HTTP.HDR(ERR.FLG)
         IF ERR.FLG THEN
            PL_PRINT ST$PLCB 'R#4' : ' Error reading from connection  CLOSED'
            GOSUB 990000
            RETURN
         END
*$*      IF ST$HTTP.HDR = '' THEN RETURN
         IF ST$CMD = '' THEN RETURN
      END
*
      ST$KEEP.ALIVE = NO
*$*PRINT 'PLIP$NOKEEPALIVE = ' : PLIP$NOKEEPALIVE
      IF NOT(PLIP$NOKEEPALIVE) THEN
         LOCATE('CONNECTION',ST$HTTP.HDR,1;LOC) THEN
            T$$$ = OCONV(ST$HTTP.VAL<1,LOC>,'MCU')
            LOCATE('KEEP-ALIVE',T$$$,1,1;LOC2) THEN
               ST$KEEP.ALIVE = YES
*$*PRINT 'SETTING ST$KEEP.ALIVE'
            END
         END
      END
*
      CMD = FIELD(ST$CMD,' ',1)
      BEGIN CASE
         CASE CMD = 'GET'
         CASE CMD = 'POST'
            ST$POST.LEN = ''
            LOCATE('CONTENT-LENGTH',ST$HTTP.HDR,1;LOC) THEN
               ST$POST.LEN = FIELD(TRIM(ST$HTTP.VAL<1,LOC,1>),' ',1)
               IF NOT(ST$POST.LEN MATCHES '1N0N') THEN ST$POST.LEN = ''
            END
            IF NOT(ST$POST.LEN) THEN
               PL_PRINT ST$PLCB 'R#4' : ' ERROR - POST without content'
               GOSUB 990000
               RETURN
            END
            IF LEN(ST$IBUF) < ST$POST.LEN THEN RETURN
         CASE CMD = 'HEAD'
         CASE YES
            PL_PR ST$PLCB 'R#4' : ' ' : ST$CMD<1,1> 'L#46' : '  '
            R.ERR = '501 NOT IMPLEMENTED [PLW-MAIN:1];The HTTP command ' : CMD : ' is not implemented by this server.  [PLW-MAIN:1]'
            GOTO 99000
      END CASE
*
      IF ST$POST.LEN AND LEN(ST$IBUF) < ST$POST.LEN THEN RETURN
*
      FNAME = FIELD(ST$CMD,' ',2)
      IF ST$POST.LEN THEN
         PARM = ST$IBUF[1,ST$POST.LEN]
         ST$POST.DATA = PARM
         FNAME = OCONV(FIELD(FNAME,'?',1),'MCU')
         ST$IBUF = ST$IBUF[ST$POST.LEN+1,BIG.STR]
         ST$POST.LEN = ''
      END ELSE
         PARM = OCONV(FNAME,'G1?999')
         FNAME = OCONV(FIELD(FNAME,'?',1),'MCU')
         ST$POST.DATA = ''
      END
*
      VAR$NAMES = ''
      MAT VAR$VALS = ''
      VAR$CNT = 0
*
      FLG = NO
      IF ST$POST.DATA <> '' THEN
         LOCATE('CONTENT-TYPE',ST$HTTP.HDR,1;LOC) THEN
            ENC.TP = upcase(FIELD(TRIM(ST$HTTP.VAL<1,LOC,1>),' ',1))
            ENC.TP = FIELD(ENC.TP,';',1)
            BEGIN CASE
               CASE ENC.TP = 'APPLICATION/X-WWW-FORM-URLENCODED'
                  FLG = YES
               CASE ENC.TP = 'MULTIPART/FORM-DATA'
                  CALL PLW.DECODE.MULTIPART(ST$POST.DATA)
            END CASE
         END
      END ELSE
         FLG = YES
      END
*
      IF FLG THEN
         I1 = DCOUNT(PARM,'&')
         FOR I = 1 TO I1
            PP = FIELD(PARM,'&',I)
            V = FIELD(PP,'=',1)
            GOSUB 91000
            P.NM = V
            V = FIELD(PP,'=',2)
            GOSUB 91000
            P.VAL = V
            IF I1 <= 500 THEN
               VAR$NAMES<I> = P.NM
               VAR$VALS(I)   = P.VAL
            END ELSE
               VAR$NAMES<I> = P.NM
               VAR$VALS(MOD(I-1,500)+1)<INT((I-1)/500)+1> = P.VAL
            END
         NEXT I
         VAR$CNT = DCOUNT(VAR$NAMES,AM)
      END
*
      PL_GET_HDR T.R.ADDR FROM 'X-CONNADDR' THEN 
         T.R.ADDR = FIELD(FIELD(T.R.ADDR,' ',2),':',1)
      END ELSE
         T.R.ADDR = FIELD(ST$RIP,':',1)
      END
      PL_PR ST$PLCB 'R#4' : ' ' : T.R.ADDR 'L#16' : ( CMD 'L#4' : ' ' : FNAME : ' ' : OCONV(PARM[1,40],'MCP') ) 'L#40' : '  '
*
      LOCATE('IF-MODIFIED-SINCE',ST$HTTP.HDR,1;LOC) THEN
         MOD.TM = PL_FROMDATE(ST$HTTP.VAL<1,LOC,1>)
      END ELSE
         MOD.TM = ''
      END
*
      T = FIELD(FNAME,'/',DCOUNT(FNAME,'/'))
      F.CH = T[1,1]
      R.ERR = ''
      RESX = ''
*
      BEGIN CASE
         CASE F.CH = '&'
         CASE F.CH >= 'A' AND F.CH <= 'Z'
         CASE F.CH >= '0' AND F.CH <= '9'
         CASE F.CH = '_' AND T[2,1] <> '_'
         CASE T = ''
         CASE YES
            MATREAD DATA$ARRAY FROM PL$DATA.FD , PL$V.PORT.NO : '*' : ST$IP : '/' ELSE
               MAT DATA$ARRAY = ''
               DATA$OPT = 'E'
            END
            R.ERR = '404 NOT FOUND [PLW-MAIN:2];The specified file name is invalid.  [PLW-MAIN:2:' : FNAME : ']'
            PL$PGNAME = ''
            PLW$LEVEL = 1
      END CASE
      IF R.ERR = '' THEN
         PL$EXTRAHTTP = ''
         PL$PGNAME = ''
         PLW$LEVEL = 0
         CALL PLW.PAGE(FNAME:'',MOD.TM,R.ERR)
      END
      IF R.ERR <> '' AND R.ERR[1,4] <> '304 ' THEN
         IF INDEX(DATA$OPT,'E',1) THEN
            PL_SETVAR R.ERR TO '_ERROR' ELSE NULL
            PL_SETVAR FNAME TO '_FNAME' ELSE NULL
            PL_SETVAR MOD.TM TO '_MOD.TM' ELSE NULL
            CALL PLW.PAGE('__ERROR.HTM','',ERROR2)
            IF ERROR2 = '' THEN R.ERR = ''
         END
      END
*
      IF RESX = AM THEN
*$*      PL_PRINT ST$PLCB 'R#4' : ' CLOSING [0]'
         PL_TCP_CLOSE ST$PLCB ELSE NULL
         ST$CLOSESENT = YES
         PL_WRITE_STATE
         PL_TCP_SET_Q ST$PLCB , A.CLOSED ELSE NULL
         CALL PLW.LOG(FNAME,R.ERR,ST$DATA.LEN)
         MAT ST$ARRAY = ''
         RETURN
      END
*
      READU DUMMY FROM PL$LOCK.FD , 'V.PORT.NO*' : PL$V.PORT.NO LOCKED NULL ELSE NULL
*
      IF RESX = '' AND R.ERR = '' THEN
         R.ERR = '500 INTERNAL ERROR [PLW-MAIN:3];Invalid Page.  No content or error given.  [PLW-MAIN:3]'
      END
*
      IF RESX = '' AND FIELD(R.ERR,' ',1) <> '304' THEN
         CALL PLW.ERROR(R.ERR)
         R.ERR = FIELD(R.ERR,';',1)
      END
*
      IF R.ERR = '' THEN
         R.ERR = '200 OK'
      END
*
      R.LEN = 0
      IF RESX <> '' OR R.ERR <> '' THEN
         IF CTRL$HEXFLG THEN
            IF PL$PBHDR = '' OR PL$EXTRAHTTP <> '' THEN
               CALL PLW.BLD.HTTP.HDR(0,FIELD(R.ERR,';',1),ST$KEEP.ALIVE,CTRL$MIME,CTRL$TMS,LEN(RESX)/2,LL,PL$EXTRAHTTP)
               PL$PBHDR = LL
            END
            PL_PRINT R.ERR
            BEGIN CASE
               CASE CMD = 'GET' OR CMD = 'POST'
                  R.LEN = LEN(PL$PBHDR) + ( LEN(RESX) / 2 )
                  PL_BCB.SNDX PL_HEX(PL$PBHDR) : RESX
               CASE CMD = 'HEAD'
                  R.LEN = LEN(PL$PBHDR)
                  PL_BCB.SNDX PL_HEX(PL$PBHDR)
            END CASE
         END ELSE
            IF PL$PBHDR = '' OR PL$EXTRAHTTP <> '' THEN
               CALL PLW.BLD.HTTP.HDR(0,FIELD(R.ERR,';',1),ST$KEEP.ALIVE,CTRL$MIME,CTRL$TMS,LEN(RESX),LL,PL$EXTRAHTTP)
               PL$PBHDR = LL
            END
            PL_PRINT R.ERR
            BEGIN CASE
               CASE CMD = 'GET' OR CMD = 'POST'
                  R.LEN = LEN(PL$PBHDR) + LEN(RESX)
                  PL_BCB.SND PL$PBHDR : RESX
               CASE CMD = 'HEAD'
                  R.LEN = LEN(PL$PBHDR)
                  PL_BCB.SND PL$PBHDR
            END CASE
         END
         CALL PLW.LOG(FNAME,R.ERR,R.LEN)
         O.FLG = YES
         RESX = ''
      END
*
      RETURN
*
10120 REM EVENT 1.2
*
      A.FLG = YES
      T = ST$IP
      PL_TCP_GET_LISTEN ST$PLCB ELSE NULL
      L.PLCB = RES
*
      PL_TCP_SET_Q ST$PLCB , A.READ ELSE NULL
*
      IF L.PLCB < 0 THEN
         IF L.PLCB <> -29 THEN
            PL_PRINT 'Error getting listen ERR = ' : ERR : ' RES = ' : L.PLCB
         END
         RELEASE PL$CONN.FD , ST$PLCB 'R%8'
         RETURN
      END
*
      RELEASE PL$CONN.FD , ST$PLCB 'R%8'
*
      PL_PLCB.STATUS L.PLCB ELSE NULL
*
      MAT ST$ARRAY = ''
      PL_PRSTATE ''
      ST$PLCB = L.PLCB
      ST$TP  = ST.TP.HTTP
      ST$IP  = T
      ST$CFG = PL$CFG
      ST$RIP = PL_TCP.STATUS_RIP() : ':' : PL_TCP.STATUS_RPORT()
*$*   PL_PRINT ST$PLCB 'R#4' : ' OPEN ' : ST$RIP
      PL_WRITE_STATE
      PR$PLCB = ST$PLCB
      PL_PRSTATE ''
*
      GOTO 10230
*
10210 REM EVENT 2.1
*
      A.FLG = YES
*$*   PL_PRINT ST$PLCB 'R#4' : ' CLOSED'
      GOSUB 990000
      MAT ST$ARRAY = ''
*
      RETURN
*
10230 REM EVENT 2.3
*
      A.FLG = YES
*
      IF ST$OBUF.CNT MATCHES '1N0N' AND ST$OBUF.CNT <> '0' THEN
         PL_BCB.SND ''
         IF ST$OBUF.CNT[1,1] = '*' THEN
            PL_PRINT ST$PLCB 'R#4' : ' KILLED write error'
            GOTO 990000
         END
      END ELSE
         GOSUB 200
*
         IF NOT(O.FLG) THEN
            PL_WRITE_STATE
            PL_TCP_SET_Q ST$PLCB , A.READ + A.CLOSED ELSE NULL
            MAT ST$ARRAY = ''
            RETURN
         END
*
         IF ST$OBUF.CNT[1,1] = '*' THEN
            PL_PRINT ST$PLCB 'R#4' : ' KILLED write error'
            GOTO 990000
         END
      END
*
      IF ST$OBUF.CNT MATCHES '1N0N' AND ST$OBUF.CNT <> '0' THEN
         PL_WRITE_STATE
         PL_TCP_SET_Q ST$PLCB , A.WRITE + A.CLOSED ELSE NULL
         MAT ST$ARRAY = ''
         RETURN
      END
*
      IF NOT(ST$KEEP.ALIVE) THEN
*$*      PL_PRINT ST$PLCB 'R#4' : ' CLOSING [1]'
         PL_TCP_CLOSE ST$PLCB ELSE NULL
         ST$CLOSESENT = YES
         PL_WRITE_STATE
         PL_TCP_SET_Q ST$PLCB , A.CLOSED ELSE NULL
         MAT ST$ARRAY = ''
         RETURN
      END
*
      PL_WRITE_STATE
      PL_TCP_SET_Q ST$PLCB , A.READ + A.CLOSED ELSE NULL
      MAT ST$ARRAY = ''
      RETURN
*
10240 REM EVENT 2.4
*
      A.FLG = YES
*
      IF ST$OBUF.CNT MATCHES '1N0N' AND ST$OBUF.CNT <> '0' THEN
         PL_BCB.SND ''
         IF ST$OBUF.CNT[1,1] = '*' THEN
            PL_PRINT ST$PLCB 'R#4' : ' KILLED write error'
            GOTO 990000
         END
      END ELSE
         GOSUB 200
         IF ST$OBUF.CNT[1,1] = '*' THEN
            PL_PRINT ST$PLCB 'R#4' : ' KILLED write error'
            GOTO 990000
         END
      END
*
      IF ST$OBUF.CNT MATCHES '1N0N' AND ST$OBUF.CNT <> '0' THEN
         PL_WRITE_STATE
         PL_TCP_SET_Q ST$PLCB , A.WRITE + A.CLOSED ELSE NULL
         MAT ST$ARRAY = ''
         RETURN
      END
*
      IF NOT(ST$CLOSESENT) THEN
*$*      PL_PRINT ST$PLCB 'R#4' : ' CLOSING [2]'
         PL_TCP_CLOSE ST$PLCB ELSE NULL
         ST$CLOSESENT = YES
      END
      PL_WRITE_STATE
      PL_TCP_SET_Q ST$PLCB , A.CLOSED ELSE NULL
      MAT ST$ARRAY = ''
      RETURN
*
10250 REM EVENT 2.5
*
      PL_PRINT ST$PLCB 'R#4' : ' FREE'
      GOSUB 990000
*
      RETURN
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Event processing subroutines
*
40000 REM Event
*
      RESTART.CTR = RESTART.CTR + 1
*
      ST$PLCB = P.NO
      IF ST = 15 THEN
         PL_READ_STATE ELSE GOTO 40099
      END ELSE
         PL_READU_STATE ELSE GOTO 40099
      END
*
      PR$PLCB = ST$PLCB
      PL_PRSTATE 'Processing event [' : P.NO : ',' : MSG : ',' : TP : ',' : ST : ']'
*
      IF NOT(NUM(ST$TP)) AND PLW$EXT <> '' THEN
         SUB.NAME = FIELD(ST$TP,' ',1)
         LOCATE(SUB.NAME,PLW$EXT,1,1;L) THEN
            CALL @SUB.NAME(P.NO,MSG,TP,ST)
            RETURN
         END ELSE
            PL_PRINT '40000: Unknown ST$TP = ' : ST$TP
            GOSUB 990000
            RETURN
         END
      END
*
      BEGIN CASE
         CASE ST$TP = ST.TP.HTTP.LISTEN
            IF ST <> 15 THEN
               PL_PRINT '40000: Mul Listen PLCB not state 15 ' : ST$PLCB : ' ' : ST
               PL_PRINT '       Sending supervisor a RECYCLE signal'
               WRITE '99' ON PL$CTRL.FD , 'CONFIG-EXIT'
               GOTO 990000
            END
            GOTO 10120
         CASE ST$TP = ST.TP.HTTP
            BEGIN CASE
               CASE MSG = MSG.ACTIVITY ;* Activity
                  BEGIN CASE
                     CASE ST <= 1
                        GOTO 10210
                     CASE ST = 3 OR ST = 4 OR ST = 5 OR ST = 6 OR ST = 7
                        GOTO 10230
                     CASE ST = 8 OR ST = 9 OR ST = 10 OR ST = 11
                        GOTO 10240
                     CASE YES
                        PL_PRINT '40000: Invalid ST on TCP PLCB ' : ST$PLCB : ' ' : ST
                        GOTO 990000
                  END CASE
               CASE MSG = MSG.TIMEOUT OR MSG = MSG.LONG.TIMEOUT
                  GOTO 40100
            END CASE
         CASE YES
            PL_PRINT '40000: Unknown ST$TP ' : ST$PLCB : ' ' : ST$TP
            GOSUB 990000
      END CASE
*
      RETURN
*
40099 REM State not on file
*
      RELEASE PL$CONN.FD , P.NO 'R%8'
      P2 = '40000: Error reading ST$ARRAY ' : P.NO 'R%8'
      DESC     = 'PL$V.PORT.NO = ' : PL$V.PORT.NO
      DESC<-1> = 'P.NO         = ' : P.NO
      DESC<-1> = 'MSG          = ' : MSG
      DESC<-1> = 'TP           = ' : TP
      DESC<-1> = 'ST           = ' : ST
      CALL PLU.ERROR.LOG('PLW-MAIN',P2,DESC)
*
      MAT ST$ARRAY = ''
*
      RETURN
*
40100 REM PLCB TIMEOUT
*
      IF ST$TP = ST.TP.HTTP.LISTEN THEN
         PL_PRINT '40100: HTTP LISTEN TIMEOUT'
         RETURN
      END
*
      PL_PRINT ST$PLCB 'R#4' : ' TIMEOUT'
      GOTO 990000
*
50100 REM Dummy TIMEOUT event
*
      RETURN
*
50200 REM Local event CONFIG
*
      READ N.CFG FROM PLIP$CTRL.FD , PL$CFG ELSE CALL PLXX.STOP(202,PL$CFG)
*
      IF N.CFG <> O.CFG THEN
         CALL PLW.READ.CONFIG('RUN')
         O.CFG = N.CFG
      END
*
      PL_TCP_ADD_Q PL$V.PORT.NO , PNO.CHK , MSG.CONFIG , 30 ELSE NULL
*
      RETURN
*
50300 REM Local event EXITFLG
*
      IF PL_TA() THEN
         CMD = PL_GET()
         CMD = OCONV(CMD,'MCU')
         IF CMD = 'X' THEN
            EXIT.FLG = YES
            RETURN
         END
         IF CMD = 'R' THEN
            RESTART.FLG = YES
         END
      END
*
      READV X FROM PL$PROC.FD , 'CFG*' : PL$V.PORT.NO , 11 THEN
         IF X = '1' THEN
            EXIT.FLG = YES
            RETURN
         END
      END
*
      READV X FROM PL$PROC.FD , 'CFG*' : PL$V.PORT.NO , 12 THEN
         IF X = '1' THEN
            RESTART.FLG = YES
            RETURN
         END
      END
*
      PL_TCP_ADD_Q PL$V.PORT.NO , PNO.CHK , MSG.EXITFLG , 5 ELSE NULL
      LAST.EXIT.CHK = PL_NOW()
*
      RETURN
*
50500 REM Local event AUTH
*
      PL_TCP_ADD_Q -1 , PNO.CHK , MSG.AUTH , 600 ELSE NULL
*
      RETURN
*
50600 REM Dummy local event
*
      RETURN
*
50700 REM sub cleanup
*
      CALL PLW.CLEANUP.SUBS
      PL_TCP_ADD_Q -1 , PNO.CHK , MSG.SUB.CLEANUP , ( 30 * 60 ) ELSE NULL
*
      RETURN
*
50800 REM LONG TIMEOUT
*
      RETURN
*
51100 REM CONN Cleanup
*
      CALL PLW.CONN.CLEANUP
      PL_TCP_ADD_Q -1 , PNO.CHK , MSG.CONN.CLEANUP , PLIP$CONN.CLEANUP ELSE NULL
*
      RETURN
*
51200 REM
*
      RETURN
*
51400 REM
*
      RETURN
*
51500 REM MSG.EXT
*
      I1 = DCOUNT(PLW$EXT,SVM)
      FOR I = 1 TO I1
         SUB.NAME = PLW$EXT<1,1,I>
         CALL @SUB.NAME('',MSG.EXT,'','')
      NEXT I
*
      PL_TCP_ADD_Q -1 , PNO.CHK , MSG.EXT , 10 ELSE NULL
*
      RETURN
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
91000 REM Convert inbound var V
*
      V = PL_REPL(V,'+',' ')
*
      IF NOT(INDEX(V,'%',1)) THEN RETURN
*
      IF INDEX(V,'%25',1) THEN
         V = PL_REPL(V,CHAR(249),CHAR(249):'~~~Q$$$')
         V = PL_REPL(V,'%25',CHAR(249):'~~~P$$$')
         PERCENT.FLG = YES
      END ELSE
         PERCENT.FLG = NO
      END
*
      LOOP
         T = INDEX(V,'%',1)
      WHILE T DO
         CH = ICONV(V[T+1,2],'MX0C')
         V = PL_REPL(V,(V[T,3]),CH)
      REPEAT
*
      IF PERCENT.FLG THEN
         V = PL_REPL(V,CHAR(249):'~~~Q$$$',CHAR(249))
         V = PL_REPL(V,CHAR(249):'~~~P$$$','%')
      END
*
      RETURN
*
92000 REM Read config
*
      READ N.CFG FROM PLIP$CTRL.FD , 'CONFIG' ELSE CALL PLXX.STOP(202,'CONFIG')
*
      IF N.CFG <> O.CFG THEN
         CALL PLW.READ.CONFIG('RUN')
         O.CFG = N.CFG
      END
*
      RETURN
*
99000 REM Internal Error
*
*
      T = FIELD(R.ERR,';',2)
      IF T = '' THEN T = R.ERR
      X = T : CRLF : CRLF
      CALL PLW.BLD.HTTP.HDR(0,FIELD(FIELD(R.ERR,';',1),';',1),ST$KEEP.ALIVE,'text/plain','',LEN(X),LL,PL$EXTRAHTTP)
      PL_BCB.SND LL : X
*
      RETURN
*
      INCLUDE PLW.DEL.STATE.INCLUDE
*
99999 REM Dont go here
*
      STOP 'X'
   END
