diff options
| -rw-r--r-- | CMakeLists.txt | 24 | ||||
| -rw-r--r-- | LICENSE | 13 | ||||
| -rw-r--r-- | README.md | 30 | ||||
| -rwxr-xr-x | src/3rd/flibs/Copyright | 27 | ||||
| -rw-r--r-- | src/3rd/flibs/README | 117 | ||||
| -rwxr-xr-x | src/3rd/flibs/src/cgi/cgi_protocol.f90 | 541 | ||||
| -rwxr-xr-x | src/3rd/flibs/src/cgi/fcgi_protocol.f90 | 183 | ||||
| -rwxr-xr-x | src/3rd/flibs/src/datastructures/dictionary.f90 | 269 | ||||
| -rwxr-xr-x | src/3rd/flibs/src/datastructures/linkedlist.f90 | 242 | ||||
| -rw-r--r-- | src/main.f90 | 52 |
10 files changed, 1498 insertions, 0 deletions
diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..d409cc4 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,24 @@ +CMAKE_MINIMUM_REQUIRED (VERSION 3.6) +PROJECT (Fortran-FCGI) + +ENABLE_LANGUAGE (Fortran) + +IF (CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + SET (CMAKE_Fortran_FLAGS "-Wall") +ENDIF () + +FIND_LIBRARY (LIBFASTCGI fcgi) + +ADD_EXECUTABLE (fortran-fcgi + src/3rd/flibs/src/cgi/cgi_protocol.f90 + src/3rd/flibs/src/cgi/fcgi_protocol.f90 + src/main.f90 +) + +TARGET_INCLUDE_DIRECTORIES (fortran-fcgi + PRIVATE src/3rd/flibs/src/datastructures +) + +TARGET_LINK_LIBRARIES (fortran-fcgi + ${LIBFASTCGI} +) @@ -0,0 +1,13 @@ + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + Version 2, December 2004 + + Copyright (C) 2004 Sam Hocevar <sam@hocevar.net> + + Everyone is permitted to copy and distribute verbatim or modified + copies of this license document, and changing it is allowed as long + as the name is changed. + + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. You just DO WHAT THE FUCK YOU WANT TO. diff --git a/README.md b/README.md new file mode 100644 index 0000000..b5400c7 --- /dev/null +++ b/README.md @@ -0,0 +1,30 @@ +FastCGI program in Fortran +========================== + +This is a template [FastCGI](https://en.wikipedia.org/wiki/FastCGI) program written in Fortran. +It uses [libfcgi](https://packages.debian.org/source/sid/libfcgi), so no magic here ;) + +Interface to `libfcgi` is taken from the [Flibs collection](http://flibs.sourceforge.net/). + + +Building +======== + +`libfcgi` is required. Building is tested with [GNU Fortran](https://gcc.gnu.org/fortran/) only. + + +The build is based on [CMake](https://cmake.org/), but if you wish: + +```sh +$ gfortran -I src/3rd/flibs/src/datastructures src/3rd/flibs/src/cgi/*.f90 src/main.f90 -lfcgi -o fortran-fcgi +``` + +Building with CMake: + +```sh +$ mkdir build +$ cd build +$ cmake .. +$ make +``` + diff --git a/src/3rd/flibs/Copyright b/src/3rd/flibs/Copyright new file mode 100755 index 0000000..92ad5b5 --- /dev/null +++ b/src/3rd/flibs/Copyright @@ -0,0 +1,27 @@ +Copyright (c) 2008, Arjen Markus + +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. +Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. +Neither the name of the author nor the names of the contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + diff --git a/src/3rd/flibs/README b/src/3rd/flibs/README new file mode 100644 index 0000000..1b923de --- /dev/null +++ b/src/3rd/flibs/README @@ -0,0 +1,117 @@ +Flibs, version 0.9, december 2008 +--------------------------------- + +What is Flibs +------------- +Flibs is a collection of Fortran modules for various tasks: +- [cgi] facilitate web programming via CGI +- [checking] checking various aspects of the code via instrumentation + and static analysis +- [computing] computational tasks, such as automatic differentiation +- [controlstructures] flow control structures such as finite state machines +- [datastructures] support for implementing linked lists, dictionaries + and the like +- [filedir] OS-level tasks regarding files and directories +- [funit] a framework for unit testing, inspired by JUnit +- [ipc] inter-process communication +- [lemon] Lex/Yacc-like parser generation +- [platform] utilities to query the OS and the platform running the + program +- [reporting] tools for generating reports in various formats + (notably LaTex and HTML) +- [specs] tool to generate a robust reading routine from specifications, + geared to tabular input +- [sqlite] interface to the SQLite database management system (http//www.sqlite.org) +- [streams] modules to treat files as "streams" rather than record-oriented +- [strings] modules to manipulate strings (tokenizing, varying-length strings) +- [tools] preprocessor tool to manipulate the source code +- [wrapper] tool to generate Fortran 90 and Fortran 2003 interfaces to C + routines from the C header files + +Furthermore: +- [app] a tool for generating makefile dependencies from the Fortran + source code and an experiment at "literate programming". +- [chksys] a collection of programs to probe the properties of the + Fortran compiler (with a similar program for C) +- [doc] documentation for the various modules (in HTML form) and several + articles. +- [experiments] various experiments with different programming + paradigms. +- [testmake] a program suite to generate test programs from + simple specifications. + +Documentation is not complete, but most if not all modules and utilities +come with a comprehensive example/test case. + +The Flibs project is located on SourceForge: http://flibs.sf.net + + +Building the modules +-------------------- + +Each directory under the "src" directory contains one or more modules or +tools. The corresponding directory under "tests" contains the +test/example programs and makefiles (or in some case project files for +MS Developer Studio with Compaq Visual Fortran as the Fortran compiler). +Each set can be built on its own. + +The makefiles are set up using macros to take care of differences in +compilers and compiler options. In principle it should not be necessary +to adapt the makefiles to your particular compiler, unless it is doing +things in a completely different way than: +- Compile the individual sources +- Link the resulting object files into an executable + +The simple configuration system (configure.sh and configure.bat) helps +to set up the macros for the makefiles: +- configure.sh probes various compilers under Linux, Cygwin or MinGW +- configure.bat is meant for Windows + +You can select the compiler you prefer, g95, gfortran, f95, cvf, +for instance: + + > configure.sh gfortran + +Or you can select a type of build (normal, debug, optimise): + + > configure.sh -optimise + + +Status of the modules +--------------------- + +Not all modules and utilities included in the 0.9 release are fully +functional yet. They have been included mainly for completeness and +as a reminder: + +- the genetic_algorithms module typically converges too fast, so that + a suboptimal solution is returned. +- the tupleserver program is not quite finished yet, but as tuple spaces + are a very interesting construct to achieve concurrency, it is + included here. +- the fwrapper program, meant to generate C/C++ interfaces from Fortran + code is still in its infancy. The cwrap program (written in Tcl) is + functional though. + + +Tcl utilities +------------- + +While most of the code is written in standard Fortran 90, as far as the +authors are aware, the collection also contains several utilities +written in Tcl. If you do not have a Tcl installation, you can either +get a full installation from www.activestate.com or you can use a +standalone runtime executable from www.equi4.com. + + +Copyright +--------- + +Most of the source files have been written by Arjen Markus. The modules +under "filedir", "platform" and several modules in other directories +have been written by Michael Baudin. The date/time module under +"computing" has been supplied by Arjan van Dijk. + +All source code in this project is licensed via the BSD license (see +the "Copyright" file). Basically this means: +Do what you want with it, but do not claim it is your original work. diff --git a/src/3rd/flibs/src/cgi/cgi_protocol.f90 b/src/3rd/flibs/src/cgi/cgi_protocol.f90 new file mode 100755 index 0000000..6ce9f0b --- /dev/null +++ b/src/3rd/flibs/src/cgi/cgi_protocol.f90 @@ -0,0 +1,541 @@ +! cgi_protocol.f90 -- +! Module for interfacing with a web server via the CGI protocol +! (GET, POST, ...) +! +! TODO: +! - find out how to deal with text area data +! - find out how to deal with uploaded files +! - merge environment variables into the cgi_get routines +! - implement the SCGI protocol +! - implement delayed responses (also via customisable template) +! +module cgi_protocol + implicit none + + integer, parameter :: DICT_KEY_LENGTH = 80 + integer, parameter :: DICT_VALUE_LENGTH = 200 + integer, parameter :: DICT_BUFFER_LENGTH = DICT_KEY_LENGTH + DICT_VALUE_LENGTH + 1 + + integer, parameter :: output_no_header = 0 + integer, parameter :: output_html = 1 + integer, parameter :: output_text = 2 + integer, parameter, private :: output_html_delayed = 3 ! Not implemented yet! + integer, parameter, private :: output_text_delayed = 4 + + type DICT_DATA + character(len=DICT_VALUE_LENGTH) :: value + end type DICT_DATA + + interface cgi_get + module procedure cgi_get_string + module procedure cgi_get_integer + module procedure cgi_get_real + end interface + + type(DICT_DATA), parameter :: dict_null = dict_data('') + + integer, private, save :: method = -1 + integer, private, save :: luout_cgi = -1 + logical, private, save :: header_written + +! +! Body of source code for storing and retrieving the data +! (also contains the CONTAINS clause) +! +include 'dictionary.f90' + +! cgi_begin -- +! Determine the type of interaction with the server and retrieve the data +! +! Arguments: +! html Whether the output will be HTML or plain text +! dict Dictionary holding the information from the server (output) +! luout LU-number for writing the file (output!) +! +! Note: +! This routine determines the way the server passes on the data +! by looking for clues in the environment variables QUERY_LENGTH +! and QUERY_STRING +! +! +! TODO: +! Support for two-pass run (if the computation takes a longer +! than a few seconds) +! +subroutine cgi_begin( html, dict, luout ) + integer, intent(in) :: html + type(DICT_STRUCT), pointer :: dict + integer, intent(out) :: luout + + integer :: length + integer :: status + logical :: opend + character(len=DICT_BUFFER_LENGTH) :: string + character(len=1) :: ch + + ! + ! Clean up, if necessary + ! + if ( associated(dict) ) then + call dict_destroy( dict ) + endif + + header_written = .false. + + ! + ! Determine which input method + ! + call get_environment_variable( "QUERY_STRING", length=length, status=status ) + if ( status == 0 ) then + call cgi_get_method( dict, length ) + method = 1 + else + call get_environment_variable( "CONTENT_LENGTH", value=string, status=status ) + if ( status == 0 ) then + read( string, * ) length + call cgi_post_method( dict, length ) + method = 1 + else + read( *, '(A)', advance = 'no' ) ch + if ( ch == '%' ) then + ! + ! TODO: better method for determining length + call cgi_dustmote_method( dict ) + method = 2 + elseif ( index( '1234567890', ch ) > 0 ) then + ! call cgi_simple_cgi( dict ) + method = -1 + else + method = -1 + endif + endif + endif + + ! + ! If we did not get the correct information, just blow the + ! whole thing off + ! + if ( method == -1 ) then + call cgi_error( "CGI protocol not recognised or not implemented" ) + endif + + ! + ! What LU-number for the output + ! method 1: write directly to standard output (assumed to be at unit 6) + ! method 2: write to a file first (cgiout) + ! + if ( method == 1 ) then + luout = 6 + endif + if ( method == 2 ) then + do luout = 10,99 + inquire( luout, opened = opend ) + if ( .not. opend ) then + exit + endif + enddo + open( luout, file = 'cgiout' ) + endif + luout_cgi = luout + + ! + ! Write the header lines + ! + select case ( html ) + case ( output_html, output_text ) + call cgi_header( html ) + case( output_html_delayed, output_text_delayed ) + ! TODO + case( output_no_header ) + ! Writing the header is delayed, because the type is not known yet + case default + call cgi_error( "Programming error: wrong value for parameter 'html' in CGI_BEGIN" ) + end select + +end subroutine cgi_begin + +! cgi_header -- +! Write the CGI header information +! +! Arguments: +! type Type of header +! +subroutine cgi_header( type ) + integer, intent(in) :: type + + header_written = .true. + + select case ( type ) + case ( output_html, output_html_delayed ) + write( luout_cgi, '(a)' ) 'Content-Type: text/html;charset=iso8859-1' + write( luout_cgi, '(a)' ) '' + case( output_text, output_text_delayed ) + write( luout_cgi, '(a)' ) 'Content-Type: text/plain;charset=iso8859-1' + write( luout_cgi, '(a)' ) '' + case( output_no_header ) + call cgi_error( "Programming error: value 'output_no_header' not allowed in CGI_HEADER" ) + case default + call cgi_error( "Programming error: wrong value for parameter 'type' in CGI_HEADER" ) + end select +end subroutine cgi_header + +! cgi_get_method -- +! Get the information via the environment variable QUERY_STRING +! +! Arguments: +! dict Dictionary holding the information from the server (output) +! length Total length of the input +! +subroutine cgi_get_method( dict, length ) + type(DICT_STRUCT), pointer :: dict + integer, intent(in) :: length + + character(len=length) :: buffer + + call get_environment_variable( "QUERY_STRING", value=buffer ) + call cgi_store_dict( dict, buffer ) + +end subroutine cgi_get_method + +! cgi_post_method -- +! Get the information via standard input +! +! Arguments: +! dict Dictionary holding the information from the server (output) +! length Total length of the input +! +subroutine cgi_post_method( dict, length ) + type(DICT_STRUCT), pointer :: dict + integer, intent(in) :: length + + character(len=length) :: buffer + + read( *, '(a)', advance='no' ) buffer + call cgi_store_dict( dict, buffer ) + +end subroutine cgi_post_method + +! cgi_dustmote_method -- +! Get the information line by line +! +! Arguments: +! dict Dictionary holding the information from the server (output) +! +! +subroutine cgi_dustmote_method( dict ) + type(DICT_STRUCT), pointer :: dict + + type(DICT_DATA) :: data + character(len=DICT_KEY_LENGTH) :: key + character(len=DICT_BUFFER_LENGTH) :: input + integer :: k + integer :: lu + integer :: ierr + logical :: opend + + read( *, '(a)' ) input ! Skip the remainder of the first line + read( *, '(a)' ) input + + do while ( input /= '%END%' ) + call cgi_store_dict( dict, input ) + + read( *, '(a)', iostat=ierr ) input + if ( ierr /= 0 ) then + exit + endif + enddo + +end subroutine cgi_dustmote_method + +! cgi_store_dict -- +! Store the information in the dictionary +! +! Arguments: +! dict Dictionary holding all information +! string Complete string received from CGI server +! +subroutine cgi_store_dict( dict, string ) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: string + + character(len=DICT_KEY_LENGTH) :: key + character(len=len(string)) :: buffer + type(DICT_DATA) :: data + + integer :: k + integer :: keq + + buffer = string + + do + k = index( buffer, '&' ) + if ( k .le. 0 ) then + if ( buffer == ' ' ) then + exit + else + k = len(buffer) + 1 ! Remaining piece + endif + endif + + call cgi_decode_string( buffer(1:k-1) ) + + ! + ! Store the string + ! + keq = index( buffer(1:k-1), '=' ) + if ( keq > 0 ) then + key = buffer(1:keq-1) + data%value = buffer(keq+1:k-1) + + if ( .not. associated( dict ) ) then + call dict_create( dict, key, data ) + else + call dict_add_key( dict, key, data ) + endif + endif + + if ( k < len(buffer) ) then + buffer = buffer(k+1:) + else + buffer = ' ' + endif + + enddo +end subroutine cgi_store_dict + +! cgi_decode_string -- +! Decode the string (replace + and %xx) +! +! Arguments: +! dict Dictionary holding all information +! string Complete string received from CGI server +! +subroutine cgi_decode_string( string ) + character(len=*), intent(inout) :: string + + integer :: k + integer :: ch + + ! + ! First the +'s + ! + do + k = index( string, '+' ) + if ( k .le. 0 ) exit + + string(k:k) = ' ' + enddo + + ! + ! Now %xx + ! + do + k = index( string, '%' ) + if ( k .le. 0 ) exit + + read( string(k+1:k+2), '(z2)' ) ch + string(k:) = achar(ch) // string(k+3:) + enddo +end subroutine cgi_decode_string + +! cgi_end -- +! Indicate to the server that we are done +! Arguments: +! None +! Note: +! This is simply done by writing a file cgiready, +! if method 2 is used. Stop in all cases +! +subroutine cgi_end + + integer :: lu + logical :: opend + + if ( method == 2 ) then + do lu = 10,99 + inquire( lu, opened=opend ) + if ( .not. opend ) then + open( lu, file = "cgiready" ) + close( lu ) + exit + endif + enddo + endif + + stop + +end subroutine cgi_end + +! cgi_error -- +! Report a fatal error +! Arguments: +! msg Message to be printed +! template Template file to be used (optional) +! +subroutine cgi_error( msg, template ) + character(len=*), intent(in) :: msg + character(len=*), intent(in), optional :: template + + character(len=200) :: text + integer :: k + integer :: ierr + integer :: lu + logical :: opend + logical :: exists + + exists = .false. + if ( present(template) ) then + inquire( file = template, exist = exists ) + endif + + if ( .not. header_written ) then + write( luout_cgi, '(a)' ) 'Content-Type: text/html;charset=iso8859-1' + write( luout_cgi, '(a)' ) '' + endif + + if ( exists ) then + do lu = 10,99 + inquire( lu, opened = opend ) + if ( .not. opend ) then + exit + endif + enddo + open( lu, file = template ) + + do + read( lu, '(a)', iostat=ierr ) text + if ( ierr /= 0 ) exit + + k = index( text, 'MSG' ) + if ( k > 0 ) then + write( luout_cgi, '(3a)' ) text(1:k-1), trim(msg), text(k+3:) + else + write( luout_cgi, '(a)' ) text + endif + enddo + close( lu ) + else + write( luout_cgi, * ) '<html>' + write( luout_cgi, * ) '<head><title>Severe error</title></head>' + write( luout_cgi, * ) '<body>' + write( luout_cgi, * ) '<b>', trim(msg), '</b>' + write( luout_cgi, * ) '</body></html>' + endif + + call cgi_end + +end subroutine cgi_error + +! cgi_get_session -- +! Get the value of the "sessionid" variable +! Arguments: +! dict Dictionary with values +! value Value of the session ID (character(len=20)) +! Note: +! The session ID can be used to uniquely identify the +! connection with the user. But it should be passed into the +! HTML output as a hidden variable (see the documentation +! for more information) +! +subroutine cgi_get_session( dict, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*) :: value + + character(len=20) :: time_string + type(DICT_DATA) :: data + + if ( dict_has_key( dict, "sessionid" ) ) then + data = dict_get_key( dict, "sessionid" ) + value = data%value + else + call date_and_time( time = time_string ) + value = time_string(5:6) // time_string(8:10) + data%value = value + call dict_add_key( dict, "sessionid", data ) + endif + +end subroutine cgi_get_session + +! cgi_get_* -- +! Get the value of variables +! Arguments: +! dict Dictionary with values +! varname Name of the variable to retrieve +! value Value of the variable +! Note: +! If the variable does not exist, then the value +! is not changed! (Use dict_has_key() to check the +! existence) +! +subroutine cgi_get_string( dict, varname, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*) :: varname + character(len=*) :: value + + type(DICT_DATA) :: data + + if ( dict_has_key( dict, varname ) ) then + data = dict_get_key( dict, varname ) + value = data%value + endif + +end subroutine cgi_get_string + +subroutine cgi_get_integer( dict, varname, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*) :: varname + integer :: value + + type(DICT_DATA) :: data + integer :: ierr + integer :: new_value + + if ( dict_has_key( dict, varname ) ) then + data = dict_get_key( dict, varname ) + read( data%value, *, iostat=ierr ) new_value + if ( ierr == 0 ) then + value = new_value + endif + endif + +end subroutine cgi_get_integer + +subroutine cgi_get_real( dict, varname, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*) :: varname + real :: value + + type(DICT_DATA) :: data + integer :: ierr + real :: new_value + + if ( dict_has_key( dict, varname ) ) then + data = dict_get_key( dict, varname ) + read( data%value, *, iostat=ierr ) new_value + if ( ierr == 0 ) then + value = new_value + endif + endif + +end subroutine cgi_get_real + +subroutine cgi_get_logical( dict, varname, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*) :: varname + logical :: value + + type(DICT_DATA) :: data + integer :: ierr + integer :: new_value + + if ( dict_has_key( dict, varname ) ) then + data = dict_get_key( dict, varname ) + read( data%value, *, iostat=ierr ) new_value + if ( ierr == 0 ) then + value = (new_value == 1) + endif + endif + +end subroutine cgi_get_logical + +end module cgi_protocol diff --git a/src/3rd/flibs/src/cgi/fcgi_protocol.f90 b/src/3rd/flibs/src/cgi/fcgi_protocol.f90 new file mode 100755 index 0000000..df9b3f0 --- /dev/null +++ b/src/3rd/flibs/src/cgi/fcgi_protocol.f90 @@ -0,0 +1,183 @@ +! +! fcgi_protocol.f90 -- +! +! By Ricolindo.Carino@gmail.com +! +! Module for interfacing a Fortran program with a web server (nginx) via the FastCGI protocol +! +! Requires the cgi_protocol module from FLIBS +! +! Provides the following: +! +! function fcgip_accept_environment_variables(), bound to libfcgi/FCGI_Accept() +! - waits for FCGI environment variables from the webserver +! +! function fcgip_get_char(), bound to libfcgi/FCGI_get_char() +! - reads a character from POSTed data +! +! function fcgip_put_string(), bound to libfcgi/FCGI_puts() +! - copies a line of text to the webserver +! +! subroutine fcgip_make_dictionary() +! - breaks up QUERY_STRING or POSTed data into a dictionary +! +! subroutine fcgip_put_file () +! - copies a file line by line to the webserver +! +! User must supply the routine to interpret the dictionary and compose a +! response to QUERY_STRING or POSTed data +! + +module fcgi_protocol + + use cgi_protocol + + implicit none + + ! FCGI library (libfcgi) routines + interface + + ! The function to wait for FastCGI environment variables from the webserver + function fcgip_accept_environment_variables () bind(C, NAME='FCGI_Accept') + use ISO_C_BINDING + implicit none + integer(C_INT) :: fcgip_accept_environment_variables + end function fcgip_accept_environment_variables + + ! The function to retrieve a character from POSTed data + function fcgip_get_char () bind(C, NAME='FCGI_getchar') + use ISO_C_BINDING + implicit none + character(C_CHAR) :: fcgip_get_char + end function fcgip_get_char + + ! The function to copy a null-terminated string to the webserver + function fcgip_put_string (s) bind(C, NAME='FCGI_puts') + use ISO_C_BINDING + implicit none + integer(C_INT) :: fcgip_put_string + character(C_CHAR), dimension(*) :: s + end function fcgip_put_string + + end interface + + ! public abbreviations + character(len=3), parameter :: AFORMAT = '(a)' + character(len=2), parameter :: CRLF = achar(13)//achar(10) + character(len=1), parameter :: NUL = achar(0) + + ! private objects + ! MAX_CONTENT_LENGTH must be enough for "long" QUERY_STRING or POSTed content + integer, parameter, private :: MAX_CONTENT_LENGTH = 1024 + character(len=MAX_CONTENT_LENGTH), private :: content + integer, private :: iStat + +contains + + + subroutine fcgip_make_dictionary( dict, unitNo ) + ! Retrieve FastCGI environment variables into dictionary 'dict' + ! Invoked after FCGI_Accept()/fcgip_accept_environment_variable() has completed + ! Write debugging information to file unit number 'unitNo', which must already be open + ! Debugging information should begin with %REMARK%, so as not to be sent + ! to the webserver, see fcgi_put_file() + + type(DICT_STRUCT), pointer :: dict + integer, intent(in) :: unitNo + + integer :: i + integer :: iLen + character(len=1) :: ch + + ! write to the beginning of file unitNo + rewind (unitNo) + + ! Clean up dictionary ? + if ( associated(dict) ) then + call dict_destroy( dict ) + write(unitNo, AFORMAT) '%REMARK% cleaned dictionary...' + else + write(unitNo, AFORMAT) '%REMARK% dictionary NOT associated()...' + endif + + ! add the requested script ('/' if none) to dictionary + call get_environment_variable('DOCUMENT_URI', content) + iLen = len_trim(content) + if ( iLen > 0 ) then + content = 'DOCUMENT_URI='//content + else ! default is /, to ensure dictionary is not empty + content = 'DOCUMENT_URI=/' + endif + iLen = len_trim(content) + call cgi_store_dict( dict, content(:iLen) ) + write(unitNo, AFORMAT) '%REMARK% added to dictionary: '//content(:iLen) + + ! QUERY_STRING (request method was GET) ? + call get_environment_variable( "QUERY_STRING", value=content, length=iLen, status=iStat ) + if ( iStat == 0 ) then + write(unitNo, AFORMAT) '%REMARK% QUERY_STRING='//trim(content) + if ( iLen > 0 ) then + call cgi_store_dict( dict, content(:iLen) ) + write(unitNo, AFORMAT) '%REMARK% added to dictionary: QUERY_STRING='//content(:iLen) + end if + endif + + ! anything in CONTENT_LENGTH (request method was POST) ? + call get_environment_variable( "CONTENT_LENGTH", value=content, status=iStat ) + if ( iStat == 0 ) then + write(unitNo, AFORMAT) '%REMARK% CONTENT_LENGTH='//trim(content) + iLen = len_trim(content) + if ( iLen > 0 ) then + read( content, * ) iLen + do i=1,iLen + ch = fcgip_get_char() + content( i:i ) = ch + end do + content( iLen+1: ) = ' ' + call cgi_store_dict( dict, content(:iLen) ) + write(unitNo, AFORMAT) '%REMARK% added to dictionary: CONTENT='//content(:iLen) + end if + endif + + ! for other environment variables, see <nginx directory>/conf/fastcgi_params + + write(unitNo, AFORMAT) '%REMARK% completed dictionary...' + + end subroutine fcgip_make_dictionary + + + + subroutine fcgip_put_file ( unitNo, mimetype ) + ! Copy file 'unitNo' line by line to the webserver via FCGI_puts() + ! except for lines beginning with %REMARK% + ! File must already exist, expected to contain the response to some query + + integer, intent(in) :: unitNo + character(len=*), intent(in), optional :: mimetype + + character(len=80) :: mimetype_ + + mimetype_ = 'text/html' + if ( present(mimetype) ) then + mimetype_ = mimetype + endif + + ! flush any pending writes + flush(unitNo) + + ! let the server know what type of data + iStat = fcgip_put_string ('Content-type: '//trim(mimetype_)//CRLF//NUL) + + ! copy line by line to webserver, except those starting with %REMARK% + rewind(unitNo) + do while (.true.) + read(unitNo, AFORMAT, iostat=iStat) content + if (iStat < 0) exit ! no more lines + if (content(:8) == '%REMARK%') cycle + iStat = fcgip_put_string (trim(content)//NUL) ! FCGI_puts expects NULL terminated strings + end do + + end subroutine fcgip_put_file + + +end module fcgi_protocol diff --git a/src/3rd/flibs/src/datastructures/dictionary.f90 b/src/3rd/flibs/src/datastructures/dictionary.f90 new file mode 100755 index 0000000..4f0e1de --- /dev/null +++ b/src/3rd/flibs/src/datastructures/dictionary.f90 @@ -0,0 +1,269 @@ +! dictionary.f90 -- +! Include file for defining dictionaries: +! a mapping of strings to some data +! +! See the example/test program for the way to use this +! +! Note: +! Use is made of a hash table. This should speed up most +! operations. The algorithm for determining the hashkey +! is taken from Kernighan and Pike: The Practice of Programming +! +! Note: +! - Define the length of the strings as +! parameter "DICT_KEY_LENGTH" +! - Define a derived type for the data +! to be stored +! - Also define a "null" value - DICT_NULL +! of type DICT_DATA, for use when the +! key is not found. +! - Put both in a separate module, that +! will be used. +! +! $Id: dictionary.f90,v 1.5 2013-03-05 12:08:29 arjenmarkus Exp $ +! +type LIST_DATA + character(len=DICT_KEY_LENGTH) :: key + type(DICT_DATA) :: value +end type LIST_DATA + +type HASH_LIST + type(LINKED_LIST), pointer :: list +end type HASH_LIST + +type DICT_STRUCT + private + type(HASH_LIST), pointer, dimension(:) :: table +end type DICT_STRUCT + +! +! We do not want everything to be public +! +private :: LIST_DATA +private :: HASH_LIST +private :: LINKED_LIST +private :: list_create +private :: list_destroy +private :: list_count +private :: list_next +private :: list_insert +private :: list_insert_head +private :: list_delete_element +private :: list_get_data +private :: list_put_data +private :: dict_get_elem +private :: dict_hashkey + +integer, parameter, private :: hash_size = 4993 +integer, parameter, private :: multiplier = 31 + +include 'linkedlist.f90' + +! +! Routines and functions specific to dictionaries +! + +! dict_create -- +! Create and initialise a dictionary +! Arguments: +! dict Pointer to new dictionary +! key Key for the first element +! value Value for the first element +! Note: +! This version assumes a shallow copy is enough +! (that is, there are no pointers within the data +! to be stored) +! It also assumes the argument list does not already +! refer to a list. Use dict_destroy first to +! destroy up an old list. +! +subroutine dict_create( dict, key, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: key + type(DICT_DATA), intent(in) :: value + + type(LIST_DATA) :: data + integer :: i + integer :: hash + + allocate( dict ) + allocate( dict%table(hash_size) ) + + do i = 1,hash_size + dict%table(i)%list => null() + enddo + + data%key = key + data%value = value + + hash = dict_hashkey( trim(key ) ) + call list_create( dict%table(hash)%list, data ) + +end subroutine dict_create + +! dict_destroy -- +! Destroy an entire dictionary +! Arguments: +! dict Pointer to the dictionary to be destroyed +! Note: +! This version assumes that there are no +! pointers within the data that need deallocation +! +subroutine dict_destroy( dict ) + type(DICT_STRUCT), pointer :: dict + + integer :: i + + do i = 1,size(dict%table) + if ( associated( dict%table(i)%list ) ) then + call list_destroy( dict%table(i)%list ) + endif + enddo + deallocate( dict%table ) + deallocate( dict ) + +end subroutine dict_destroy + +! dict_add_key +! Add a new key +! Arguments: +! dict Pointer to the dictionary +! key Key for the new element +! value Value for the new element +! Note: +! If the key already exists, the +! key's value is simply replaced +! +subroutine dict_add_key( dict, key, value ) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: key + type(DICT_DATA), intent(in) :: value + + type(LIST_DATA) :: data + type(LINKED_LIST), pointer :: elem + integer :: hash + + elem => dict_get_elem( dict, key ) + + if ( associated(elem) ) then + elem%data%value = value + else + data%key = key + data%value = value + hash = dict_hashkey( trim(key) ) + if ( associated( dict%table(hash)%list ) ) then + call list_insert( dict%table(hash)%list, data ) + else + call list_create( dict%table(hash)%list, data ) + endif + endif + +end subroutine dict_add_key + +! dict_delete_key +! Delete a key-value pair from the dictionary +! Arguments: +! dict Dictionary in question +! key Key to be removed +! +subroutine dict_delete_key( dict, key ) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: key + + type(LINKED_LIST), pointer :: elem + integer :: hash + + elem => dict_get_elem( dict, key ) + + if ( associated(elem) ) then + hash = dict_hashkey( trim(key) ) + call list_delete_element( dict%table(hash)%list, elem ) + endif +end subroutine dict_delete_key + +! dict_get_key +! Get the value belonging to a key +! Arguments: +! dict Pointer to the dictionary +! key Key for which the values are sought +! +function dict_get_key( dict, key ) result(value) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: key + type(DICT_DATA) :: value + + type(LIST_DATA) :: data + type(LINKED_LIST), pointer :: elem + + elem => dict_get_elem( dict, key ) + + if ( associated(elem) ) then + value = elem%data%value + else + value = DICT_NULL + endif +end function dict_get_key + +! dict_has_key +! Check if the dictionary has a particular key +! Arguments: +! dict Pointer to the dictionary +! key Key to be sought +! +function dict_has_key( dict, key ) result(has) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: key + logical :: has + + type(LINKED_LIST), pointer :: elem + + elem => dict_get_elem( dict, key ) + + has = associated(elem) +end function dict_has_key + +! dict_get_elem +! Find the element with a particular key +! Arguments: +! dict Pointer to the dictionary +! key Key to be sought +! +function dict_get_elem( dict, key ) result(elem) + type(DICT_STRUCT), pointer :: dict + character(len=*), intent(in) :: key + + type(LINKED_LIST), pointer :: elem + integer :: hash + + hash = dict_hashkey( trim(key) ) + + elem => dict%table(hash)%list + do while ( associated(elem) ) + if ( elem%data%key .eq. key ) then + exit + else + elem => list_next( elem ) + endif + enddo +end function dict_get_elem + +! dict_hashkey +! Determine the hash value from the string +! Arguments: +! key String to be examined +! +integer function dict_hashkey( key ) + character(len=*), intent(in) :: key + + integer :: hash + integer :: i + + dict_hashkey = 0 + + do i = 1,len(key) + dict_hashkey = modulo( multiplier * dict_hashkey + ichar(key(i:i)), hash_size ) + enddo + + dict_hashkey = 1 + modulo( dict_hashkey-1, hash_size ) +end function dict_hashkey + diff --git a/src/3rd/flibs/src/datastructures/linkedlist.f90 b/src/3rd/flibs/src/datastructures/linkedlist.f90 new file mode 100755 index 0000000..9071ece --- /dev/null +++ b/src/3rd/flibs/src/datastructures/linkedlist.f90 @@ -0,0 +1,242 @@ +! linkedlist.f90 -- +! Include file for defining linked lists where each element holds +! the same kind of data +! +! See the example/test program for the way to use this +! +! Note: +! You should only use pointer variables of this type, no +! ordinary variables, as sometimes the memory pointed to +! will be deallocated. The subroutines and functions +! are designed to minimize mistakes (for instance: using +! = instead of =>) +! +! $Id: linkedlist.f90,v 1.4 2009-08-17 04:26:12 arjenmarkus Exp $ +! +! Define the linked-list data type +! +type LINKED_LIST + type(LINKED_LIST), pointer :: next + type(LIST_DATA) :: data +end type LINKED_LIST + +! +! define a private (!) interface to prevent +! mistakes with ordinary assignment +! +!interface assignment(=) +! module procedure list_assign +!end interface +!private :: list_assign + +! +! Define the subroutines and functions +! +contains + +! list_assign +! Subroutine to prevent errors with assignment +! Arguments: +! list_left List on the left-hand side +! list_right List on the right-hand side +! +! NOTE: +! This does not work because of a private/public +! conflict +! +!subroutine list_assign( list_left, list_right ) +! type(LINKED_LIST), INTENT(OUT) :: list_left +! type(LINKED_LIST), INTENT(IN) :: list_right +! !type(LINKED_LIST), pointer :: list_left +! !type(LINKED_LIST), pointer :: list_right +! +! ! +! ! Note the order! +! ! +! stop 'Error: ordinary assignment for lists' +! list_left%next => null() +!end subroutine list_assign + +! list_create -- +! Create and initialise a list +! Arguments: +! list Pointer to new linked list +! data The data for the first element +! Note: +! This version assumes a shallow copy is enough +! (that is, there are no pointers within the data +! to be stored) +! It also assumes the argument list does not already +! refer to a list. Use list_destroy first to +! destroy up an old list. +! +subroutine list_create( list, data ) + type(LINKED_LIST), pointer :: list + type(LIST_DATA), intent(in) :: data + + allocate( list ) + list%next => null() + list%data = data +end subroutine list_create + +! list_destroy -- +! Destroy an entire list +! Arguments: +! list Pointer to the list to be destroyed +! Note: +! This version assumes that there are no +! pointers within the data that need deallocation +! +subroutine list_destroy( list ) + type(LINKED_LIST), pointer :: list + + type(LINKED_LIST), pointer :: current + type(LINKED_LIST), pointer :: elem + + elem => list + do while ( associated(elem) ) + current => elem + elem => current%next + deallocate( current ) + enddo +end subroutine list_destroy + +! list_count -- +! Count the number of items in the list +! Arguments: +! list Pointer to the list +! +integer function list_count( list ) + type(LINKED_LIST), pointer :: list + + type(LINKED_LIST), pointer :: current + type(LINKED_LIST), pointer :: next + + if ( associated(list) ) then + list_count = 1 + current => list + do while ( associated(current%next) ) + current => current%next + list_count = list_count + 1 + enddo + else + list_count = 0 + endif +end function list_count + +! list_next +! Return the next element (if any) +! Arguments: +! elem Element in the linked list +! Result: +! +function list_next( elem ) result(next) + type(LINKED_LIST), pointer :: elem + type(LINKED_LIST), pointer :: next + + next => elem%next + +end function list_next + +! list_insert +! Insert a new element +! Arguments: +! elem Element in the linked list after +! which to insert the new element +! data The data for the new element +! +subroutine list_insert( elem, data ) + type(LINKED_LIST), pointer :: elem + type(LIST_DATA), intent(in) :: data + + type(LINKED_LIST), pointer :: next + + allocate(next) + + next%next => elem%next + elem%next => next + next%data = data +end subroutine list_insert + +! list_insert_head +! Insert a new element before the first element +! Arguments: +! list Start of the list +! data The data for the new element +! +subroutine list_insert_head( list, data ) + type(LINKED_LIST), pointer :: list + type(LIST_DATA), intent(in) :: data + + type(LINKED_LIST), pointer :: elem + + allocate(elem) + elem%data = data + + elem%next => list + list => elem +end subroutine list_insert_head + +! list_delete_element +! Delete an element from the list +! Arguments: +! list Header of the list +! elem Element in the linked list to be +! removed +! +subroutine list_delete_element( list, elem ) + type(LINKED_LIST), pointer :: list + type(LINKED_LIST), pointer :: elem + + type(LINKED_LIST), pointer :: current + type(LINKED_LIST), pointer :: prev + + if ( associated(list,elem) ) then + list => elem%next + deallocate( elem ) + else + current => list + prev => list + do while ( associated(current) ) + if ( associated(current,elem) ) then + prev%next => current%next + deallocate( current ) ! Is also "elem" + exit + endif + prev => current + current => current%next + enddo + endif +! allocate(next) +! +! next%next => elem%next +! elem%next => next +! next%data = data +end subroutine list_delete_element + +! list_get_data +! Get the data stored with a list element +! Arguments: +! elem Element in the linked list +! +function list_get_data( elem ) result(data) + type(LINKED_LIST), pointer :: elem + + type(LIST_DATA) :: data + + data = elem%data +end function list_get_data + +! list_put_data +! Store new data with a list element +! Arguments: +! elem Element in the linked list +! data The data to be stored +! +subroutine list_put_data( elem, data ) + type(LINKED_LIST), pointer :: elem + type(LIST_DATA), intent(in) :: data + + elem%data = data +end subroutine list_put_data + diff --git a/src/main.f90 b/src/main.f90 new file mode 100644 index 0000000..28a52dc --- /dev/null +++ b/src/main.f90 @@ -0,0 +1,52 @@ +program fortran_fcgi + + use fcgi_protocol + + implicit none + + type(DICT_STRUCT), pointer :: dict => null() + integer :: unitNo ! unit number for a scratch file + + unitNo = getpid() ! use process ID as unit number + open (unit=unitNo, status='scratch') + + do while (fcgip_accept_environment_variables() >= 0) + + call fcgip_make_dictionary(dict, unitNo) + call respond(dict, unitNo) + call fcgip_put_file(unitNo) + + end do + + close (unitNo) + +contains + + subroutine respond(dict, unitNo) + type(DICT_STRUCT), pointer, intent(in) :: dict + integer, intent(in) :: unitNo + character(len=80) :: scriptName + + write (unitNo, '(a)') & + '<!DOCTYPE html>', & + '<html lang="en">', & + '<head><meta charset="utf-8" />', & + '<title>Fortran FastCGI</title></head>', & + '<body>', & + '<h1>Fortran FastCGI</h1>' + + call cgi_get(dict, 'DOCUMENT_URI', scriptName) + + select case (trim(scriptName)) + + case ('/foo') + write (unitNo, '(a)') '<p>foo</p>' + + end select + + write (unitNo, '(a)') '</body>', '</html>' + + end subroutine respond + +end program fortran_fcgi + |