      SUBROUTINE PLW.PAGE(FNAME,MOD.TM,R.ERR)
*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
*
      J.LST = '0FILE' : VM : '1FILE' : VM : '0XXX' : VM : '1XXX' : VM : '0XXX-RAW' : VM : '1XXX-RAW' : VM : '0HOST' : VM : '1HOST' : VM : '0XXX-RAW' : VM : '1XXX-RAW'
*
      R.ERR = ''
      RESX = ''
      PL$PBHDR = ''
*
      IF INDEX(FNAME,'..',1) THEN
         R.ERR = '500 Bad request'
         RETURN
      END
*
      PLW$LEVEL = PLW$LEVEL + 1
*
      IF FNAME[1,1] <> '/' THEN
         IF PL$PGNAME = '' THEN
            FNAME = '/' : FNAME
         END ELSE
            T = OCONV(PL$PGNAME,'G1/999')
            C = COUNT(T,'/')
            IF NOT(C) THEN
               FNAME = '/' : FNAME
            END ELSE
               C = INDEX(T,'/',C)
               FNAME = '/' : T[1,C-1] : '/' : FNAME
            END
         END
      END
*
      IF FNAME[LEN(FNAME),1] = '/' THEN FNAME = FNAME : 'INDEX.HTM'
*
      FNAME = OCONV(FNAME,'MCU')
*
      IF FNAME[1,1] = '&' OR FNAME[1,2] = '/&' THEN
         MATREAD DATA$ARRAY FROM PL$DATA.FD , PL$V.PORT.NO : "*LOCAL" THEN
            FLG = YES
            IF FNAME[1,1] = '/' THEN FNAME = FNAME[2,9999]
            IF FNAME[1,1] = '&' THEN FNAME = FNAME[2,9999]
            IF FNAME[1,4] = 'AMP;' OR FNAME[1,4] = 'amp;' THEN FNAME = FNAME[5,9999]
            IF FNAME[LEN(FNAME),1] = '/' THEN FNAME = FNAME[1,LEN(FNAME)-1]
            DNAME = '/local pages/'
         END ELSE
            R.ERR = '500 INTERNAL ERROR [PLW.PAGE:1];Local content file not found.  [PLW.PAGE:1:' : FNAME : ']'
            RETURN
         END
      END ELSE
         FLG = NO
         IF FNAME[1,LEN(FNAME)] <> '/' THEN FNAME = FNAME : '/'
         I1 = COUNT(FNAME,'/') + 1
         FOR I = I1 TO 1 STEP -1 UNTIL FLG
            DNAME = OCONV(FNAME,'G0/':I) : '/'
            MATREAD DATA$ARRAY FROM PL$DATA.FD , PL$V.PORT.NO : '*' : ST$IP : DNAME THEN
               FLG = YES
               FNAME = OCONV(FNAME,'G':I:'/99')
               BEGIN CASE
                  CASE FNAME = '/'
                     FNAME = ''
                  CASE FNAME[LEN(FNAME),1] = '/'
                     FNAME = FNAME[1,LEN(FNAME)-1]
               END CASE
            END
         NEXT I
      END
*
      IF FLG THEN
         IF INDEX(FNAME,'/',1) AND NOT(INDEX(DATA$OPT,'S',1)) THEN
            FLG = NO
         END
      END
*
      IF NOT(FLG) THEN
         R.ERR = '404 NOT FOUND [PLW.PAGE:2];Directory not found.  [PLW.PAGE:2:' : FNAME : ']'
         PLW$LEVEL = PLW$LEVEL - 1
         RETURN
      END
*
      IF LEN(FNAME) > (MAX.ID.LEN-12) THEN
         IF INDEX(FNAME,'/',1) THEN
            R.ERR = '404 NOT FOUND [PLW.PAGE:3];Directory format is invalid (too long).  [PLW.PAGE:3:' : FNAME : ']'
            PLW$LEVEL = PLW$LEVEL - 1 
            RETURN
         END ELSE
            R.ERR = '404 NOT FOUND [PLW.PAGE:4];File name format is invalid (too long).  [PLW.PAGE:4:' : FNAME : ']'
            PLW$LEVEL = PLW$LEVEL - 1
            RETURN
         END
      END
*
      PL$PGNAME = DATA$PREFIX : DNAME : FNAME
*
      IF PLW$LEVEL = 1 THEN
         IF INDEX(DATA$OPT,'D',1) THEN
            IF INDEX(DATA$OPT,'A',1) THEN
               FLG = YES
            END ELSE
               FILE.TP = FIELD(FNAME,'/',DCOUNT(FNAME,'/'))
               FILE.TP = FIELD(FILE.TP,'.',DCOUNT(FILE.TP,'.'))
               READV M.TP FROM PL$CTRL.FD , 'MIME*' : FILE.TP , 1 ELSE
                  READV M.TP FROM PL$CTRL.FD , 'MIME*' , 1 ELSE
                     M.TP = ''
                  END
               END
               IF M.TP = 'text/html' THEN
                  FLG = YES
               END ELSE
                  FLG = NO
               END
            END
            IF FLG THEN
               PL_SETVAR FNAME TO '_FNAME' ELSE NULL
               CALL PLW.PAGE(DNAME:'__DEFAULT.HTM',MOD.TM,R.ERR)
               RETURN
            END
         END
      END
