aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2019-10-29 19:17:19 +0200
committerIgor Pashev <pashev.igor@gmail.com>2019-10-29 19:17:19 +0200
commitc6c4a50986494a8f20eee4dbd30f05d144352761 (patch)
tree4e33ae0d9647bbe767d25eb0bd551bf3aa3a4e5a
downloadfortran-fcgi-c6c4a50986494a8f20eee4dbd30f05d144352761.tar.gz
Intial version
-rw-r--r--CMakeLists.txt24
-rw-r--r--LICENSE13
-rw-r--r--README.md30
-rwxr-xr-xsrc/3rd/flibs/Copyright27
-rw-r--r--src/3rd/flibs/README117
-rwxr-xr-xsrc/3rd/flibs/src/cgi/cgi_protocol.f90541
-rwxr-xr-xsrc/3rd/flibs/src/cgi/fcgi_protocol.f90183
-rwxr-xr-xsrc/3rd/flibs/src/datastructures/dictionary.f90269
-rwxr-xr-xsrc/3rd/flibs/src/datastructures/linkedlist.f90242
-rw-r--r--src/main.f9052
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}
+)
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..456c488
--- /dev/null
+++ b/LICENSE
@@ -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
+