! ! CGI interface library for Fortran 90 ! Copyright The Numerical Algorithms Group Ltd, Oxford, UK. 1995. ! ! Author: R.M.J.Iles (R.M.J.Iles@nag.co.uk) ! Version: 1.0 (Aug95) ! ! Provides the capability for writing Fortran 90 programs that comply ! with the Common Gateway Interface (CGI) standard for WWW clients ... ! ! See TEMPLATE program at the end for example of use ..... ! ! subroutine cgi_init(ok) ! call this first, recovers the information from the CGI invocation ! and returns status logical (ok). If ok is true then proceed, if ! ok is false then "Content-type: text/html" and an error message ! has already been returned to the user ! ! POST method requires NAGWare f90 compiler release 2.2 or later ! GET method has buffer limit of 4096 characters ! ! Information is returned in a global ISO Varying Length String array ! (cgi_entries) of datatype `namevalue' and size `number_of_entries' ! MODULE cgi_utils ! ! Use the unix interface module supplied with NAGWare f90 (f90_unix) ! Use the iso_varying_string module (available via http://www.nag.co.uk/) ! Use the i/o status module supplied with NAGWare f90 (also available ! for other compilers) ! USE f90_unix USE iso_varying_string USE f90_iostat PRIVATE PUBLIC :: cgi_entries, number_of_entries, cgi_init, namevalue, & varying_string TYPE namevalue TYPE (varying_string) :: name TYPE (varying_string) :: value END TYPE namevalue TYPE (namevalue), ALLOCATABLE :: cgi_entries(:) INTEGER :: number_of_entries CONTAINS !-------------------------------------------------------------------- SUBROUTINE cgi_init(ok) IMPLICIT NONE LOGICAL :: ok, report = .FALSE. CHARACTER (len=4096) :: vbuffer CHARACTER (len=64) :: method, content, length CHARACTER (len=16) :: hex = '0123456789ABCDEF' CHARACTER (len=1) :: c CHARACTER (len=2) :: digits TYPE (varying_string) :: buffer INTEGER :: i_length = 0 INTEGER :: i, status, i1, i2 ok = .FALSE. ! ! Check method ! CALL getenv('REQUEST_METHOD',method) ! ! POST method recovery ! IF (method=='POST') THEN ! ! Check content type .... ! CALL getenv('CONTENT_TYPE',content) IF (content/='application/x-www-form-urlencoded') THEN IF ( .NOT. report) THEN WRITE (*,'("Content-type: text/html"/)') report = .TRUE. END IF WRITE (*,'("

Routine can only be used to decode form")') WRITE (*,'("results, not: ",a,"

")') trim(content) RETURN END IF ! ! Find out the length of the string being passed ! CALL getenv('CONTENT_LENGTH',length) i = 1 i_length = atoi(length,i) ! ! Read the string into the buffer and count the number of entries ! buffer = '' number_of_entries = 1 DO i = 1, i_length READ (*,'(a)',advance='no',iostat=status) c ! write(*,'(a)',advance='no')c IF (status/=ioerr_ok) THEN IF ( .NOT. report) THEN WRITE (*,'("Content-type: text/html"/)') report = .TRUE. END IF WRITE (*,'("

READ Failure ",i,"

")') status RETURN ELSE IF (c=='&') number_of_entries = number_of_entries + 1 buffer = buffer // c END IF END DO ! ! GET method recovery ! ELSE IF (method=='GET') THEN CALL getenv('QUERY_STRING',vbuffer) buffer = vbuffer IF (vbuffer==' ') THEN number_of_entries = 0 ok = .TRUE. RETURN END IF number_of_entries = 1 DO i = 1, len_trim(vbuffer) IF (vbuffer(i:i)=='&') number_of_entries = number_of_entries + 1 END DO ! ! Unsupported method ! ELSE IF ( .NOT. report) THEN WRITE (*,'("Content-type: text/html"/)') report = .TRUE. END IF WRITE (*,'("

This script can only be used for ")') WRITE (*,'("POST and GET methods, not: ",a,"

")') trim(method) RETURN END IF ! ! Split up the buffer into entries and start to handle escaped ! characters ! ALLOCATE (cgi_entries(number_of_entries)) buffer = replace(buffer,target='+',substring=' ',every=.TRUE.) buffer = replace(buffer,target='%2B',substring='+',every=.TRUE.) DO i = 1, number_of_entries CALL split(buffer,cgi_entries(i)%value,'&') cgi_entries(i) %value = replace(cgi_entries(i)%value,target='%26', & substring='&',every=.TRUE.) CALL split(cgi_entries(i)%value,cgi_entries(i)%name,'=') cgi_entries(i) %value = replace(cgi_entries(i)%value,target='%3D', & substring='=',every=.TRUE.) cgi_entries(i) %name = replace(cgi_entries(i)%name,target='%3D', & substring='=',every=.TRUE.) cgi_entries(i) %name = replace(cgi_entries(i)%name,target='%25', & substring='#+#',every=.TRUE.) cgi_entries(i) %value = replace(cgi_entries(i)%value,target='%25', & substring='#+#',every=.TRUE.) ! ! Handle % , note %25 (code for % itself) is turned ! temporarily into #+# to make life easier .... ! DO i1 = index(cgi_entries(i)%name,'%') IF (i1==0) EXIT digits = extract(cgi_entries(i)%name,i1+1,i1+2) i2 = index(hex,digits(1:1)) - 1 i2 = 16*i2 + (index(hex,digits(2:2))-1) cgi_entries(i) %name = replace(cgi_entries(i)%name,start=i1, & finish=i1+2,substring=char(i2)) END DO DO i1 = index(cgi_entries(i)%value,'%') IF (i1==0) EXIT digits = extract(cgi_entries(i)%value,i1+1,i1+2) i2 = index(hex,digits(1:1)) - 1 i2 = 16*i2 + (index(hex,digits(2:2))-1) cgi_entries(i) %value = replace(cgi_entries(i)%value,start=i1, & finish=i1+2,substring=char(i2)) END DO cgi_entries(i) %name = replace(cgi_entries(i)%name,target='#+#', & substring='%',every=.TRUE.) cgi_entries(i) %value = replace(cgi_entries(i)%value,target='#+#', & substring='%',every=.TRUE.) END DO ! ! Recover space and return ! buffer = '' ok = .TRUE. END SUBROUTINE cgi_init !-------------------------------------------------------------------- ! ! Convert string to integer ! FUNCTION atoi(string,i) RESULT (value) CHARACTER (len=*) :: string INTEGER :: i, ii, max, sign, value CHARACTER (len=10), PARAMETER :: digit = '0123456789' max = len(string) value = 0 sign = 1 CALL skipbl(string,i) IF (string(i:i)=='-') THEN sign = -1 i = i + 1 END IF DO i = i, max ii = index(digit,string(i:i)) IF (ii==0) THEN value = sign*value RETURN END IF value = (value*10) + (ii-1) END DO END FUNCTION atoi !-------------------------------------------------------------------- ! ! Skip blanks in a string, used by ATOI ! SUBROUTINE skipbl(string,i) CHARACTER (len=*) :: string INTEGER :: i, max max = len(string) IF (string(i:)==' ') THEN i = max ELSE DO i = i, max IF (string(i:i)/=' ') EXIT END DO END IF END SUBROUTINE skipbl !-------------------------------------------------------------------- !Program Template !! !! Use the unix interface module supplied with NAGWare f90 !! !use cgi_utils !use iso_varying_string ! ! logical :: ok !! !! Initialise the CGI connection and continue if ok ..... !! ! call cgi_init(ok) ! if(ok)then !! !! Output the datatype and a blank line !! ! write (*,'("Content-type: text/html"/)') !! !! Output the entries (put_line is from iso_varying_string) !! ! do i=1, number_of_entries ! call put_line(cgi_entries(i)%name) ! call put_line(' := ') ! call put_line(cgi_entries(i)%value) ! call put_line('
') ! enddo ! endif ! ! end program Template END MODULE cgi_utils