      REM PLW-SUPERVISOR
*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
*
      DUMMY = @(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'
      RELEASE
*
      IF SENT<1,2> = 'RESTART' THEN
         RESTART.FLG = YES
      END ELSE
         RESTART.FLG = NO
      END
*
      MAT PLS$VARS = ''
*
      CRLF = CR : LF
      NUL80 = STR(CHAR(0),80)
*
      ILOCK.TBL = ''
      ILOCK.ID = 0
*
      CALL PLIP.INIT.SUB
      CALL PLW.INIT.SUB('RUN')
*
      CALL PLWS.GETLOCK(PL$LOCK.FD,'WWW.CTRL,LOCK','SUPERVISOR-PROCESS',L.PORT)
      IF L.PORT <> '' THEN
         PL_PRINT 'Another SUPERVISOR is already running.'
         STOP
      END
      PL_READVU DUMMY FROM PL$LOCK.FD , 'SUPERVISOR-PROCESS' , 1 ELSE NULL
*
      WRITEV '' ON PL$PROC.FD , 'CFG*SUP' , 12
*
      IF NOT(RESTART.FLG) THEN
         CLEARFILE PL$PROC.FD
         CLEARFILE PL$STATE.FD
         CLEARFILE PL$CONN.FD
      END
*
      PL$CFG = 'CONFIG'
*
      PL_PRINT ''
      PL_PRINT ''
      PL_PRINT '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*'
      PL_PRINT ''
      PL_PRINT 'PicLan-IP SUPERVISOR starting on port ' : PORT.NO : '.'
      PL_PRINT ''
*
      OPEN 'WWW.LOG,HANGS' TO HANGS.FD ELSE CALL PLXX.STOP(201,'WWW.LOG,HANGS')
*
* Open local HTTP messages file
*
      PL$V.PORT.NO = 'SUP'
      MAT DATA$ARRAY = ''
      DATA$TP = 'FILE'
      DATA$FNAME = 'WWW.CTRL,LOCAL.PAGES'
*
      OPEN.ERR = NO
      GOSUB 90000
      IF OPEN.ERR THEN
         PL_PRINT 'Error opening local WEB pages file WWW.CTRL,LOCAL.PAGES'
         STOP
      END
      DATA$FNUM = LOC
      MATWRITE DATA$ARRAY ON PL$DATA.FD , PL$V.PORT.NO : '*LOCAL'
*
      IF NOT(RESTART.FLG) THEN
         PL_PRINT 'Cleaning up old connections ... '
*
         FOR I = 0 TO 199
            PL_PRREMOVESTATE I
         NEXT I
      END
*
      PL_PRINT ''
*
      D = ''
      I1 = DCOUNT(PLIP$PROC.PORTS,VM)
      FOR I = 1 TO I1
         N = PLIP$PROC.PORTS<1,I>
         IF N MATCHES '1N0N' THEN
            D<1,-1> = N
            D<2,-1> = I - 1
         END
      NEXT I
      WRITE D ON PL$PROC.FD , 'CFG*PORTS'
*
      IF NOT(RESTART.FLG) THEN
         I1 = DCOUNT(PLIP$PROC.PORTS,VM)
         FOR I = 1 TO I1
            SSTR = ''
            BEGIN CASE
               CASE PLIP$PROC.PORTS<1,I> MATCHES '1N0N'
                  PL_PRINT 'Starting THREAD on port ' : PLIP$PROC.PORTS<1,I> : ' ... '
                  CALL PLWS.LOGON(PLIP$PROC.PORTS<1,I>,'START ':I-1,SSTR,ERR.STR)
               CASE PLIP$PROC.PORTS<1,I> = '*'
                  PL_PRINT 'Starting THREAD on phantom ... '
                  CALL PLWS.LOGON('*','START ':I-1,SSTR,ERR.STR)
               CASE YES
                  PL_PRINT 'The process port specified as ' : PLIP$PROC.PORTS<1,I> : ' is not valid.'
                  STOP
            END CASE
            IF ERR.STR THEN
               PL_PRINT 'An non-recoverable error has occurred while logging a PicLan-IP'
               PL_PRINT 'helper process on ...'
               PL_PRINT ''
               PL_PRINT '   ' : ERR.STR
               STOP
            END
            PL_PRINT SSTR
            SLEEP 5
         NEXT I
      END
*
      EXIT.FLG = NO
*
      PRINT ''
      PRINT "Press 'x' to exit ..."
      PRINT ''
*
      CHK.CNT = PLIP$SUP.POLL
      LOOP
         IF PL_TA() THEN
            CMD = PL_GET()
            CMD = OCONV(CMD,'MCU')
            IF CMD = 'X' THEN EXIT.FLG = YES
         END
*
         IF NOT(EXIT.FLG) THEN
            READ EXIT.FLG FROM PL$CTRL.FD , 'CONFIG-EXIT' THEN
               DELETE PL$CTRL.FD , 'CONFIG-EXIT'
            END ELSE
               EXIT.FLG = NO
            END
         END
      UNTIL EXIT.FLG DO
*
         NW = PL_NOW()
*
         CHK.CNT = CHK.CNT - 1
         IF CHK.CNT <= 0 THEN
            PL_PRCHECKSTATE A1,A2,A3,PR$PLCB,PR$STATE TIMEOUT PLIP$SUP.TIMEOUT THEN
               P.NO = RES
               PP.NO = PLIP$PROC.PORTS<1,P.NO+1>
               GOSUB 100
            END
*
            J1 = DCOUNT(ILOCK.TBL,AM)
            FOR J = J1 TO 1 STEP -1
               IF ILOCK.TBL<J,3> < NW THEN
PL_PRINT 'ILOCK: Timeout ' : ILOCK.TBL<J,1> : ' ' : ILOCK.TBL<J,2,1> : ' ' : ILOCK.TBL<J,2,2>
                  OPEN ILOCK.TBL<J,2,1> TO ILOCK.FD THEN
                     RELEASE ILOCK.FD , ILOCK.TBL<J,2,2>
                     ILOCK.FD = ''
                  END
                  ILOCK.TBL = DELETE(ILOCK.TBL,J,0,0)
               END
            NEXT J
         END
*
         PL_READU ILOCK.Q FROM PL$STATE.FD , 'ILOCK*Q' THEN
            I1 = DCOUNT(ILOCK.Q,AM)
            FOR I = 1 TO I1
               L = ILOCK.Q<I>
PL_PR 'ILOCK: ' : L<1,1> : ' ' : L<1,2> : ' ' : L<1,3,1> : ' ' : L<1,3,2> : ' ' : L<1,4> : ' = '
               GOSUB 200
PL_PRINT D<1> : ' ' : D<2>
               WRITE D ON PL$STATE.FD , 'ILOCK*' : L<1,2>
            NEXT I
*
            DELETE PL$STATE.FD , 'ILOCK*Q'
         END ELSE
            RELEASE PL$STATE.FD , 'ILOCK*Q'
         END
*
         READV X FROM PL$PROC.FD , 'CFG*SUP' , 12 THEN
            IF X = '1' THEN
               WRITEV '' ON PL$PROC.FD , 'CFG*SUP' , 12
            END
         END
*
         IF PLIP$PLZ.CLEANUP.FLG THEN
            CALL PLZ.CLEANUP.SUB
         END
*
         SLEEP 1
*
      REPEAT
*
      FOR I = 1 TO DCOUNT(PLIP$PROC.PORTS,VM)
         P.NO = I - 1
         WRITEV 1 ON PL$PROC.FD , 'CFG*' : P.NO , 11
      NEXT I
*
      DELETE PL$PROC.FD , 'CFG*PORTS'
      DELETE PL$PROC.FD , 'CFG*SUP'
*
      IF EXIT.FLG = 99 THEN
         PL_PRINT 'PLW-SUPERVISOR received RECYCLE signal'
         PL_PRINT 'Sleeping 20 seconds'
         SLEEP 20
         PL_PRINT 'Checking to see that children died'
         FOR I = 1 TO DCOUNT(PLIP$PROC.PORTS,VM)
            P.NO = I - 1
            CALL PLWS.GETLOCK(PL$LOCK.FD,'WWW.CTRL,LOCK','V.PORT.NO*':P.NO,L.PORT)
            IF L.PORT = '' THEN
               PL_PRINT 'Process ' : P.NO : ' logged off successfully'
            END ELSE
               PL_PRINT 'About to logoff port ' : L.PORT : ' ... '
               CALL PLWS.LOGOFF(L.PORT,SSTR,ERR.STR)
               PL_PRINT SSTR : ERR.STR
            END
         NEXT I
         RELEASE PL$LOCK.FD , 'SUPERVISOR-PROCESS'
         PL_PRINT 'Executing PLIP-CLEANUP'
         EXECUTE 'PLIP-CLEANUP'
         PL_PRINT 'Restarting Supervisor'
      END
*
      PL_PRINT 'PicLan-IP SUPERVISOR on port ' : PORT.NO : ' stopped.'
      PL_PRINT ''
*
      STOP
*
100   REM Check STA in P.NO
*
      LOG = PL_DATE()
      LOG<2> = PL_TIME()
      LOG<3> = P.NO
      LOG<4> = PR$PLCB
      LOG<5> = PR$STATE
      READVU NEXT.ID FROM PL$CTRL.FD , 'LOGOFF.NEXT.ID' , 1 ELSE NEXT.ID = 1
      WRITE (NEXT.ID+1) ON PL$CTRL.FD , 'LOGOFF.NEXT.ID'
      WRITE LOG ON HANGS.FD , NEXT.ID 'R%6'
*
      IF P.NO = '' THEN RETURN
*
      PL_PRINT 'Process ' : P.NO : ' is hung.'
*
      IF PP.NO = '*' THEN
         CALL PLWS.GETLOCK(PL$LOCK.FD,'WWW.CTRL,LOCK','V.PORT.NO*':P.NO,L.PORT)
         IF L.PORT = '' THEN
            PL_PRINT 'Process appears to already be logged off.'
            PL_PRINT '   or at least the PicLan-IP port item lock is cleared.'
         END ELSE
            PL_PRINT 'About to logoff port ' : L.PORT : ' ... '
            CALL PLWS.LOGOFF(L.PORT,SSTR,ERR.STR)
            PL_PRINT SSTR : ERR.STR
         END
      END ELSE
         PL_PRINT 'Logging off port ' : PP.NO
         CALL PLWS.LOGOFF(PP.NO,SSTR,ERR.STR)
         PL_PRINT SSTR : ERR.STR
         SLEEP 10
      END
*
      EXECUTE 'RECOVER.USERS'
      OS.EXECUTE 'sudo /usr/local/bin/recover-users'
*
      DELETE PL$PROC.FD , P.NO
*
      IF PR$PLCB <> '' THEN
*
         ST$PLCB = PR$PLCB
*
         LOG = PL_DATE()
         LOG<2> = PL_TIME()
         LOG<3> = P.NO
         LOG<4> = PR$PLCB
*
         PL_READ_STATE ELSE MAT ST$ARRAY = ''
         ST$OWN = ''
         ST$IBUF = ''
*
         RESX = ''
         VAR$NAMES = ''
         VAR$CNT = 0
         MAT VAR$VALS = ''
         PL$V.PORT.NO = 'SUP'
         PR$NOW = PL_NOW()
         PL_SETVAR PR$STATE TO '_ERR.PRSTATE' ELSE NULL
*
         SUB.NAME = ''
         I1 = DCOUNT(PR$STATE,' ')
         FOR I = 1 TO I1 WHILE SUB.NAME = ''
            T = FIELD(PR$STATE,' ',I)
            SUB.NAME = OCONV(T,'TWWW.CTRL,PGBASICXREF;X;;1')
         NEXT I
         IF SUB.NAME <> '' THEN
            PL_SETVAR SUB.NAME TO '_ERR.PRSUBNAME' ELSE NULL
         END
*
         BEGIN CASE
            CASE ST$TP = ST.TP.HTTP
               IF PR$STATE = '' THEN
                  R.ERR = '500 INTERNAL ERROR;An internal error has occurred.' : CRLF : CRLF : 'Pick process ' : P.NO : ' has hung without any state information.'
               END ELSE
                  R.ERR = '500 INTERNAL ERROR;An internal server error has occurred.' : CRLF : CRLF : 'Pick process ' : P.NO : ' has hung during:' : CRLF : CRLF : '    ' : PR$STATE
                  READ D FROM PL$STATE.FD , 'RUN*' : P.NO THEN
                     ERR.SRC = ''
                     R.ERR = R.ERR : CRLF : CRLF : 'The next executable statement is:' : CRLF : CRLF : '    ' : D<1,1> : ' ' : D<1,2> : ' ' : D<1,3>
                     OPEN D<1,1> TO SRC.FD THEN
                        READ DD FROM SRC.FD , D<1,2> THEN
                           L0 = D<1,3> - 15
                           L1 = D<1,3> + 15
                           IF L0 < 1 THEN L0 = 1
                           FOR L = L0 TO L1
                              IF L <> D<1,3> THEN
                                 ERR.SRC<-1> = '    ' : L 'R%4' : ' ' : DD<L>
                              END ELSE
                                 ERR.SRC<-1> = '--> ' : L 'R%4' : ' ' : DD<L>
                              END
                           NEXT L
                        END ELSE
                           ERR.SRC = 'Cannot read source item: ' : D<1,1> : ' ' : D<1,2>
                        END
                     END ELSE
                        ERR.SRC = 'Cannot open source file: ' : D<1,1> : ' ' : D<1,2>
                     END
                     DELETE PL$STATE.FD , 'RUN*' : P.NO
                     PL_SETVAR ERR.SRC TO '_ERR.SRC' ELSE NULL
                     CALL PLW.PAGE('/&ERR_BAS2.HTM','','')
                  END ELSE
                     CALL PLW.PAGE('/&ERR_BAS1.HTM','','')
                  END
               END
               LOG<5> = R.ERR
               READVU NEXT.ID FROM PL$CTRL.FD , 'LOGOFF.NEXT.ID' , 1 ELSE NEXT.ID = 1
               WRITE (NEXT.ID+1) ON PL$CTRL.FD , 'LOGOFF.NEXT.ID'
               WRITE LOG ON HANGS.FD , NEXT.ID 'R%6'
*
               IF RESX = '' THEN
                  T = OCONV(R.ERR,'G1;9999')
                  IF T = '' THEN T = R.ERR
                  X = T : CRLF : CRLF
                  MIME.TP = 'text/plain'
               END ELSE
                  X = RESX
                  MIME.TP = 'text/html'
               END
               CALL PLW.BLD.HTTP.HDR(0,FIELD(R.ERR,';',1),0,MIME.TP,'',LEN(X),LL,'')
*
               PL_BCB.SND LL : X
               PL_TCP_CLOSE ST$PLCB ELSE NULL
               ST$CLOSESENT = YES
               ST$KEEP.ALIVE = NO
               PL_TCP_SET_Q ST$PLCB , A.READ+A.WRITE+A.CLOSED ELSE NULL
               PL_WRITE_STATE
               MAT ST$ARRAY = ''
         END CASE
*
      END
*
      IF PP.NO = '*' THEN
         PL_PRINT 'Restarting phantom job for THREAD ' : P.NO : ' ... '
         CALL PLWS.LOGON('*','RESTART ':P.NO,SSTR,ERR.STR)
         PL_PRINT SSTR : ERR.STR
      END ELSE
         PL_PRINT 'Restarting THREAD ' : P.NO : ' on port ' : PP.NO : ' ... '
         CALL PLWS.LOGON(PP.NO,'RESTART ':P.NO,SSTR,ERR.STR)
         PL_PRINT SSTR : ERR.STR
      END
*
      PR$PLCB = ''
      PL$V.PORT.NO = P.NO
      PL_PRSTATE 'Restarted by PLW-SUPERVISOR'
*
      RETURN
*
200   REM ILOCK logic
*
      D = ''
*
      CMD = L<1,1>
      J1 = DCOUNT(ILOCK.TBL,AM)
*
      BEGIN CASE
         CASE CMD = 'LOCK'
            NAME = L<1,3>
            TIMEOUT.VAL = L<1,4>
            FOR J = 1 TO J1
               IF ILOCK.TBL<J,2> = NAME THEN
                  D = 'LOCKED'
                  D<-1> = 'WEB'
                  RETURN
               END
            NEXT J
            OPEN NAME<1,1,1> TO ILOCK.FD ELSE
               D = 'ERROR'
               D<-1> = 'File not found'
               RETURN
            END
            READVU DUMMY FROM ILOCK.FD , NAME<1,1,2> , 1 LOCKED
               CALL PLWS.GETLOCK(ILOCK.FD,NAME<1,1,1>,NAME<1,1,2>,L.PORT)
               IF L.PORT <> '' THEN L.PORT = 'Unknown'
               D = 'LOCKED'
               D<2> = L.PORT
               RETURN
            END ELSE NULL
            DUMMY = ''
            ILOCK.FD = ''
*
            ILOCK.ID = ILOCK.ID + 1
            D = ILOCK.ID
            D<1,2> = NAME
            D<1,3> = NW + TIMEOUT.VAL
            ILOCK.TBL<-1> = D
*
            D = 'OK'
            D<-1> = ILOCK.ID
         CASE CMD = 'UNLOCK'
            ILOCK.ID = L<1,3>
            FOR J = 1 TO J1
               IF ILOCK.TBL<J,1> = ILOCK.ID THEN
                  OPEN ILOCK.TBL<J,2,1> TO ILOCK.FD ELSE
                     D = 'ERROR'
                     D<-1> = 'File not found'
                     ILOCK.TBL = DELETE(ILOCK.TBL,J,0,0)
                     RETURN
                  END
                  RELEASE ILOCK.FD , ILOCK.TBL<J,2,2>
                  ILOCK.TBL = DELETE(ILOCK.TBL,J,0,0)
                  D = 'OK'
                  RETURN
               END
            NEXT J
            D = 'NOT LOCKED'
         CASE CMD = 'CHECK'
            ILOCK.ID = L<1,3>
            TIMEOUT.VAL = L<1,4>
            FOR J = 1 TO J1
               IF ILOCK.TBL<J,1> = ILOCK.ID THEN
                  OPEN ILOCK.TBL<J,2,1> TO ILOCK.FD ELSE
                     D = 'ERROR'
                     D<-1> = 'File not found'
                     ILOCK.TBL = DELETE(ILOCK.TBL,J,0,0)
                     RETURN
                  END
                  IF TIMEOUT.VAL THEN
                     ILOCK.TBL<J,3> = NW + TIMEOUT.VAL
                  END
                  D = 'OK'
                  RETURN
               END
            NEXT J
            D = 'NOT LOCKED'
         CASE YES
            D = 'ERROR'
            D<-1> = 'Unknown command'
      END CASE
*
      RETURN
*
90000 REM Open file group
*
      LOCATE(DATA$FNAME,PL$FILE.LIST;LOC) THEN RETURN
*
      PL$FILE.LIST<-1> = DATA$FNAME
      LOCATE(DATA$FNAME,PL$FILE.LIST;LOC) ELSE NULL
      OPEN DATA$FNAME TO F$ARRAY(LOC) ELSE
         OPEN.ERR = YES
         RETURN
      END
*
      RETURN
   END