*
      C.OPT = ( INDEX(DATA$OPT,'C',1) <> 0 )
      LOCATE(C.OPT:DATA$TP,J.LST,1;L) ELSE
         R.ERR = '500 INTERNAL ERROR [PLW.PAGE:5];Internal Error, invalid directory type.  [PLW.PAGE:5]'
         PLW$LEVEL = PLW$LEVEL - 1
         RETURN
      END
*
      ON L GOSUB 100,200,100,200,300,300,100,200,400,400
      IF R.ERR <> '' THEN RETURN
*
      IF CTRL$TP THEN
         ON CTRL$TP GOSUB 11000,12000
      END
*
      PLW$LEVEL = PLW$LEVEL - 1
*
      RETURN
*
100   REM FILE
*
      LK.CNT = 0
      NEED.BLD.FLG = YES
      LOOP WHILE NEED.BLD.FLG AND LK.CNT < 2 DO
         NEED.BLD.FLG = NO
         LK.CNT = LK.CNT + 1
         IF LK.CNT = 2 THEN
            READU DUMMY FROM PL$LOCK.FD , 'PLW.PAGE' ELSE NULL
         END
         MATREAD CTRL$ARRAY FROM PL$PGCTRL.FD , PL$PGNAME THEN
            T = PR$NOW - CTRL$CACHETM
            IF T < 0 OR T >= PLIP$WWW.CACHE.TIMEOUT THEN
               READ SRC0 FROM PL$PGCACHE.FD , PL$PGNAME THEN
                  CALL PLW.GET.PAGE(FNAME,DATA.TP,SRC1)
                  IF SRC1 <> '' THEN
                     IF SRC0 = SRC1 THEN
                        CTRL$CACHETM = PR$NOW
                        WRITEV CTRL$CACHETM ON PL$PGCTRL.FD , PL$PGNAME , CTRL$CACHETM$N
                     END ELSE
                        IF LK.CNT < 2 THEN
                           NEED.BLD.FLG = YES
                        END ELSE
                           CALL PLW.BLD.FILE(DATA$FNAME,FNAME,SRC1,R.ERR)
                           IF R.ERR = '' THEN
                              WRITE SRC1 ON PL$PGCACHE.FD , PL$PGNAME
                           END
                        END
                     END
                  END ELSE
                     R.ERR = '404 NOT FOUND [PLW.PAGE:6];File not found.  [PLW.PAGE:6:' : FNAME : ']'
                  END
               END ELSE
                  IF LK.CNT < 2 THEN   
                     NEED.BLD.FLG = YES
                  END ELSE
                     CALL PLW.GET.PAGE(FNAME,DATA.TP,SRC1)
                     IF SRC1 <> '' THEN
                        CALL PLW.BLD.FILE(DATA$FNAME,FNAME,SRC1,R.ERR)
                        IF R.ERR = '' THEN
                           WRITE SRC1 ON PL$PGCACHE.FD , PL$PGNAME
                        END
                     END ELSE
                        R.ERR = '404 NOT FOUND [PLW.PAGE:7];File not found.  [PLW.PAGE:7:' : FNAME : ']'
                     END
                  END
               END
            END ELSE
*$*            PL_PR 'CACHE '
            END
         END ELSE
            IF LK.CNT < 2 THEN
               NEED.BLD.FLG = YES
            END ELSE
               CALL PLW.GET.PAGE(FNAME,DATA.TP,SRC1)
               IF SRC1 <> '' THEN
                  CALL PLW.BLD.FILE(DATA$FNAME,FNAME,SRC1,R.ERR)
                  IF R.ERR = '' THEN
                     WRITE SRC1 ON PL$PGCACHE.FD , PL$PGNAME
                  END
               END ELSE
                  R.ERR = '404 NOT FOUND [PLW.PAGE:8];File not found.  [PLW.PAGE:8:' : FNAME : ']'
               END
            END
         END
*
      REPEAT
*
      IF LK.CNT >= 2 THEN
         RELEASE PL$LOCK.FD , 'PLW.PAGE'
      END
*
      RETURN
*
200   REM FILE - no cache check
*
      MATREAD CTRL$ARRAY FROM PL$PGCTRL.FD , PL$PGNAME ELSE GOTO 100
      RETURN
*
300   REM XXXRAW
*
      RETURN
*
400   REM HOSTRAW
*
      RETURN
*
*
11000 REM Process type '1' GET requests
*
      IF MOD.TM <> '' THEN
         IF MOD.TM = CTRL$TM THEN
            R.ERR = '304 NOT MODIFIED'
            PL$PBHDR = CTRL$NMHDR<1,1> : PL_TODATE(PL_NOW()-PLIP$TZ) : CTRL$NMHDR<1,2>
            RETURN
         END
      END
*
      READ RESX FROM PL$PGDATA.FD , PL$PGNAME ELSE
         R.ERR = '500 INTERNAL ERROR [PLW.PAGE:9];Internal Error, unable to read image item.  [PLW.PAGE:9]'
         RETURN
      END
*
      PL$PBHDR = CTRL$HDR<1,1> : PL_TODATE(PL_NOW()-PLIP$TZ) : CTRL$HDR<1,2>
*
      RETURN
*
12000 REM Process type '2' GET requests
*
      PL_PRSTATE 'Calling embedded subroutine ' : CTRL$SUB
      DELETE PL$STATE.FD , 'RUN*' : PL$V.PORT.NO
      VAR = CTRL$SUB
      CALL @VAR(R.ERR)
      DELETE PL$STATE.FD , 'RUN*' : PL$V.PORT.NO
      PL_PRSTATE ''
      CTRL$TMS = ''
*
      RETURN
   END
