C	This program is a demonstration of a DECthreads server script written
C	in a language other than DCL or C.
C
C	This script assumes it was invoked as a presentation script, meaning
C	the URL passed to it is the name of the file to 'convert'.  To set
C	up the presentation, add the following lines to your configuration:
C
C	    suffix .url application/redirect 8BIT 1.0
C	    presentation application/redirect www_root:[bin]redirect.exe
C
C	The first line of the file to be 'converted' is read and passed
C	back to the server as the location in a redirect.  The first 
C	first line of the .url file must be a complete URL specification.
C-
	PROGRAM REDIRECT_SCRIPT
	INTEGER NET_LINK, STATUS, LENGTH, LIB$GET_SYMBOL, ULEN, TBL_IND
	INTEGER I, ULUN, LAST_SLASH, J
	CHARACTER LINE*1024, URL*255
C
C	Get URL to open the cheap way - translate DCL symbol used by WWWEXEC.COM
C
	STATUS = LIB$GET_SYMBOL ( 'url', URL, ULEN, TBL_IND )
C
C	Connect to network link established by WWWEXEC.COM
C
	CALL LIB$GET_LUN ( NET_LINK )
	OPEN ( UNIT=NET_LINK, FILE='NET_LINK:', STATUS='OLD', 
	1	FORM='FORMATTED', CARRIAGECONTROL='NONE', RECL=4096 )
C
C	Convert URL in file to VMS format.
C
	LAST_SLASH = 1
	DO I = 2, ULEN
	    URL(I-1:I-1) = URL(I:I)
	    IF ( URL(I:I) .EQ. '/' ) THEN
		URL(I-1:I) = ':['
		LAST_SLASH = I
		DO J = I+1, ULEN
		    IF ( URL(J:J) .EQ. '/' ) THEN
			LAST_SLASH = J
			URL(J:J) = '.'
		    END IF
		END DO
		GOTO  10
	    END IF
	END DO
10	CONTINUE
	URL(LAST_SLASH:LAST_SLASH) = ']'
C
C	Open URL file and read first line.
C
40	FORMAT ( Q, A )
	CALL LIB$GET_LUN ( ULUN )
	OPEN ( UNIT=ULUN, FILE=URL(:ULEN), STATUS='OLD', READONLY, 
	1	FORM='FORMATTED', CARRIAGECONTROL = 'LIST', ERR=300 )
	READ ( ULUN, 40, ERR=350 ) LENGTH, LINE(:MIN(LEN(LINE),LENGTH))
	CLOSE ( ULUN )
C
C	Send redirect message.
C
50	FORMAT ( A, A, A, A )
	WRITE ( NET_LINK, 50 ) '<DNETCGI>'
	WRITE ( NET_LINK, 50 ) 'status: 302 redirect via Fortran script',
	1	CHAR(13)//CHAR(10)//'Location: ', LINE(:LENGTH),
	2	CHAR(13)//CHAR(10)//CHAR(13)//CHAR(10)
	TYPE*,'Writing cgi terminator'
	WRITE ( NET_LINK, 50 ) '</DNETCGI>'
	TYPE*,'Wrote cgi terminator'
	CLOSE ( NET_LINK )
	CALL EXIT ( 1 )
C
C	Open error.
C
300	TYPE*,'Open error on file'
	WRITE ( NET_LINK, 50 ) '<DNETCGI>'
	WRITE ( NET_LINK, 50 ) 'status: 404 Open error on file',
	1	CHAR(13)//CHAR(10)//'Content-type: text/plain',
	2	CHAR(13)//CHAR(10)//CHAR(13)//CHAR(10)
	WRITE ( NET_LINK, 50 ) 'Error openning file: ', URL(:ULEN)
	WRITE ( NET_LINK, 50 ) '</DNETCGI>'
	CLOSE ( NET_LINK )
	CALL EXIT ( 1 )
C
C	Read error on file.
C
350	TYPE*,'Read error on file'
	WRITE ( NET_LINK, 50 ) '<DNETCGI>'
	WRITE ( NET_LINK, 50 ) 'status: 500 Read error on file',
	1	CHAR(13)//CHAR(10)//'Content-type: text/plain',
	2	CHAR(13)//CHAR(10)//CHAR(13)//CHAR(10)
	WRITE ( NET_LINK, 50 ) 'Error reading file'
	WRITE ( NET_LINK, 50 ) '</DNETCGI>'
	CLOSE ( NET_LINK )
	CALL EXIT ( 1 )
	
	END
