! ! Skeleton for testing whether fortransockets working ! program httpserver integer :: connection, handle, i, ios, iport, istat integer, dimension(4) :: iaddress character (len=80) :: nam character (len=256) :: lin integer :: buffpos character (len=10000) :: buff integer :: div, nlin, nreq, space logical :: fin character (len=250) :: header, footer character (len=62) :: doctype character (len=2) :: crlf character (len=19) :: hmess1 character (len=10) :: indexfile crlf=char(10) // char(13) indexfile='index.html' hmess1='HTTP/1.0 200 OK' // crlf // crlf doctype='' header='\n\nF95 Web server\n' // & '\n' // & '\n\n' footer='\n\n\n' iport=9000 call fortran_mkserver(iport, handle, istat) if (istat /= 0) then write(*,*) 'ERROR: Unable to open port ', iport stop end if nreq=0 buff=' ' do write(*,*) 'Listening...' call fortran_accept(handle, connection, istat) write(*,*) 'Accepted...', handle if (istat==0) then call fortran_receive(connection, buff, istat) nreq=nreq+1 write(*,*) nlin, '(istat=', istat, '): ', trim(buff) write(nam,'(i5,a)') nlin, ': ' fin=.false. buffpos=1 call getlin(buffpos, buff, lin, fin) if (lin(1:6)=='GET / ') then open(10, file=indexfile, status='old', iostat=ios) if (ios == 0) then call fortran_send(connection, hmess1, istat) do read(10, '(a)', iostat=ios) buff if (ios /= 0) then exit end if call fortran_send(connection, trim(buff), istat) end do close(10) else call fortran_send(connection, doctype, istat) call fortran_send(connection, trim(header), istat) call fortran_send(connection, trim(nam) // '

Error 404: Page not found', istat) call fortran_send(connection, trim(footer), istat) end if else if (lin(1:5)=='POST ') then call fortran_send(connection, hmess1, istat) call fortran_send(connection, doctype, istat) call fortran_send(connection, trim(header), istat) call fortran_send(connection, '

Table of variables in POST requests:\n' , istat) call fortran_send(connection, '

KeywordValue' , istat) nlin=0 do while (.not.fin) nlin=nlin+1 call getlin(buffpos, buff, lin, fin) space=index(lin(1:len_trim(lin)), ' ') div=index(lin(1:len_trim(lin)), '=') if (space > 0) then continue else if (div > 0) then call fortran_send(connection, '
' , istat) call fortran_send(connection, lin(1:(div-1)), istat) call fortran_send(connection, '' , istat) lin=lin((div+1):len_trim(lin)) call depost(lin) call fortran_send(connection, trim(lin), istat) end if end do call fortran_send(connection, '
', istat) call fortran_send(connection, trim(footer), istat) else call fortran_send(connection, doctype, istat) call fortran_send(connection, trim(header), istat) call fortran_send(connection, trim(nam) // '

Error 501: Not implemented', istat) call fortran_send(connection, trim(footer), istat) end if call fortran_closeserver(connection, istat) end if end do call fortran_closeserver(handle, istat) end program httpserver ! ! getline ! subroutine getlin(pos, buff, lin, fin) integer, intent(in out) :: pos character (len=*), intent (in out) :: buff character (len=*), intent (out) :: lin logical, intent(out) :: fin integer :: sta sta=pos eob=len_trim(buff) do if (pos > eob) exit if (buff(pos:pos) == char(10) .or. & buff(pos:pos) == char(13) .or. & buff(pos:pos) == char(38)) exit pos=pos+1 end do lin=buff(sta:(pos-1)) do if (pos > eob) exit if (buff(pos:pos) /= char(10) .and. & buff(pos:pos) /= char(13) .and. & buff(pos:pos) /= char(38)) exit pos=pos+1 end do fin=(pos >= eob) end subroutine getlin ! ! Transform HTML hexadecimal codes etc from POSTed text ! subroutine depost(string) character (len=*) :: string integer :: i, eos, ich character (len=2) :: hex eos=len_trim(string) i=1 do if (i > eos) exit if (string(i:i)=='+') then string(i:i)=' ' else if (string(i:i)=='%') then if (string(i:(i+5))=='%0D%0A') then string=string(1:(i-1)) // '
' // string((i+6):eos) i=i+3 eos=eos-2 else hex=string((i+1):(i+2)) read(hex, '(Z2)') ich string=string(1:(i-1)) // char(ich) // string((i+3):eos) eos=eos-2 end if end if i=i+1 end do end subroutine depost