From 628ebab0b83ccef05a7ac18aa1b7a38fb2d38acd Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 26 Jan 2009 00:00:56 +0000 Subject: [PATCH] 2009-01-26 00:52 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * contrib/make_b32_all.bat * contrib/make_gcc_all.sh * contrib/make_vc_all.bat + contrib/hbssl + contrib/hbssl/Makefile + contrib/hbssl/common.mak + contrib/hbssl/make_b32.bat + contrib/hbssl/make_vc.bat + contrib/hbssl/make_gcc.sh + contrib/hbssl/hbssl.h + contrib/hbssl/hbssl.ch + contrib/hbssl/ssl.c + contrib/hbssl/sslctx.c + contrib/hbssl/sslrand.c + contrib/hbssl/tests + contrib/hbssl/tests/hbmk_b32.bat + contrib/hbssl/tests/hbmk_vc.bat + contrib/hbssl/tests/test.prg + Added Harbour bindings to OpenSSL. Work in progress, but it's theoretically already functional. To build, set your HB_DIR_OPENSSL or HB_INC_OPENSSL envvar. ; TOFIX: Makefile openssl autodetection should be adjusted. * contrib/examples/uhttpd ! Fixed SVN attributes. (except for /home dir) --- harbour/ChangeLog | 31 +- harbour/contrib/examples/uhttpd/hbmk_b32.bat | 2 +- .../contrib/examples/uhttpd/modules/info.prg | 224 +- .../examples/uhttpd/modules/showcounter.prg | 438 +- .../uhttpd/modules/tableservletdb.prg | 800 ++-- .../examples/uhttpd/modules/testajax.prg | 138 +- harbour/contrib/examples/uhttpd/readme.txt | 36 +- harbour/contrib/examples/uhttpd/socket.c | 832 ++-- harbour/contrib/examples/uhttpd/uhttpd.ini | 70 +- harbour/contrib/examples/uhttpd/uhttpd.prg | 3884 ++++++++--------- harbour/contrib/hbssl/Makefile | 44 + harbour/contrib/hbssl/common.mak | 18 + harbour/contrib/hbssl/hbssl.ch | 77 + harbour/contrib/hbssl/hbssl.h | 66 + harbour/contrib/hbssl/make_b32.bat | 81 + harbour/contrib/hbssl/make_gcc.sh | 24 + harbour/contrib/hbssl/make_vc.bat | 82 + harbour/contrib/hbssl/ssl.c | 440 ++ harbour/contrib/hbssl/sslctx.c | 193 + harbour/contrib/hbssl/sslrand.c | 89 + harbour/contrib/hbssl/tests/hbmk_b32.bat | 14 + harbour/contrib/hbssl/tests/hbmk_vc.bat | 14 + harbour/contrib/hbssl/tests/test.prg | 37 + harbour/contrib/make_b32_all.bat | 1 + harbour/contrib/make_gcc_all.sh | 1 + harbour/contrib/make_vc_all.bat | 1 + 26 files changed, 4423 insertions(+), 3214 deletions(-) create mode 100644 harbour/contrib/hbssl/Makefile create mode 100644 harbour/contrib/hbssl/common.mak create mode 100644 harbour/contrib/hbssl/hbssl.ch create mode 100644 harbour/contrib/hbssl/hbssl.h create mode 100644 harbour/contrib/hbssl/make_b32.bat create mode 100755 harbour/contrib/hbssl/make_gcc.sh create mode 100644 harbour/contrib/hbssl/make_vc.bat create mode 100644 harbour/contrib/hbssl/ssl.c create mode 100644 harbour/contrib/hbssl/sslctx.c create mode 100644 harbour/contrib/hbssl/sslrand.c create mode 100644 harbour/contrib/hbssl/tests/hbmk_b32.bat create mode 100644 harbour/contrib/hbssl/tests/hbmk_vc.bat create mode 100644 harbour/contrib/hbssl/tests/test.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 8e2f087f4a..f14dd7fcc1 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,13 +8,40 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2009-01-26 00:52 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * contrib/make_b32_all.bat + * contrib/make_gcc_all.sh + * contrib/make_vc_all.bat + + contrib/hbssl + + contrib/hbssl/Makefile + + contrib/hbssl/common.mak + + contrib/hbssl/make_b32.bat + + contrib/hbssl/make_vc.bat + + contrib/hbssl/make_gcc.sh + + contrib/hbssl/hbssl.h + + contrib/hbssl/hbssl.ch + + contrib/hbssl/ssl.c + + contrib/hbssl/sslctx.c + + contrib/hbssl/sslrand.c + + contrib/hbssl/tests + + contrib/hbssl/tests/hbmk_b32.bat + + contrib/hbssl/tests/hbmk_vc.bat + + contrib/hbssl/tests/test.prg + + Added Harbour bindings to OpenSSL. + Work in progress, but it's theoretically already functional. + To build, set your HB_DIR_OPENSSL or HB_INC_OPENSSL envvar. + ; TOFIX: Makefile openssl autodetection should be adjusted. + + * contrib/examples/uhttpd + ! Fixed SVN attributes. (except for /home dir) + 2009-01-25 22:16 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * source/rtl/philes.c ! FWRITE(): Fixed accessing past the string buffer (thus causing potential GPF and a huge security hole) when - the passed length is greate than the lenght of the string. + the passed length is greater than the length of the string. Very old bug. In fact CA-Cl*pper suffers from the same - problem, and behavior for such case is not documented. + problem, and behaviour for such case is not documented. Harbour will ignore the length parameter (thus writing the whole passed string), if the length is invalid. diff --git a/harbour/contrib/examples/uhttpd/hbmk_b32.bat b/harbour/contrib/examples/uhttpd/hbmk_b32.bat index 3ed9759401..d73d62b291 100644 --- a/harbour/contrib/examples/uhttpd/hbmk_b32.bat +++ b/harbour/contrib/examples/uhttpd/hbmk_b32.bat @@ -1,7 +1,7 @@ @echo off cls rem -rem $Id: hbmk_b32.bat 9884 2008-11-09 19:37:16Z vszakats $ +rem $Id$ rem SET UHTTP_INET_SUPPORT=no diff --git a/harbour/contrib/examples/uhttpd/modules/info.prg b/harbour/contrib/examples/uhttpd/modules/info.prg index 603949d9ff..63af5e9fc9 100644 --- a/harbour/contrib/examples/uhttpd/modules/info.prg +++ b/harbour/contrib/examples/uhttpd/modules/info.prg @@ -1,112 +1,112 @@ -/* - * $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $ - */ - -/* - * Harbour Project source code: - * uHTTPD info page - * - * Copyright 2009 Francesco Saverio Giudice - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -/* - Show internal variables. - Call it with: /info -*/ - - -#include "common.ch" -#include "hbclass.ch" - -MEMVAR _SERVER, _REQUEST, _GET, _POST - -FUNCTION HRBMAIN() - LOCAL cHtml - - cHtml := ShowServerInfo() - - RETURN cHtml - -STATIC FUNCTION ShowServerInfo() - LOCAL cHtml := "" - - cHtml += DisplayVars( _Server , "SERVER Vars" ) - cHtml += "
" - cHtml += DisplayVars( _Get , "GET Vars" ) - cHtml += "
" - cHtml += DisplayVars( _Post , "POST Vars" ) - cHtml += "
" - //cHtml += DisplayVars( _Cookie , "COOKIE Vars" ) - //cHtml += "
" - //cHtml += DisplayVars( _Files , "FILE Vars" ) - //cHtml += "
" - cHtml += DisplayVars( _Request, "REQUEST Vars" ) - cHtml += "
" - //cHtml += DisplayVars( _Session, "SESSION Vars" ) - //cHtml += "
" - RETURN cHtml - -STATIC FUNCTION DisplayVars( hHash, cTitle ) - LOCAL cHtml := "" - cHtml += "" - cHtml += "" - cHtml += "" - cHtml += "" - cHtml += "" - cHtml += "" - cHtml += DisplayHash( hHash ) - cHtml += "
" + hb_cStr( cTitle ) + "
KEYVALUE
" -RETURN cHtml - -STATIC FUNCTION DisplayHash( hHash ) - LOCAL cHtml := "" - LOCAL cKey, cSubKey - - FOR EACH cKey IN hHash:Keys - cHtml += "" - cHtml += "" + hb_cStr( cKey ) + "" - cHtml += "" + hb_cStr( hHash[ cKey ] ) + "" - cHtml += "" - NEXT -RETURN cHtml +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * uHTTPD info page + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +/* + Show internal variables. + Call it with: /info +*/ + + +#include "common.ch" +#include "hbclass.ch" + +MEMVAR _SERVER, _REQUEST, _GET, _POST + +FUNCTION HRBMAIN() + LOCAL cHtml + + cHtml := ShowServerInfo() + + RETURN cHtml + +STATIC FUNCTION ShowServerInfo() + LOCAL cHtml := "" + + cHtml += DisplayVars( _Server , "SERVER Vars" ) + cHtml += "
" + cHtml += DisplayVars( _Get , "GET Vars" ) + cHtml += "
" + cHtml += DisplayVars( _Post , "POST Vars" ) + cHtml += "
" + //cHtml += DisplayVars( _Cookie , "COOKIE Vars" ) + //cHtml += "
" + //cHtml += DisplayVars( _Files , "FILE Vars" ) + //cHtml += "
" + cHtml += DisplayVars( _Request, "REQUEST Vars" ) + cHtml += "
" + //cHtml += DisplayVars( _Session, "SESSION Vars" ) + //cHtml += "
" + RETURN cHtml + +STATIC FUNCTION DisplayVars( hHash, cTitle ) + LOCAL cHtml := "" + cHtml += "" + cHtml += "" + cHtml += "" + cHtml += "" + cHtml += "" + cHtml += "" + cHtml += DisplayHash( hHash ) + cHtml += "
" + hb_cStr( cTitle ) + "
KEYVALUE
" +RETURN cHtml + +STATIC FUNCTION DisplayHash( hHash ) + LOCAL cHtml := "" + LOCAL cKey, cSubKey + + FOR EACH cKey IN hHash:Keys + cHtml += "" + cHtml += "" + hb_cStr( cKey ) + "" + cHtml += "" + hb_cStr( hHash[ cKey ] ) + "" + cHtml += "" + NEXT +RETURN cHtml diff --git a/harbour/contrib/examples/uhttpd/modules/showcounter.prg b/harbour/contrib/examples/uhttpd/modules/showcounter.prg index 4b57d6a2df..a168890bd2 100644 --- a/harbour/contrib/examples/uhttpd/modules/showcounter.prg +++ b/harbour/contrib/examples/uhttpd/modules/showcounter.prg @@ -1,219 +1,219 @@ - -/* - * $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $ - */ - -/* - * Harbour Project source code: - * simple image counter - * - * Copyright 2009 Francesco Saverio Giudice - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - - -MEMVAR _SERVER // defined in uHTTPD -MEMVAR _REQUEST // defined in uHTTPD - -#include "common.ch" -//#include "xhb.ch" -#include "gd.ch" - -#define IMAGES_IN "..\..\hbgd\tests\digits\" -#define IMAGES_OUT ( _SERVER[ "DOCUMENT_ROOT" ] + "\counter\" ) - -#define DISPLAY_NUM 10 - -FUNCTION HRBMAIN() - LOCAL cHtml - LOCAL cBaseImage - - IF HB_HHasKey( _REQUEST, "w" ) - - cHtml := CreateCounter( AllTrim( Str( Val( _REQUEST[ "w" ] ) ) ) ) - //hb_ToOutDebug( hb_sprintf( "CreateCounter = %s", cHtml ) ) - IF !Empty( cHtml ) - uAddHeader( "Content-Type", "image/gif" ) - uAddHeader( "Pragma", "no-cache" ) - uAddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" ) - uWrite( cHtml ) - ELSE - uAddHeader( "Content-Type", "text/html" ) - uWrite( "

Error: No image created

" ) - ENDIF - - - ELSE - - uAddHeader( "Content-Type", "text/html" ) - uWrite( "

Error: no parameters passed

" ) - - ENDIF - -RETURN TRUE - -STATIC FUNCTION CreateCounter( cValue, cBaseImage ) - - LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp - //LOCAL black, white, blue, red, green, cyan, gray - LOCAL white - LOCAL aNumberImages := {} - LOCAL n, nValue - LOCAL cFile - - // A value if not passed - DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM ) - DEFAULT cBaseImage TO "57chevy.gif" - - IF !File( IMAGES_IN + cBaseImage ) - //hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" ) - //THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" ) - RETURN NIL - ENDIF - - nValue := Val( cValue ) - - // Fix num lenght - IF nValue > 10^DISPLAY_NUM - nValue := 10^DISPLAY_NUM - ENDIF - - cValue := StrZero( nValue, DISPLAY_NUM ) - - //? "Value = ", cValue - - // To set fonts run this command: - // for windows: SET GDFONTPATH=c:\windows\fonts - // per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType - - // SET GDFONTPATH=c:\windows\fonts - //IF GetEnv( "GDFONTPATH" ) == "" - // ? "Please set GDFONTPATH" - // ? "On Windows: SET GDFONTPATH=c:\windows\fonts" - // ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType" - // ? - //ENDIF - - // Check output directory - /* - IF !ISDirectory( IMAGES_OUT ) - DirMake( IMAGES_OUT ) - ENDIF - */ - - /* Load a digits image in memory from file */ - oIDigits := GDImage():LoadFromGif( IMAGES_IN + cBaseImage ) - - /* Get single number images */ - - // Get dimensions - nWidth := oIDigits:Width() - nHeight := oIDigits:Height() - - // Check base digits image - DO CASE - CASE nWidth % 10 == 0 // 0..9 digits - nDigits := 10 - CASE nWidth % 11 == 0 // 0..9 : - nDigits := 11 - CASE nWidth % 13 == 0 // 0..9 : am pm - nDigits := 13 - OTHERWISE - uWrite( "Error on digits image" ) - ENDCASE - nNumWidth := nWidth / nDigits - - //? "nNumWidth, nWidth, nHeight, nDigits = ", nNumWidth, nWidth, nHeight, nDigits - - /* extracts single digits */ - FOR n := 1 TO nDigits - oTemp := oIDigits:Copy( (n - 1) * nNumWidth, 0, nNumWidth, nHeight ) - //oTemp:SaveGif( IMAGES_OUT + StrZero( n-1, 2 ) + ".gif" ) - // Here I have to clone the image, otherwise on var destruction I loose - // the image in memory - aAdd( aNumberImages, oTemp:Clone() ) - NEXT - - /* Create counter image in memory */ - oI := GDImage():New( nNumWidth * DISPLAY_NUM, nHeight ) // the counter - //? "Image dimensions: ", oI:Width(), oI:Height() - - /* Allocate background */ - white := oI:SetColor( 255, 255, 255 ) - - /* Allocate drawing color */ - //black := oI:SetColor( 0, 0, 0 ) - //blue := oI:SetColor( 0, 0, 255 ) - //red := oI:SetColor( 255, 0, 0 ) - //green := oI:SetColor( 0, 255, 0 ) - //cyan := oI:SetColor( 0, 255, 255 ) - - /* Draw rectangle */ - //oI:Rectangle( 0, 0, 200, 30, , blue ) - - /* Draw Digits */ - FOR n := 1 TO Len( cValue ) - // Retrieve the number from array in memory - oTemp := aNumberImages[ Val( SubStr( cValue, n, 1 ) ) + 1 ]:Clone() - // Save it to show the number for a position - //oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" ) - // Set the digit as tile that I have to use to fill position in counter - oI:SetTile( oTemp ) - // Fill the position with the image digit - oI:Rectangle( (n - 1) * nNumWidth, 0, (n - 1) * nNumWidth + nNumWidth, nHeight, TRUE, gdTiled ) - NEXT - - /* Write Final Counter Image */ - cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif" - //oI:SaveGif( IMAGES_OUT + cFile ) - - /* Destroy images in memory */ - // Class does it automatically - - //? - //? "Look at " + IMAGES_OUT + " folder for output images" - //? - -//RETURN cFile -RETURN oI:ToStringGif() - + +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * simple image counter + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +MEMVAR _SERVER // defined in uHTTPD +MEMVAR _REQUEST // defined in uHTTPD + +#include "common.ch" +//#include "xhb.ch" +#include "gd.ch" + +#define IMAGES_IN "..\..\hbgd\tests\digits\" +#define IMAGES_OUT ( _SERVER[ "DOCUMENT_ROOT" ] + "\counter\" ) + +#define DISPLAY_NUM 10 + +FUNCTION HRBMAIN() + LOCAL cHtml + LOCAL cBaseImage + + IF HB_HHasKey( _REQUEST, "w" ) + + cHtml := CreateCounter( AllTrim( Str( Val( _REQUEST[ "w" ] ) ) ) ) + //hb_ToOutDebug( hb_sprintf( "CreateCounter = %s", cHtml ) ) + IF !Empty( cHtml ) + uAddHeader( "Content-Type", "image/gif" ) + uAddHeader( "Pragma", "no-cache" ) + uAddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" ) + uWrite( cHtml ) + ELSE + uAddHeader( "Content-Type", "text/html" ) + uWrite( "

Error: No image created

" ) + ENDIF + + + ELSE + + uAddHeader( "Content-Type", "text/html" ) + uWrite( "

Error: no parameters passed

" ) + + ENDIF + +RETURN TRUE + +STATIC FUNCTION CreateCounter( cValue, cBaseImage ) + + LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp + //LOCAL black, white, blue, red, green, cyan, gray + LOCAL white + LOCAL aNumberImages := {} + LOCAL n, nValue + LOCAL cFile + + // A value if not passed + DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM ) + DEFAULT cBaseImage TO "57chevy.gif" + + IF !File( IMAGES_IN + cBaseImage ) + //hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" ) + //THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" ) + RETURN NIL + ENDIF + + nValue := Val( cValue ) + + // Fix num lenght + IF nValue > 10^DISPLAY_NUM + nValue := 10^DISPLAY_NUM + ENDIF + + cValue := StrZero( nValue, DISPLAY_NUM ) + + //? "Value = ", cValue + + // To set fonts run this command: + // for windows: SET GDFONTPATH=c:\windows\fonts + // per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType + + // SET GDFONTPATH=c:\windows\fonts + //IF GetEnv( "GDFONTPATH" ) == "" + // ? "Please set GDFONTPATH" + // ? "On Windows: SET GDFONTPATH=c:\windows\fonts" + // ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType" + // ? + //ENDIF + + // Check output directory + /* + IF !ISDirectory( IMAGES_OUT ) + DirMake( IMAGES_OUT ) + ENDIF + */ + + /* Load a digits image in memory from file */ + oIDigits := GDImage():LoadFromGif( IMAGES_IN + cBaseImage ) + + /* Get single number images */ + + // Get dimensions + nWidth := oIDigits:Width() + nHeight := oIDigits:Height() + + // Check base digits image + DO CASE + CASE nWidth % 10 == 0 // 0..9 digits + nDigits := 10 + CASE nWidth % 11 == 0 // 0..9 : + nDigits := 11 + CASE nWidth % 13 == 0 // 0..9 : am pm + nDigits := 13 + OTHERWISE + uWrite( "Error on digits image" ) + ENDCASE + nNumWidth := nWidth / nDigits + + //? "nNumWidth, nWidth, nHeight, nDigits = ", nNumWidth, nWidth, nHeight, nDigits + + /* extracts single digits */ + FOR n := 1 TO nDigits + oTemp := oIDigits:Copy( (n - 1) * nNumWidth, 0, nNumWidth, nHeight ) + //oTemp:SaveGif( IMAGES_OUT + StrZero( n-1, 2 ) + ".gif" ) + // Here I have to clone the image, otherwise on var destruction I loose + // the image in memory + aAdd( aNumberImages, oTemp:Clone() ) + NEXT + + /* Create counter image in memory */ + oI := GDImage():New( nNumWidth * DISPLAY_NUM, nHeight ) // the counter + //? "Image dimensions: ", oI:Width(), oI:Height() + + /* Allocate background */ + white := oI:SetColor( 255, 255, 255 ) + + /* Allocate drawing color */ + //black := oI:SetColor( 0, 0, 0 ) + //blue := oI:SetColor( 0, 0, 255 ) + //red := oI:SetColor( 255, 0, 0 ) + //green := oI:SetColor( 0, 255, 0 ) + //cyan := oI:SetColor( 0, 255, 255 ) + + /* Draw rectangle */ + //oI:Rectangle( 0, 0, 200, 30, , blue ) + + /* Draw Digits */ + FOR n := 1 TO Len( cValue ) + // Retrieve the number from array in memory + oTemp := aNumberImages[ Val( SubStr( cValue, n, 1 ) ) + 1 ]:Clone() + // Save it to show the number for a position + //oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" ) + // Set the digit as tile that I have to use to fill position in counter + oI:SetTile( oTemp ) + // Fill the position with the image digit + oI:Rectangle( (n - 1) * nNumWidth, 0, (n - 1) * nNumWidth + nNumWidth, nHeight, TRUE, gdTiled ) + NEXT + + /* Write Final Counter Image */ + cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif" + //oI:SaveGif( IMAGES_OUT + cFile ) + + /* Destroy images in memory */ + // Class does it automatically + + //? + //? "Look at " + IMAGES_OUT + " folder for output images" + //? + +//RETURN cFile +RETURN oI:ToStringGif() + diff --git a/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg b/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg index e68f04bafc..9cf005abaf 100644 --- a/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg +++ b/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg @@ -1,400 +1,400 @@ -/* - * $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $ - */ - -/* - * Harbour Project source code: - * xml table servlet - * - * Copyright 2009 Francesco Saverio Giudice - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#include "common.ch" -#include "hbclass.ch" - -#define CRLF ( chr(13)+chr(10) ) -#define TABLE_NAME_PATH "..\..\..\tests\test.dbf" -#define SIMULATE_SLOW_REPLY - -MEMVAR _REQUEST // defined in uHTTPD - -FUNCTION HRBMAIN() - - LOCAL cXml, cPage, cCount, nCount - LOCAL oTM - LOCAL hGets - - hGets := _REQUEST - - DEFAULT hGets TO hb_Hash() - - IF HB_HHasKey( hGets, "page" ) - - cPage := hGets[ "page" ] - - oTM := TableManager():New() - - IF ( oTM:Open() ) - - oTM:Read() - cXml := oTM:getXmlData( Val( cPage ) ) - - oTM:Close() - - ENDIF - - ELSEIF HB_HHasKey( hGets, "count" ) - - cCount := hGets[ "count" ] - - IF cCount == "true" - - oTM := TableManager():New() - - IF ( oTM:Open() ) - - nCount := oTM:getLastRec() - cXml := oTM:getXmlCount( nCount ) - - oTM:Close() - - ENDIF - - ENDIF - ENDIF - - - IF !Empty( cXml ) - - uAddHeader("Content-Type", "text/xml") - // cache control - uAddHeader( "Cache-Control", "no-cache, must-revalidate" ) - uAddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" ) - - uWrite( cXml ) - - ELSE - - uAddHeader("Content-Type", "text/xml") - uWrite( '' ) - uWrite( 'No Data' ) - - ENDIF - -RETURN TRUE // I Handle HTML Output - -/* - TableManager -*/ - -CLASS TableManager - - CLASSVAR ROWS_PER_PAGE INIT 23 - - VAR aData INIT {} - - VAR cTable INIT TABLE_NAME_PATH - VAR lOpened INIT FALSE - - METHOD New() - METHOD Open() - METHOD Close() INLINE IIF( ::lOpened, ( table->( dbCloseArea() ), ::lOpened := FALSE ), ) - METHOD Read() - METHOD getLastRec() INLINE table->( LastRec() ) - METHOD getXmlData() - METHOD getXmlCount() - METHOD xmlEncode( input ) -ENDCLASS - -METHOD New() CLASS TableManager -RETURN Self - -METHOD Open() CLASS TableManager - LOCAL cDBF := ::cTable - - IF !::lOpened - - CLOSE ALL - USE ( cDBF ) ALIAS table SHARED NEW - ::lOpened := USED() - - ENDIF - -RETURN ::lOpened - -METHOD Read() CLASS TableManager - LOCAL hMap, lOk := FALSE - -#ifdef SIMULATE_SLOW_REPLY - // force slow connection to simulate long reply - HB_IDLESLEEP(0.5) -#endif - - IF ::lOpened - - table->( dbGoTop() ) - //n := 0 - DO WHILE table->( !Eof() ) //.AND. ++n < 50 - - hMap := hb_Hash() - hMap[ "recno" ] := StrZero( table->( RecNo() ), 4 ) - hMap[ "name" ] := RTrim( table->first ) + " " + RTrim( table->last ) - hMap[ "address" ] := RTrim( table->street ) - hMap[ "city" ] := RTrim( table->city ) - hMap[ "state" ] := table->state - hMap[ "zip" ] := table->zip - aAdd( ::aData, hMap ) - table->( dbSkip() ) - ENDDO - - lOk := TRUE - - ENDIF - -RETURN lOK - -/** - * Builds a String of XML representing the aData for the - * request table. - * - * For simplicity, we are using a hard-coded data set. In a production - * system, you may wish to use DAOs to query a database for specific table - * data. This may require additional parameters (e.g., the name of the - * table, which could be used to look up instructions on retrieving the - * necessary data). - * - * The returned XML will be formatted as follows: - * <table>
- * <header>
- * <cell key="address">Address</cell>
- * </header>
- * <row>
- * <cell key="name">Hank</cell>
- * <cell key="address">1B Something Street</cell>
- * <cell key="city">Marietta</cell>
- * <cell key="state">GA</cell>
- * <cell key="zip">30339</cell>
- * </row>
- * ...
- * </table> - * - * @param page - * the page number to retrieve data for - * @return a String of XML representing data for the - * requested table - * @throws IllegalArgumentException - */ - -METHOD getXmlData( page ) CLASS TableManager - LOCAL startIndex, stopIndex - LOCAL xml, i, map, key, cString - - /* - * For simplicity, we are creating XML as a String. In a production - * system, you should create an XML document (org.w3c.dom.Document) to - * ensure compliance with the DOM Level 2 Core Specification. - */ - - // Calculate the start and end indexes of the table data. - startIndex := (page - 1) * ::ROWS_PER_PAGE - stopIndex := startIndex + ::ROWS_PER_PAGE - stopIndex := Min( Len( ::aData ), stopIndex ) - - // Check the validity of the page index. - IF ( startIndex < 0 .OR. startIndex >= stopIndex ) - //throw new IllegalArgumentException("Page index is out of bounds."); - ENDIF - - xml := BasicXML():New() - - xml:append( '' ) - - // Add the opening tag - xml:append( "
" ) - - // Add nodes describing the table columns - xml:append( "
" ) - xml:append( 'RecNo') - xml:append( 'Name') - xml:append( 'Address' ) - xml:append( 'City' ) - xml:append( 'State' ) - xml:append( 'Zip' ) - xml:append( "
" ) - - // Add nodes for each row. - FOR i := startIndex + 1 TO stopIndex - map := ::aData[ i ] - - // Add the opening tag - xml:append( "" ) - - // For each entry in the HashMap, add a node - // e.g.,
123 four street
- FOR EACH key IN map:Keys - - cString := '' - cString += ::xmlEncode( hb_cStr( map[ key ] ) ) - cString += "" - - xml:append( cString ) - - NEXT - - // Add the closing tag - xml:append( "" ) - - NEXT - - // Add the closing
tag - xml:append( "" ) - -RETURN xml:toString() - -METHOD getXmlCount( nCount ) CLASS TableManager - LOCAL xml, n - LOCAL nPages := nCount / ::ROWS_PER_PAGE - - IF Int( nPages ) < nPages - nPages++ - ENDIF - - xml := BasicXML():New() - - xml:append( '' ) - - xml:append( "" ) - FOR n := 1 TO nPages - xml:append( "" + LTrim( Str( n ) ) + "" ) - NEXT - xml:append( "" ) - -RETURN xml:toString() - - /** - * Replaces characters commonly used in XML with symbolic representations - * such that they are interpretted correctly by XML parsers. - * - * @param input - * the string to encode. - * @return the encoded version of the specified string - */ -METHOD xmlEncode( input ) CLASS TableManager - - LOCAL out, i, c - - IF input == NIL - RETURN input - ENDIF - - // Go through the input string and replace the following - // characters: - // & & - // ' ' - // " " - // < < - // > > - // [any non-ascii character] &#[character code]; - - out := "" - - FOR i := 1 TO Len( input ) - c := SubStr( input, i, 1 ) - switch ( c ) - case '&' - out += "&" - exit - case "'" - out += "'" - exit - case '"' - out += """ - exit - case '<' - out += "<" - exit - case '>' - out += ">" - exit - //case ' ' - // out += " " - // exit - case Chr( 9 ) //E'\t' - case Chr( 13 ) //E'\r' - case Chr( 10 ) //E'\n' - out += c - exit - OTHERWISE - // All non-ascii - if ( Asc( c ) <= 0x1F .OR. Asc( c ) >= 0x80 ) - out += "&#x" + hb_NumToHex( Asc( c ) ) + ";" - else - out += c - endif - exit - end - NEXT - -RETURN out - -CLASS BasicXML - VAR aData INIT {} - - METHOD New() CONSTRUCTOR - METHOD Append( cString ) INLINE aAdd( ::aData, cString ) - METHOD ToString() - -ENDCLASS - -METHOD New() CLASS BasicXML - -RETURN Self - -METHOD ToString() CLASS BasicXML - LOCAL s := "" - - aEval( ::aData, {|c| s += c + IIF( Right( c, 1 ) == ">", CRLF, "" ) } ) - -RETURN s - +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * xml table servlet + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "common.ch" +#include "hbclass.ch" + +#define CRLF ( chr(13)+chr(10) ) +#define TABLE_NAME_PATH "..\..\..\tests\test.dbf" +#define SIMULATE_SLOW_REPLY + +MEMVAR _REQUEST // defined in uHTTPD + +FUNCTION HRBMAIN() + + LOCAL cXml, cPage, cCount, nCount + LOCAL oTM + LOCAL hGets + + hGets := _REQUEST + + DEFAULT hGets TO hb_Hash() + + IF HB_HHasKey( hGets, "page" ) + + cPage := hGets[ "page" ] + + oTM := TableManager():New() + + IF ( oTM:Open() ) + + oTM:Read() + cXml := oTM:getXmlData( Val( cPage ) ) + + oTM:Close() + + ENDIF + + ELSEIF HB_HHasKey( hGets, "count" ) + + cCount := hGets[ "count" ] + + IF cCount == "true" + + oTM := TableManager():New() + + IF ( oTM:Open() ) + + nCount := oTM:getLastRec() + cXml := oTM:getXmlCount( nCount ) + + oTM:Close() + + ENDIF + + ENDIF + ENDIF + + + IF !Empty( cXml ) + + uAddHeader("Content-Type", "text/xml") + // cache control + uAddHeader( "Cache-Control", "no-cache, must-revalidate" ) + uAddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" ) + + uWrite( cXml ) + + ELSE + + uAddHeader("Content-Type", "text/xml") + uWrite( '' ) + uWrite( 'No Data' ) + + ENDIF + +RETURN TRUE // I Handle HTML Output + +/* + TableManager +*/ + +CLASS TableManager + + CLASSVAR ROWS_PER_PAGE INIT 23 + + VAR aData INIT {} + + VAR cTable INIT TABLE_NAME_PATH + VAR lOpened INIT FALSE + + METHOD New() + METHOD Open() + METHOD Close() INLINE IIF( ::lOpened, ( table->( dbCloseArea() ), ::lOpened := FALSE ), ) + METHOD Read() + METHOD getLastRec() INLINE table->( LastRec() ) + METHOD getXmlData() + METHOD getXmlCount() + METHOD xmlEncode( input ) +ENDCLASS + +METHOD New() CLASS TableManager +RETURN Self + +METHOD Open() CLASS TableManager + LOCAL cDBF := ::cTable + + IF !::lOpened + + CLOSE ALL + USE ( cDBF ) ALIAS table SHARED NEW + ::lOpened := USED() + + ENDIF + +RETURN ::lOpened + +METHOD Read() CLASS TableManager + LOCAL hMap, lOk := FALSE + +#ifdef SIMULATE_SLOW_REPLY + // force slow connection to simulate long reply + HB_IDLESLEEP(0.5) +#endif + + IF ::lOpened + + table->( dbGoTop() ) + //n := 0 + DO WHILE table->( !Eof() ) //.AND. ++n < 50 + + hMap := hb_Hash() + hMap[ "recno" ] := StrZero( table->( RecNo() ), 4 ) + hMap[ "name" ] := RTrim( table->first ) + " " + RTrim( table->last ) + hMap[ "address" ] := RTrim( table->street ) + hMap[ "city" ] := RTrim( table->city ) + hMap[ "state" ] := table->state + hMap[ "zip" ] := table->zip + aAdd( ::aData, hMap ) + table->( dbSkip() ) + ENDDO + + lOk := TRUE + + ENDIF + +RETURN lOK + +/** + * Builds a String of XML representing the aData for the + * request table. + * + * For simplicity, we are using a hard-coded data set. In a production + * system, you may wish to use DAOs to query a database for specific table + * data. This may require additional parameters (e.g., the name of the + * table, which could be used to look up instructions on retrieving the + * necessary data). + * + * The returned XML will be formatted as follows: + * <table>
+ * <header>
+ * <cell key="address">Address</cell>
+ * </header>
+ * <row>
+ * <cell key="name">Hank</cell>
+ * <cell key="address">1B Something Street</cell>
+ * <cell key="city">Marietta</cell>
+ * <cell key="state">GA</cell>
+ * <cell key="zip">30339</cell>
+ * </row>
+ * ...
+ * </table> + * + * @param page + * the page number to retrieve data for + * @return a String of XML representing data for the + * requested table + * @throws IllegalArgumentException + */ + +METHOD getXmlData( page ) CLASS TableManager + LOCAL startIndex, stopIndex + LOCAL xml, i, map, key, cString + + /* + * For simplicity, we are creating XML as a String. In a production + * system, you should create an XML document (org.w3c.dom.Document) to + * ensure compliance with the DOM Level 2 Core Specification. + */ + + // Calculate the start and end indexes of the table data. + startIndex := (page - 1) * ::ROWS_PER_PAGE + stopIndex := startIndex + ::ROWS_PER_PAGE + stopIndex := Min( Len( ::aData ), stopIndex ) + + // Check the validity of the page index. + IF ( startIndex < 0 .OR. startIndex >= stopIndex ) + //throw new IllegalArgumentException("Page index is out of bounds."); + ENDIF + + xml := BasicXML():New() + + xml:append( '' ) + + // Add the opening tag + xml:append( "
" ) + + // Add nodes describing the table columns + xml:append( "
" ) + xml:append( 'RecNo') + xml:append( 'Name') + xml:append( 'Address' ) + xml:append( 'City' ) + xml:append( 'State' ) + xml:append( 'Zip' ) + xml:append( "
" ) + + // Add nodes for each row. + FOR i := startIndex + 1 TO stopIndex + map := ::aData[ i ] + + // Add the opening tag + xml:append( "" ) + + // For each entry in the HashMap, add a node + // e.g.,
123 four street
+ FOR EACH key IN map:Keys + + cString := '' + cString += ::xmlEncode( hb_cStr( map[ key ] ) ) + cString += "" + + xml:append( cString ) + + NEXT + + // Add the closing tag + xml:append( "" ) + + NEXT + + // Add the closing
tag + xml:append( "" ) + +RETURN xml:toString() + +METHOD getXmlCount( nCount ) CLASS TableManager + LOCAL xml, n + LOCAL nPages := nCount / ::ROWS_PER_PAGE + + IF Int( nPages ) < nPages + nPages++ + ENDIF + + xml := BasicXML():New() + + xml:append( '' ) + + xml:append( "" ) + FOR n := 1 TO nPages + xml:append( "" + LTrim( Str( n ) ) + "" ) + NEXT + xml:append( "" ) + +RETURN xml:toString() + + /** + * Replaces characters commonly used in XML with symbolic representations + * such that they are interpretted correctly by XML parsers. + * + * @param input + * the string to encode. + * @return the encoded version of the specified string + */ +METHOD xmlEncode( input ) CLASS TableManager + + LOCAL out, i, c + + IF input == NIL + RETURN input + ENDIF + + // Go through the input string and replace the following + // characters: + // & & + // ' ' + // " " + // < < + // > > + // [any non-ascii character] &#[character code]; + + out := "" + + FOR i := 1 TO Len( input ) + c := SubStr( input, i, 1 ) + switch ( c ) + case '&' + out += "&" + exit + case "'" + out += "'" + exit + case '"' + out += """ + exit + case '<' + out += "<" + exit + case '>' + out += ">" + exit + //case ' ' + // out += " " + // exit + case Chr( 9 ) //E'\t' + case Chr( 13 ) //E'\r' + case Chr( 10 ) //E'\n' + out += c + exit + OTHERWISE + // All non-ascii + if ( Asc( c ) <= 0x1F .OR. Asc( c ) >= 0x80 ) + out += "&#x" + hb_NumToHex( Asc( c ) ) + ";" + else + out += c + endif + exit + end + NEXT + +RETURN out + +CLASS BasicXML + VAR aData INIT {} + + METHOD New() CONSTRUCTOR + METHOD Append( cString ) INLINE aAdd( ::aData, cString ) + METHOD ToString() + +ENDCLASS + +METHOD New() CLASS BasicXML + +RETURN Self + +METHOD ToString() CLASS BasicXML + LOCAL s := "" + + aEval( ::aData, {|c| s += c + IIF( Right( c, 1 ) == ">", CRLF, "" ) } ) + +RETURN s + diff --git a/harbour/contrib/examples/uhttpd/modules/testajax.prg b/harbour/contrib/examples/uhttpd/modules/testajax.prg index 344ad5c32c..a3e0551991 100644 --- a/harbour/contrib/examples/uhttpd/modules/testajax.prg +++ b/harbour/contrib/examples/uhttpd/modules/testajax.prg @@ -1,69 +1,69 @@ -/* - * $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $ - */ - -/* - * Harbour Project source code: - * simple ajax responder - * - * Copyright 2009 Francesco Saverio Giudice - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#include "common.ch" - -MEMVAR _REQUEST - -FUNCTION HRBMAIN() - LOCAL cW - LOCAL cHtml := "" - - IF HB_HHasKey( _REQUEST, "w" ) - IF !Empty( cW := _REQUEST[ "w" ] ) - cHtml += "This is a reply from testajax : " + cW - ENDIF - ENDIF - -RETURN cHtml - - +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * simple ajax responder + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "common.ch" + +MEMVAR _REQUEST + +FUNCTION HRBMAIN() + LOCAL cW + LOCAL cHtml := "" + + IF HB_HHasKey( _REQUEST, "w" ) + IF !Empty( cW := _REQUEST[ "w" ] ) + cHtml += "This is a reply from testajax : " + cW + ENDIF + ENDIF + +RETURN cHtml + + diff --git a/harbour/contrib/examples/uhttpd/readme.txt b/harbour/contrib/examples/uhttpd/readme.txt index 2acae603fb..a311e6e20c 100644 --- a/harbour/contrib/examples/uhttpd/readme.txt +++ b/harbour/contrib/examples/uhttpd/readme.txt @@ -1,18 +1,18 @@ - -uHTTPD micro web server - -Build it using hbmk*.bat -Parameters accepted: --without-gd (disable Lib GD support) - -To see accepted parameters run: uhttpd -? -Parameters can also be defined using uhttpd.ini file. - -Before starting please build modules in modules folder using bldhrb.bat - -Once started connect to uhttpd using: -http://localhost:8082 -to see default index page. - -Francesco - - + +uHTTPD micro web server + +Build it using hbmk*.bat +Parameters accepted: --without-gd (disable Lib GD support) + +To see accepted parameters run: uhttpd -? +Parameters can also be defined using uhttpd.ini file. + +Before starting please build modules in modules folder using bldhrb.bat + +Once started connect to uhttpd using: +http://localhost:8082 +to see default index page. + +Francesco + + diff --git a/harbour/contrib/examples/uhttpd/socket.c b/harbour/contrib/examples/uhttpd/socket.c index dd26fc9ac9..24337951d6 100644 --- a/harbour/contrib/examples/uhttpd/socket.c +++ b/harbour/contrib/examples/uhttpd/socket.c @@ -1,416 +1,416 @@ -#include -#include "hbapi.h" -#include "hbapiitm.h" - -/* - - Function naming: - The intention of this library is to be as close as possible to the original - socket implementation. This supposed to be valid for function names also, - but some of the names are very platform dependent, ex., WSA*() functions. - select() function name is reserved for standard Harbour's function, so, - socket_*() prefix was used: - socket_init() - WSAStartup() - socket_exit() - WSACleanup() - socket_error() - WSALastError() - socket_select() - select() - Finally I renamed all functions to have socket_*() prefix to be more "prefix - compatible" and not to occupy a general function names like send(), bind(), - accept(), listen(), etc.: - socket_create() - socket() - socket_close() - closesocket() - socket_shutdown() - shutdown() - socket_bind() - bind() - socket_listen() - listen() - socket_accept() - accept() - socket_send() - send() - socket_recv() - recv() - socket_recv() - recv() - socket_getsockname() - getsockname() - socket_getpeername() - getpeername() - - - Types mapping: - SOCKET - UINT_PTR in Windows, let's map it to pointer type, and INVALID_SOCKET value to NIL - - struct sockaddr - It is not only IP addresses, also can be IPX, etc. All network-host byte order - conversion should be hidden from Harbour API. So, let's map to: - { adress_familly, ... } - AF_INET: { AF_INET, cAddr, nPort } - other: { AF_?, cAddressDump } -*/ - -#ifdef hb_parnidef -#undef hb_parnidef -#endif - - -static int hb_parnidef( int iParam, int iValue ) -{ - return ISNUM( iParam ) ? hb_parni( iParam ) : iValue; -} - - -static SOCKET hb_parsocket( int iParam ) -{ - return ISPOINTER( iParam ) ? ( SOCKET ) hb_parptr( 1 ) : INVALID_SOCKET; -} - - -static void hb_retsocket( SOCKET hSocket ) -{ - if( hSocket == INVALID_SOCKET ) - hb_ret(); - else - hb_retptr( ( void* ) hSocket ); -} - - -static SOCKET hb_itemGetSocket( PHB_ITEM pItem ) -{ - return HB_IS_POINTER( pItem ) ? ( SOCKET ) hb_itemGetPtr( pItem ) : INVALID_SOCKET; -} - - -static PHB_ITEM hb_itemPutSocket( PHB_ITEM pItem, SOCKET hSocket ) -{ - if( ! pItem ) - pItem = hb_itemNew( NULL ); - - if( hSocket == INVALID_SOCKET ) - hb_itemClear( pItem ); - else - hb_itemPutPtr( pItem, ( void* ) hSocket ); - - return pItem; -} - - -static void hb_itemGetSockaddr( PHB_ITEM pItem, struct sockaddr* sa ) -{ - memset( sa, 0, sizeof( struct sockaddr ) ); - - if( HB_IS_ARRAY( pItem ) ) - { - sa->sa_family = hb_arrayGetNI( pItem, 1 ); - - if( sa->sa_family == AF_INET ) - { - ( ( struct sockaddr_in* ) sa)->sin_addr.S_un.S_addr = inet_addr( hb_arrayGetCPtr( pItem, 2 ) ); - ( ( struct sockaddr_in* ) sa)->sin_port = htons( hb_arrayGetNI( pItem, 3 ) ); - } - else - { - ULONG ulLen = hb_arrayGetCLen( pItem, 2 ); - - if( ulLen > sizeof( sa->sa_data ) ) - ulLen = sizeof( sa->sa_data ); - memcpy( sa->sa_data, hb_arrayGetCPtr( pItem, 2 ), ulLen ); - } - } -} - - -static PHB_ITEM hb_itemPutSockaddr( PHB_ITEM pItem, const struct sockaddr* saddr ) -{ - pItem = hb_itemNew( pItem ); - - if( saddr->sa_family == AF_INET ) - { - hb_arrayNew( pItem, 3 ); - hb_arraySetNI( pItem, 1, saddr->sa_family ); - hb_arraySetC( pItem, 2, inet_ntoa( ( ( struct sockaddr_in* ) saddr )->sin_addr ) ); - hb_arraySetNI( pItem, 3, ntohs( ( ( struct sockaddr_in* ) saddr )->sin_port ) ); - } - else - { - hb_arrayNew( pItem, 2 ); - hb_arraySetNI( pItem, 1, saddr->sa_family ); - hb_arraySetCL( pItem, 2, saddr->sa_data, sizeof( saddr->sa_data ) ); - } - return pItem; -} - - -HB_FUNC ( SOCKET_INIT ) -{ - WSADATA wsad; - - hb_retni( WSAStartup( hb_parnidef( 1, 257 ), &wsad ) ); - hb_storclen( (char*) &wsad, sizeof( WSADATA ), 2 ); -} - - -HB_FUNC ( SOCKET_EXIT ) -{ - hb_retni( WSACleanup() ); -} - - -HB_FUNC ( SOCKET_ERROR ) -{ - hb_retni( WSAGetLastError() ); -} - - -HB_FUNC ( SOCKET_CREATE ) -{ - hb_retsocket( socket( hb_parnidef( 1, PF_INET ), - hb_parnidef( 2, SOCK_STREAM ), - hb_parnidef( 3, IPPROTO_TCP ) ) ); -} - - -HB_FUNC ( SOCKET_CLOSE ) -{ - hb_retni( closesocket( hb_parsocket( 1 ) ) ); -} - - -HB_FUNC ( SOCKET_BIND ) -{ - struct sockaddr sa; - - hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa ); - hb_retni( bind( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) ); -} - - -HB_FUNC ( SOCKET_LISTEN ) -{ - hb_retni( listen( hb_parsocket( 1 ), hb_parnidef( 2, 10 ) ) ); -} - - -HB_FUNC ( SOCKET_ACCEPT ) -{ - struct sockaddr saddr; - int iSize = sizeof( struct sockaddr ); - - hb_retsocket( accept( hb_parsocket( 1 ), &saddr, &iSize ) ); - - if( ISBYREF( 2 ) ) - { - hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) ); - } -} - - -HB_FUNC ( SOCKET_SHUTDOWN ) -{ - hb_retni( shutdown( hb_parsocket( 1 ), hb_parnidef( 2, SD_BOTH ) ) ); -} - - -HB_FUNC ( SOCKET_RECV ) -{ - int iLen, iRet; - char* pBuf; - - iLen = hb_parni( 3 ); - - if( iLen > 65536 || iLen <= 0 ) - iLen = 4096; - - pBuf = ( char* ) hb_xgrab( ( ULONG ) iLen ); - iRet = recv( hb_parsocket( 1 ), pBuf, iLen, hb_parnidef( 4, 0 ) ); - hb_retni( iRet ); - hb_storclen( pBuf, iRet > 0 ? iRet : 0, 2 ); - hb_xfree( pBuf ); -} - - -HB_FUNC ( SOCKET_SEND ) -{ - hb_retni( send( hb_parsocket( 1 ), hb_parc( 2 ), hb_parclen( 2 ), hb_parni( 3, 0 ) ) ); -} - - -HB_FUNC ( SOCKET_SELECT ) -{ - fd_set setread, setwrite, seterror; - BOOL bRead = 0, bWrite = 0, bError = 0; - struct timeval tv; - SOCKET socket, maxsocket; - PHB_ITEM pArray, pItem; - ULONG ulLen, ulIndex, ulCount; - LONG lTimeout; - int iRet; - - - FD_ZERO( &setread ); - FD_ZERO( &setwrite ); - FD_ZERO( &seterror ); - - maxsocket = (SOCKET) 0; - - pArray = hb_param( 1, HB_IT_ARRAY ); - if( pArray ) - { - ulLen = hb_arrayLen( pArray ); - for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) - { - socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); - if( socket != INVALID_SOCKET ) - { - bRead = 1; - FD_SET( socket, &setread ); - if( socket > maxsocket ) - maxsocket = socket; - } - } - } - - pArray = hb_param( 2, HB_IT_ARRAY ); - if( pArray ) - { - ulLen = hb_arrayLen( pArray ); - for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) - { - socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); - if( socket != INVALID_SOCKET ) - { - bWrite = 1; - FD_SET( socket, &setwrite ); - if( socket > maxsocket ) - maxsocket = socket; - } - } - } - - pArray = hb_param( 3, HB_IT_ARRAY ); - if( pArray ) - { - ulLen = hb_arrayLen( pArray ); - for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) - { - socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); - if( socket != INVALID_SOCKET ) - { - bError = 1; - FD_SET( socket, &seterror ); - if( socket > maxsocket ) - maxsocket = socket; - } - } - } - - /* Default forever */ - lTimeout = ISNUM( 4 ) ? hb_parnl( 4 ) : -1; - - if( lTimeout == -1 ) - { - iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL, - bError ? &seterror : NULL, NULL ); - } - else - { - tv.tv_sec = lTimeout / 1000; - tv.tv_usec = ( lTimeout % 1000 ) * 1000; - iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL, - bError ? &seterror : NULL, &tv ); - } - - pArray = hb_param( 1, HB_IT_ARRAY ); - if( pArray && ISBYREF( 1 ) ) - { - ulLen = hb_arrayLen( pArray ); - pItem = hb_itemNew( NULL ); - hb_arrayNew( pItem, ulLen ); - ulCount = 0; - for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) - { - socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); - if( socket != INVALID_SOCKET ) - { - if( FD_ISSET( socket, &setread ) ) - { - hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) ); - } - } - } - hb_itemParamStoreForward( 1, pItem ); - } - - pArray = hb_param( 2, HB_IT_ARRAY ); - if( pArray && ISBYREF( 2 ) ) - { - ulLen = hb_arrayLen( pArray ); - pItem = hb_itemNew( NULL ); - hb_arrayNew( pItem, ulLen ); - ulCount = 0; - for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) - { - socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); - if( socket != INVALID_SOCKET ) - { - if( FD_ISSET( socket, &setwrite ) ) - { - hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) ); - } - } - } - hb_itemParamStoreForward( 2, pItem ); - } - - pArray = hb_param( 3, HB_IT_ARRAY ); - if( pArray && ISBYREF( 3 ) ) - { - ulLen = hb_arrayLen( pArray ); - pItem = hb_itemNew( NULL ); - hb_arrayNew( pItem, ulLen ); - ulCount = 0; - for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) - { - socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); - if( socket != INVALID_SOCKET ) - { - if( FD_ISSET( socket, &seterror ) ) - { - hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) ); - } - } - } - hb_itemParamStoreForward( 3, pItem ); - } - - hb_retni( iRet ); -} - - -HB_FUNC ( SOCKET_GETSOCKNAME ) -{ - struct sockaddr saddr; - int iSize = sizeof( struct sockaddr ); - - hb_retni( getsockname( hb_parsocket( 1 ), &saddr, &iSize ) ); - if( ISBYREF( 2 ) ) - { - hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) ); - } -} - - -HB_FUNC ( SOCKET_GETPEERNAME ) -{ - struct sockaddr saddr; - int iSize = sizeof( struct sockaddr ); - - hb_retni( getpeername( hb_parsocket( 1 ), &saddr, &iSize ) ); - if( ISBYREF( 2 ) ) - { - hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) ); - } -} - - -HB_FUNC ( CONNECT ) -{ - struct sockaddr sa; - - hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa ); - hb_retni( connect( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) ); -} - +#include +#include "hbapi.h" +#include "hbapiitm.h" + +/* + + Function naming: + The intention of this library is to be as close as possible to the original + socket implementation. This supposed to be valid for function names also, + but some of the names are very platform dependent, ex., WSA*() functions. + select() function name is reserved for standard Harbour's function, so, + socket_*() prefix was used: + socket_init() - WSAStartup() + socket_exit() - WSACleanup() + socket_error() - WSALastError() + socket_select() - select() + Finally I renamed all functions to have socket_*() prefix to be more "prefix + compatible" and not to occupy a general function names like send(), bind(), + accept(), listen(), etc.: + socket_create() - socket() + socket_close() - closesocket() + socket_shutdown() - shutdown() + socket_bind() - bind() + socket_listen() - listen() + socket_accept() - accept() + socket_send() - send() + socket_recv() - recv() + socket_recv() - recv() + socket_getsockname() - getsockname() + socket_getpeername() - getpeername() + + + Types mapping: + SOCKET + UINT_PTR in Windows, let's map it to pointer type, and INVALID_SOCKET value to NIL + + struct sockaddr + It is not only IP addresses, also can be IPX, etc. All network-host byte order + conversion should be hidden from Harbour API. So, let's map to: + { adress_familly, ... } + AF_INET: { AF_INET, cAddr, nPort } + other: { AF_?, cAddressDump } +*/ + +#ifdef hb_parnidef +#undef hb_parnidef +#endif + + +static int hb_parnidef( int iParam, int iValue ) +{ + return ISNUM( iParam ) ? hb_parni( iParam ) : iValue; +} + + +static SOCKET hb_parsocket( int iParam ) +{ + return ISPOINTER( iParam ) ? ( SOCKET ) hb_parptr( 1 ) : INVALID_SOCKET; +} + + +static void hb_retsocket( SOCKET hSocket ) +{ + if( hSocket == INVALID_SOCKET ) + hb_ret(); + else + hb_retptr( ( void* ) hSocket ); +} + + +static SOCKET hb_itemGetSocket( PHB_ITEM pItem ) +{ + return HB_IS_POINTER( pItem ) ? ( SOCKET ) hb_itemGetPtr( pItem ) : INVALID_SOCKET; +} + + +static PHB_ITEM hb_itemPutSocket( PHB_ITEM pItem, SOCKET hSocket ) +{ + if( ! pItem ) + pItem = hb_itemNew( NULL ); + + if( hSocket == INVALID_SOCKET ) + hb_itemClear( pItem ); + else + hb_itemPutPtr( pItem, ( void* ) hSocket ); + + return pItem; +} + + +static void hb_itemGetSockaddr( PHB_ITEM pItem, struct sockaddr* sa ) +{ + memset( sa, 0, sizeof( struct sockaddr ) ); + + if( HB_IS_ARRAY( pItem ) ) + { + sa->sa_family = hb_arrayGetNI( pItem, 1 ); + + if( sa->sa_family == AF_INET ) + { + ( ( struct sockaddr_in* ) sa)->sin_addr.S_un.S_addr = inet_addr( hb_arrayGetCPtr( pItem, 2 ) ); + ( ( struct sockaddr_in* ) sa)->sin_port = htons( hb_arrayGetNI( pItem, 3 ) ); + } + else + { + ULONG ulLen = hb_arrayGetCLen( pItem, 2 ); + + if( ulLen > sizeof( sa->sa_data ) ) + ulLen = sizeof( sa->sa_data ); + memcpy( sa->sa_data, hb_arrayGetCPtr( pItem, 2 ), ulLen ); + } + } +} + + +static PHB_ITEM hb_itemPutSockaddr( PHB_ITEM pItem, const struct sockaddr* saddr ) +{ + pItem = hb_itemNew( pItem ); + + if( saddr->sa_family == AF_INET ) + { + hb_arrayNew( pItem, 3 ); + hb_arraySetNI( pItem, 1, saddr->sa_family ); + hb_arraySetC( pItem, 2, inet_ntoa( ( ( struct sockaddr_in* ) saddr )->sin_addr ) ); + hb_arraySetNI( pItem, 3, ntohs( ( ( struct sockaddr_in* ) saddr )->sin_port ) ); + } + else + { + hb_arrayNew( pItem, 2 ); + hb_arraySetNI( pItem, 1, saddr->sa_family ); + hb_arraySetCL( pItem, 2, saddr->sa_data, sizeof( saddr->sa_data ) ); + } + return pItem; +} + + +HB_FUNC ( SOCKET_INIT ) +{ + WSADATA wsad; + + hb_retni( WSAStartup( hb_parnidef( 1, 257 ), &wsad ) ); + hb_storclen( (char*) &wsad, sizeof( WSADATA ), 2 ); +} + + +HB_FUNC ( SOCKET_EXIT ) +{ + hb_retni( WSACleanup() ); +} + + +HB_FUNC ( SOCKET_ERROR ) +{ + hb_retni( WSAGetLastError() ); +} + + +HB_FUNC ( SOCKET_CREATE ) +{ + hb_retsocket( socket( hb_parnidef( 1, PF_INET ), + hb_parnidef( 2, SOCK_STREAM ), + hb_parnidef( 3, IPPROTO_TCP ) ) ); +} + + +HB_FUNC ( SOCKET_CLOSE ) +{ + hb_retni( closesocket( hb_parsocket( 1 ) ) ); +} + + +HB_FUNC ( SOCKET_BIND ) +{ + struct sockaddr sa; + + hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa ); + hb_retni( bind( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) ); +} + + +HB_FUNC ( SOCKET_LISTEN ) +{ + hb_retni( listen( hb_parsocket( 1 ), hb_parnidef( 2, 10 ) ) ); +} + + +HB_FUNC ( SOCKET_ACCEPT ) +{ + struct sockaddr saddr; + int iSize = sizeof( struct sockaddr ); + + hb_retsocket( accept( hb_parsocket( 1 ), &saddr, &iSize ) ); + + if( ISBYREF( 2 ) ) + { + hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) ); + } +} + + +HB_FUNC ( SOCKET_SHUTDOWN ) +{ + hb_retni( shutdown( hb_parsocket( 1 ), hb_parnidef( 2, SD_BOTH ) ) ); +} + + +HB_FUNC ( SOCKET_RECV ) +{ + int iLen, iRet; + char* pBuf; + + iLen = hb_parni( 3 ); + + if( iLen > 65536 || iLen <= 0 ) + iLen = 4096; + + pBuf = ( char* ) hb_xgrab( ( ULONG ) iLen ); + iRet = recv( hb_parsocket( 1 ), pBuf, iLen, hb_parnidef( 4, 0 ) ); + hb_retni( iRet ); + hb_storclen( pBuf, iRet > 0 ? iRet : 0, 2 ); + hb_xfree( pBuf ); +} + + +HB_FUNC ( SOCKET_SEND ) +{ + hb_retni( send( hb_parsocket( 1 ), hb_parc( 2 ), hb_parclen( 2 ), hb_parni( 3, 0 ) ) ); +} + + +HB_FUNC ( SOCKET_SELECT ) +{ + fd_set setread, setwrite, seterror; + BOOL bRead = 0, bWrite = 0, bError = 0; + struct timeval tv; + SOCKET socket, maxsocket; + PHB_ITEM pArray, pItem; + ULONG ulLen, ulIndex, ulCount; + LONG lTimeout; + int iRet; + + + FD_ZERO( &setread ); + FD_ZERO( &setwrite ); + FD_ZERO( &seterror ); + + maxsocket = (SOCKET) 0; + + pArray = hb_param( 1, HB_IT_ARRAY ); + if( pArray ) + { + ulLen = hb_arrayLen( pArray ); + for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) + { + socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); + if( socket != INVALID_SOCKET ) + { + bRead = 1; + FD_SET( socket, &setread ); + if( socket > maxsocket ) + maxsocket = socket; + } + } + } + + pArray = hb_param( 2, HB_IT_ARRAY ); + if( pArray ) + { + ulLen = hb_arrayLen( pArray ); + for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) + { + socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); + if( socket != INVALID_SOCKET ) + { + bWrite = 1; + FD_SET( socket, &setwrite ); + if( socket > maxsocket ) + maxsocket = socket; + } + } + } + + pArray = hb_param( 3, HB_IT_ARRAY ); + if( pArray ) + { + ulLen = hb_arrayLen( pArray ); + for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) + { + socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); + if( socket != INVALID_SOCKET ) + { + bError = 1; + FD_SET( socket, &seterror ); + if( socket > maxsocket ) + maxsocket = socket; + } + } + } + + /* Default forever */ + lTimeout = ISNUM( 4 ) ? hb_parnl( 4 ) : -1; + + if( lTimeout == -1 ) + { + iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL, + bError ? &seterror : NULL, NULL ); + } + else + { + tv.tv_sec = lTimeout / 1000; + tv.tv_usec = ( lTimeout % 1000 ) * 1000; + iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL, + bError ? &seterror : NULL, &tv ); + } + + pArray = hb_param( 1, HB_IT_ARRAY ); + if( pArray && ISBYREF( 1 ) ) + { + ulLen = hb_arrayLen( pArray ); + pItem = hb_itemNew( NULL ); + hb_arrayNew( pItem, ulLen ); + ulCount = 0; + for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) + { + socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); + if( socket != INVALID_SOCKET ) + { + if( FD_ISSET( socket, &setread ) ) + { + hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) ); + } + } + } + hb_itemParamStoreForward( 1, pItem ); + } + + pArray = hb_param( 2, HB_IT_ARRAY ); + if( pArray && ISBYREF( 2 ) ) + { + ulLen = hb_arrayLen( pArray ); + pItem = hb_itemNew( NULL ); + hb_arrayNew( pItem, ulLen ); + ulCount = 0; + for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) + { + socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); + if( socket != INVALID_SOCKET ) + { + if( FD_ISSET( socket, &setwrite ) ) + { + hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) ); + } + } + } + hb_itemParamStoreForward( 2, pItem ); + } + + pArray = hb_param( 3, HB_IT_ARRAY ); + if( pArray && ISBYREF( 3 ) ) + { + ulLen = hb_arrayLen( pArray ); + pItem = hb_itemNew( NULL ); + hb_arrayNew( pItem, ulLen ); + ulCount = 0; + for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ ) + { + socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) ); + if( socket != INVALID_SOCKET ) + { + if( FD_ISSET( socket, &seterror ) ) + { + hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) ); + } + } + } + hb_itemParamStoreForward( 3, pItem ); + } + + hb_retni( iRet ); +} + + +HB_FUNC ( SOCKET_GETSOCKNAME ) +{ + struct sockaddr saddr; + int iSize = sizeof( struct sockaddr ); + + hb_retni( getsockname( hb_parsocket( 1 ), &saddr, &iSize ) ); + if( ISBYREF( 2 ) ) + { + hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) ); + } +} + + +HB_FUNC ( SOCKET_GETPEERNAME ) +{ + struct sockaddr saddr; + int iSize = sizeof( struct sockaddr ); + + hb_retni( getpeername( hb_parsocket( 1 ), &saddr, &iSize ) ); + if( ISBYREF( 2 ) ) + { + hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) ); + } +} + + +HB_FUNC ( CONNECT ) +{ + struct sockaddr sa; + + hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa ); + hb_retni( connect( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) ); +} + diff --git a/harbour/contrib/examples/uhttpd/uhttpd.ini b/harbour/contrib/examples/uhttpd/uhttpd.ini index e15d4f98e0..382c377be3 100644 --- a/harbour/contrib/examples/uhttpd/uhttpd.ini +++ b/harbour/contrib/examples/uhttpd/uhttpd.ini @@ -1,35 +1,35 @@ -# -# uHTTPD ini file (defaults are commented) -# - -# --- server listen port -#Port = 8082 - -# --- document flags - $(APP_DIR) is application folder -#document_root = $(APP_DIR)\home - -# --- display folder content -#show_indexes = .f. - -[THREADS] -# --- how much a thread has to wait a connection before quit -#max_wait = 60 - -# --- how many threads have to run always -#start_num = 4 - -# --- how many threads can be added to initial threads -# (over this number server replies with BUSY error) -#max_num = 20 - -[LOGFILES] -# --- path for access lot -#access = logs\access.log - -# --- path for error log -#error = logs\error.log - -[ALIASES] -# --- here put aliases to real path -# (under document_root path defined above) -/info = /cgi-bin/info.hrb +# +# uHTTPD ini file (defaults are commented) +# + +# --- server listen port +#Port = 8082 + +# --- document flags - $(APP_DIR) is application folder +#document_root = $(APP_DIR)\home + +# --- display folder content +#show_indexes = .f. + +[THREADS] +# --- how much a thread has to wait a connection before quit +#max_wait = 60 + +# --- how many threads have to run always +#start_num = 4 + +# --- how many threads can be added to initial threads +# (over this number server replies with BUSY error) +#max_num = 20 + +[LOGFILES] +# --- path for access lot +#access = logs\access.log + +# --- path for error log +#error = logs\error.log + +[ALIASES] +# --- here put aliases to real path +# (under document_root path defined above) +/info = /cgi-bin/info.hrb diff --git a/harbour/contrib/examples/uhttpd/uhttpd.prg b/harbour/contrib/examples/uhttpd/uhttpd.prg index bf2a378cf3..5fc23e7daa 100644 --- a/harbour/contrib/examples/uhttpd/uhttpd.prg +++ b/harbour/contrib/examples/uhttpd/uhttpd.prg @@ -1,1942 +1,1942 @@ -/* - * $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $ - */ - -/* - * Harbour Project source code: - * uHTTPD (Micro HTTP server) - * - * Copyright 2009 Francesco Saverio Giudice - * Copyright 2008 Mindaugas Kavaliauskas (dbtopas at dbtopas.lt) - * www - http://www.harbour-project.org - * - * Credits: - * Based on first version posted from Mindaugas Kavaliauskas on - * developers NG on December 15th, 2008 whom give my thanks to have - * shared initial work. - * Francesco. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -/* - * A simple HTTP server. - * - * More description to come. - * - * - */ - -/* - TODO: - -*/ - -// comment out this line to activate hb_toOutDebug() -#define DEBUG_ACTIVE - -#ifndef _XHARBOUR_ - #include "hbcompat.ch" -#endif -#include "fileio.ch" -#include "common.ch" -#include "inkey.ch" - -#include "hbextern.ch" // need this to use with HRB - -#ifdef GD_SUPPORT - // adding GD support - REQUEST GDIMAGE, gdImageChar, GDCHART - #define APP_GD_SUPPORT "_GD" -#else - #define APP_GD_SUPPORT "" -#endif - -#ifdef USE_HB_INET - #define APP_INET_SUPPORT "_INET" -#else - #define APP_INET_SUPPORT "" -#endif - -#define APP_NAME "uhttpd_inet" -#define APP_VER_NUM "0.3" -#define APP_VERSION APP_VER_NUM + APP_GD_SUPPORT + APP_INET_SUPPORT - -#define AF_INET 2 - -// default values - they can changes using line command switch -#define START_RUNNING_THREADS 4 // Start threads to serve connections -#define MAX_RUNNING_THREADS 20 // Max running threads - -#define START_SERVICE_THREADS 1 // Initial number for service connections -#define MAX_SERVICE_THREADS 3 // Max running threads - -#define LISTEN_PORT 8082 // differs from standard 80 port for tests in case - // anyone has a apache/IIS installed -#define FILE_STOP ".uhttpd.stop" -#define FILE_ACCESS_LOG "logs\access.log" -#define FILE_ERROR_LOG "logs\error.log" - -#define PAGE_STATUS_REFRESH 1 -#define THREAD_MAX_WAIT ( 60 ) // HOW MUCH TIME THREAD HAS TO WAIT BEFORE FINISH - IN SECONDS - -#define CR_LF (CHR(13)+CHR(10)) -#define HB_IHASH() HB_HSETCASEMATCH( {=>}, FALSE ) - -#ifndef _XHARBOUR_ - - #ifdef __PLATFORM__WINDOWS - REQUEST HB_GT_WVT_DEFAULT - REQUEST HB_GT_WIN - REQUEST HB_GT_NUL - #ifdef HB_MT_VM - #define THREAD_GT hb_gtVersion() - #endif - #else - REQUEST HB_GT_STD_DEFAULT - REQUEST HB_GT_NUL - #define THREAD_GT "XWC" - #endif - -#else - - REQUEST HB_GT_WVT - REQUEST HB_GT_WIN - REQUEST HB_GT_NUL - -#endif - -// dynamic call for HRB support -DYNAMIC HRBMAIN - -STATIC s_hmtxQueue, s_hmtxServiceThreads, s_hmtxRunningThreads, s_hmtxLog, s_hmtxConsole, s_hmtxBusy -STATIC s_hmtxHRB -STATIC s_hfileLogAccess, s_hfileLogError, s_cDocumentRoot, s_lIndexes, s_lConsole, s_nPort -STATIC s_nThreads, s_nStartThreads, s_nMaxThreads -STATIC s_nServiceThreads, s_nStartServiceThreads, s_nMaxServiceThreads -STATIC s_nConnections, s_nMaxConnections, s_nTotConnections -STATIC s_nServiceConnections, s_nMaxServiceConnections, s_nTotServiceConnections -STATIC s_aRunningThreads := {} -STATIC s_aServiceThreads := {} - -#ifdef USE_HB_INET -STATIC s_cLocalAddress, s_nLocalPort -#endif - -// ALIASES: now read from ini file -//STATIC s_hFileAliases := { "/info" => "/cgi-bin/info.hrb" } -STATIC s_hFileAliases := { => } - -THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_cErrorMsg - -MEMVAR _SERVER, _GET, _POST, _REQUEST, _HTTP_REQUEST, m_cPost - -FUNCTION MAIN( ... ) -LOCAL nPort, hListen, hSocket, aRemote, cI, xVal -LOCAL aThreads, nStartThreads, nMaxThreads, nStartServiceThreads -LOCAL i, cPar, lStop -LOCAL cGT, cDocumentRoot, lIndexes, cConfig -LOCAL lConsole -LOCAL nProgress := 0 -LOCAL hDefault, cLogAccess, cLogError -LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads - - IF !HB_MTVM() - ? "I need multhread support. Please, recompile me!" - WAIT - RETURN 2 - ENDIF - - // ----------------------- Initializations --------------------------------- - - SysSettings() - - // ----------------------- Parameters defaults ----------------------------- - - // defaults not changeble via ini file - lStop := FALSE - cConfig := EXE_Path() + "\" + APP_NAME + ".ini" - lConsole := TRUE - nStartServiceThreads := START_SERVICE_THREADS - - // Check GT version - if I have started app with //GT:NUL then I have to disable - // console - cGT := HB_GT_VERSION() - IF ( cGT == "NUL" ) - lConsole := FALSE - ENDIF - - // TOCHECK: now not force case insensitive - //HB_HSETCASEMATCH( s_hFileAliases, FALSE ) - - // ----------------- Line command parameters checking ---------------------- - - i := 1 - while ( i <= PCount() ) - - cPar := hb_PValue( i++ ) - - do case - case cPar == "--port" .OR. cPar == "-p" - cCmdPort := hb_PValue( i++ ) - - case cPar == "--docroot" .OR. cPar == "-d" - cCmdDocumentRoot := hb_PValue( i++ ) - - case cPar == "--indexes" .OR. cPar == "-i" - lCmdIndexes := TRUE - - case cPar == "--stop" .OR. cPar == "-s" - lStop := TRUE - - case cPar == "--config" .OR. cPar == "-c" - cConfig := hb_PValue( i++ ) - - case cPar == "--start-threads" .OR. cPar == "-ts" - nCmdStartThreads := Val( hb_PValue( i++ ) ) - - case cPar == "--max-threads" .OR. cPar == "-tm" - nCmdMaxThreads := Val( hb_PValue( i++ ) ) - - case cPar == "--help" .OR. Lower( cPar ) == "-h" .OR. cPar == "-?" - help() - RETURN 0 - - otherwise - help() - RETURN 0 - endcase - enddo - - // -------------------- checking STOP request ------------------------------- - - IF lStop - HB_MEMOWRIT( FILE_STOP, "" ) - RETURN 0 - ELSE - FERASE( FILE_STOP ) - ENDIF - - // ----------------- Parse ini file ---------------------------------------- - - hDefault := ParseIni( cConfig ) - - // ------------------- Parameters changeable from ini file ---------------- - - nPort := hDefault[ "MAIN" ][ "Port" ] - cDocumentRoot := hDefault[ "MAIN" ][ "Document_root" ] - lIndexes := hDefault[ "MAIN" ][ "Show_indexes" ] - - cLogAccess := hDefault[ "LOGFILES" ][ "access" ] - cLogError := hDefault[ "LOGFILES" ][ "error" ] - - nStartThreads := hDefault[ "THREADS" ][ "start_num" ] - nMaxThreads := hDefault[ "THREADS" ][ "max_num" ] - - FOR EACH xVal IN hDefault[ "ALIASES" ] - IF HB_ISSTRING( xVal ) - hb_HSet( s_hFileAliases, xVal:__enumKey(), xVal ) - ENDIF - NEXT - - //hb_ToOutDebug( "hDefault = %s\n\r", hb_ValToExp( hDefault ) ) - //hb_ToOutDebug( "s_hFileAliases = %s\n\r", hb_ValToExp( s_hFileAliases ) ) - - // ------------------- Parameters forced from command line ---------------- - - IF cCmdPort != NIL - nPort := Val( cCmdPort ) - ENDIF - - IF cCmdDocumentRoot != NIL - cDocumentRoot := cCmdDocumentRoot - ENDIF - - IF lCmdIndexes != NIL - lIndexes := lCmdIndexes - ENDIF - - IF nCmdStartThreads != NIL - nStartThreads := nCmdStartThreads - ENDIF - - IF nCmdMaxThreads != NIL - nMaxThreads := nCmdMaxThreads - ENDIF - - // -------------------- checking starting values ---------------------------- - - IF nPort <= 0 .OR. nPort > 65535 - ? "Invalid port number:", nPort - WAIT - RETURN 1 - ENDIF - - - IF HB_ISSTRING( cDocumentRoot ) - //cI := STRTRAN( SUBSTR( cDocumentRoot, 2 ), "\", "/" ) - cI := cDocumentRoot - IF HB_DirExists( cI ) - IF RIGHT( cI, 1 ) == "/" .AND. LEN(cI) > 2 .AND. SUBSTR( cI, LEN( cI ) - 2, 1 ) != ":" - s_cDocumentRoot := LEFT( cI, LEN( cI ) - 1 ) - ELSE - s_cDocumentRoot := cI - ENDIF - ELSE - ? "Invalid document root:", cI - WAIT - RETURN 3 - ENDIF - ELSE - ? "Invalid document root" - WAIT - RETURN 3 - ENDIF - - IF nMaxThreads <= 0 - nMaxThreads := MAX_RUNNING_THREADS - ENDIF - - IF nStartThreads < 0 - nStartThreads := 0 - ELSEIF nStartThreads > nMaxThreads - nStartThreads := nMaxThreads - ENDIF - - // -------------------- assign STATIC values -------------------------------- - - s_lIndexes := lIndexes - s_lConsole := lConsole - s_nPort := nPort - s_nThreads := 0 - s_nStartThreads := nStartThreads - s_nMaxThreads := nMaxThreads - s_nServiceThreads := 0 - s_nStartServiceThreads := nStartServiceThreads - s_nMaxServiceThreads := MAX_SERVICE_THREADS - s_nConnections := 0 - s_nMaxConnections := 0 - s_nTotConnections := 0 - s_nServiceConnections := 0 - s_nMaxServiceConnections := 0 - s_nTotServiceConnections := 0 - - // --------------------- Open log files ------------------------------------- - - IF ( s_hfileLogAccess := FOPEN( cLogAccess, FO_CREAT + FO_WRITE ) ) == -1 - ? "Can't open access log file" - WAIT - RETURN 1 - ENDIF - FSEEK( s_hfileLogAccess, 0, FS_END ) - - IF ( s_hfileLogError := FOPEN( cLogError, FO_CREAT + FO_WRITE ) ) == -1 - ? "Can't open error log file" - WAIT - RETURN 1 - ENDIF - FSEEK( s_hfileLogError, 0, FS_END ) - - // --------------------- MAIN PART ------------------------------------------ - - SET CURSOR OFF - - // --------------------- define mutexes ------------------------------------- - - s_hmtxQueue := hb_mutexCreate() - s_hmtxLog := hb_mutexCreate() - s_hmtxConsole := hb_mutexCreate() - s_hmtxBusy := hb_mutexCreate() - s_hmtxRunningThreads := hb_mutexCreate() - s_hmtxServiceThreads := hb_mutexCreate() - s_hmtxHRB := hb_mutexCreate() - - WriteToConsole( "--- Starting " + APP_NAME + " ---" ) - - // -------------------------------------------------------------------------- - // SOCKET CREATION - // -------------------------------------------------------------------------- - -#ifdef USE_HB_INET - hListen := hb_InetServer( nPort ) - - IF hb_InetErrorCode( hListen ) != 0 - ? "Bind Error" - ELSE - - s_nLocalPort := hb_InetPort( hListen ) - s_cLocalAddress := hb_InetAddress( hListen ) - -#else - hListen := socket_create() - IF socket_bind( hListen, { AF_INET, "0.0.0.0", nPort } ) == -1 - ? "bind() error", socket_error() - ELSEIF socket_listen( hListen ) == -1 - ? "listen() error", socket_error() - ELSE -#endif - // --------------------------------------------------------------------------------- // - // Starting Accept connection thread - // --------------------------------------------------------------------------------- // - - WriteToConsole( "Starting AcceptConnection Thread" ) - aThreads := {} - AADD( aThreads, hb_threadStart( @AcceptConnections() ) ) - - // --------------------------------------------------------------------------------- // - // main loop - // --------------------------------------------------------------------------------- // - - WriteToConsole( "Starting main loop" ) - - IF s_lConsole - hb_DispOutAt( 1, 5, APP_NAME + " - web server - v. " + APP_VERSION ) - hb_DispOutAt( 4, 5, "Server listening (Port: " + LTrim( Str( nPort ) ) + ") : ..." ) - hb_DispOutAt( 10, 9, "Waiting." ) - ENDIF - - DO WHILE .T. - - // windows resource releasing - 1 millisecond wait - WIN_SYSREFRESH( 1 ) - - IF s_lConsole - - // Show application infos - IF hb_mutexLock( s_hmtxBusy ) - hb_DispOutAt( 5, 5, "Threads : " + Transform( s_nThreads, "9999999999" ) ) - hb_DispOutAt( 6, 5, "Connections : " + Transform( s_nConnections, "9999999999" ) ) - hb_DispOutAt( 7, 5, "Max Connections : " + Transform( s_nMaxConnections, "9999999999" ) ) - hb_DispOutAt( 8, 5, "Total Connections : " + Transform( s_nTotConnections, "9999999999" ) ) - - hb_DispOutAt( 5, 37, "ServiceThreads : " + Transform( s_nServiceThreads, "9999999999" ) ) - hb_DispOutAt( 6, 37, "Connections : " + Transform( s_nServiceConnections, "9999999999" ) ) - hb_DispOutAt( 7, 37, "Max Connections : " + Transform( s_nMaxServiceConnections, "9999999999" ) ) - hb_DispOutAt( 8, 37, "Total Connections : " + Transform( s_nTotServiceConnections, "9999999999" ) ) - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // Show progress - Progress( @nProgress ) - ENDIF - - // Wait a connection -#ifdef USE_HB_INET - hb_InetTimeOut( hListen, 50 ) - IF HB_InetDataReady( hListen ) > 0 -#else - IF socket_select( { hListen },,, 50 ) > 0 -#endif - // reset remote values - aRemote := NIL - - // Accept a remote connection -#ifdef USE_HB_INET - hSocket := HB_INETACCEPT( hListen ) -#else - hSocket := socket_accept( hListen, @aRemote ) -#endif - IF hSocket == NIL - -#ifdef USE_HB_INET - WriteToConsole( hb_sprintf( "accept() error" ) ) -#else - WriteToConsole( hb_sprintf( "accept() error: %s", socket_error() ) ) -#endif - - ELSE - - // Send accepted connection to AcceptConnections() thread - hb_mutexNotify( s_hmtxQueue, hSocket ) - - ENDIF - - ELSE - - // Checking if I have to quit - IF HB_FileExists( FILE_STOP ) - FERASE( FILE_STOP ) - EXIT - ENDIF - - ENDIF - - ENDDO - - WriteToConsole( "Waiting threads" ) - // Send to thread that they have to stop - AEVAL( aThreads, {|| hb_mutexNotify( s_hmtxQueue, NIL ) } ) - // Wait threads to end - AEVAL( aThreads, {|h| hb_threadJoin( h ) } ) - - ENDIF - - WriteToConsole( "--- Quitting " + APP_NAME + " ---" ) - - // Close socket -#ifdef USE_HB_INET - hb_InetClose( hListen ) -#else - socket_close( hListen ) -#endif - - // Close log files - FCLOSE( s_hfileLogAccess ) - FCLOSE( s_hfileLogError ) - - SET CURSOR ON - -RETURN 0 - -// --------------------------------------------------------------------------------- // -// THREAD FUNCTIONS -// --------------------------------------------------------------------------------- // - -STATIC FUNCTION AcceptConnections() - LOCAL hSocket - LOCAL nConnections, nThreads, nMaxThreads, n - LOCAL nServiceConnections, nServiceThreads, nMaxServiceThreads, nThreadID - LOCAL pThread - - WriteToConsole( "Starting AcceptConnections()" ) - - // Starting initial running threads - FOR n := 1 TO s_nStartThreads - pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) - AADD( s_aRunningThreads, { pThread, nThreadID } ) - NEXT - - // Starting initial service threads - FOR n := 1 TO s_nStartServiceThreads - pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) - AADD( s_aServiceThreads, { pThread, nThreadID } ) - NEXT - - // Main AcceptConnections loop - DO WHILE .T. - - // reset socket - hSocket := NIL - - // releasing resources - WIN_SYSREFRESH( 1 ) - - // Waiting a connection from main application loop - hb_mutexSubscribe( s_hmtxQueue,, @hSocket ) - - // I have a QUIT request - IF hSocket == NIL - - // Requesting to Running threads to quit (using -1 value) - AEVAL( s_aRunningThreads, {|| hb_mutexNotify( s_hmtxRunningThreads, -1 ) } ) - // waiting running threads to quit - AEVAL( s_aRunningThreads, {|h| hb_threadJoin( h[1] ) } ) - - // Requesting to Service threads to quit (using -1 value) - AEVAL( s_aServiceThreads, {|| hb_mutexNotify( s_hmtxServiceThreads, -1 ) } ) - // waiting service threads to quit - AEVAL( s_aServiceThreads, {|h| hb_threadJoin( h[1] ) } ) - - EXIT - ENDIF - - // Load current state - IF hb_mutexLock( s_hmtxBusy ) - nConnections := s_nConnections - nThreads := s_nThreads - nMaxThreads := s_nMaxThreads - nServiceConnections:= s_nServiceConnections - nServiceThreads := s_nServiceThreads - nMaxServiceThreads := s_nMaxServiceThreads - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // If I have no more thread to use ... - IF nConnections > nMaxThreads - - // If I have no more of service threads to use ... (DOS attack ?) - IF nServiceConnections > nMaxServiceThreads - // DROP connection -#ifdef USE_HB_INET - hb_InetClose( hSocket ) -#else - socket_shutdown( hSocket ) - socket_close( hSocket ) -#endif - - // If I have no service threads in use ... - ELSEIF nServiceConnections >= nServiceThreads - // Add one more - pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) - AADD( s_aServiceThreads, { pThread, nThreadID } ) - ENDIF - // Otherwise I send connection to service thread - hb_mutexNotify( s_hmtxServiceThreads, hSocket ) - - LOOP - - // If I have no running threads in use ... - ELSEIF nConnections >= nThreads - // Add one more - pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) - AADD( s_aRunningThreads, { pThread, nThreadID } ) - ENDIF - // Otherwise I send connection to running thread - hb_mutexNotify( s_hmtxRunningThreads, hSocket ) - - ENDDO - - WriteToConsole( "Quitting AcceptConnections()" ) - -RETURN 0 - -// --------------------------------------------------------------------------------- // -// CONNECTIONS -// --------------------------------------------------------------------------------- // -STATIC FUNCTION ProcessConnection( nThreadIdRef ) -LOCAL hSocket, cBuf, nLen, cRequest, cSend -LOCAL nMsecs, nParseTime, nPos -LOCAL nThreadId -#ifdef USE_HB_INET -LOCAL nRcvLen, nContLen -#else -LOCAL aI -#endif - - nThreadId := hb_threadID() - nThreadIdRef := nThreadId - - WriteToConsole( "Starting ProcessConnections() " + hb_CStr( nThreadId ) ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nThreads++ - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // ProcessConnection Loop - DO WHILE .T. - - // Reset socket - hSocket := NIL - - // releasing resources - WIN_SYSREFRESH( 1 ) - - // Waiting a connection from AcceptConnections() but up to defined time - hb_mutexSubscribe( s_hmtxRunningThreads, THREAD_MAX_WAIT, @hSocket ) - - // received a -1 value, I have to quit - IF HB_ISNUMERIC( hSocket ) - EXIT - // no socket received, thread can graceful quit only if over minimal number - ELSEIF hSocket == NIL - IF hb_mutexLock( s_hmtxBusy ) - IF s_nThreads <= s_nStartThreads - hb_mutexUnlock( s_hmtxBusy ) - LOOP - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - EXIT - ENDIF - - // Connection accepted - IF hb_mutexLock( s_hmtxBusy ) - s_nConnections++ - s_nTotConnections++ - s_nMaxConnections := Max( s_nConnections, s_nMaxConnections ) - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // Save initial time - nMsecs := hb_milliseconds() - - BEGIN SEQUENCE - - /* receive query */ -#ifdef USE_HB_INET - cRequest := "" - nLen := 0 - nRcvLen := 1 - nContLen := 0 - DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 - cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) - //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) - cRequest += cBuf + CR_LF - nLen += nRcvLen - IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 - cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) - nContLen := Val( cBuf ) - ENDIF - ENDDO - - //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) - // if the request has a content-lenght, we must read it - IF nLen > 0 .AND. nContLen > 0 - // cPostData is autoAllocated - cBuf := Space( nContLen ) - IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 - nLen := -1 // force error check - ELSE - cRequest += cBuf - ENDIF - ENDIF -#else - cRequest := "" - nLen := 1 - DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 - nLen := socket_recv( hSocket, @cBuf ) - cRequest += cBuf - ENDDO -#endif - - IF nLen == -1 -#ifdef USE_HB_INET - ? "recv() error:", HB_INETERRORCODE( hSocket ), HB_INETERRORDESC( hSocket ) -#else - ? "recv() error:", socket_error() -#endif - - ELSEIF nLen == 0 /* connection closed */ - ELSE - - //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) - - PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost - t_cResult := "" - t_aHeader := {} - t_nStatusCode := 200 - t_cErrorMsg := "" - -#ifdef USE_HB_INET - _SERVER["REMOTE_ADDR"] := hb_InetAddress( hSocket ) - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := hb_InetPort( hSocket ) - - _SERVER["SERVER_ADDR"] := s_cLocalAddress - _SERVER["SERVER_PORT"] := s_nLocalPort -#else - IF socket_getpeername( hSocket, @aI ) != -1 - _SERVER["REMOTE_ADDR"] := aI[2] - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := aI[3] - ENDIF - - IF socket_getsockname( hSocket, @aI ) != -1 - _SERVER["SERVER_ADDR"] := aI[2] - _SERVER["SERVER_PORT"] := aI[3] - ENDIF -#endif - IF ParseRequest( cRequest ) - //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) - define_Env( _SERVER ) - uproc_default() - ELSE - uSetStatusCode( 400 ) - ENDIF - cSend := MakeResponse() - - //hb_ToOutDebug( "cSend = %s\n\r", cSend ) - -#ifdef USE_HB_INET - DO WHILE LEN( cSend ) > 0 - IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 - ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) - WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO -#else - DO WHILE LEN( cSend ) > 0 - IF ( nLen := socket_send( hSocket, cSend ) ) == -1 - ? "send() error:", socket_error() - WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO -#endif - WriteToLog( cRequest ) - - ENDIF - -#ifdef USE_HB_INET - hb_InetClose( hSocket ) -#else - socket_shutdown( hSocket ) - socket_close( hSocket ) -#endif - END SEQUENCE - - nParseTime := hb_milliseconds() - nMsecs - WriteToConsole( "Page served in : " + Str( nParseTime/1000, 10, 7 ) + " seconds" ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nConnections-- - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - ENDDO - - WriteToConsole( "Quitting ProcessConnections() " + hb_CStr( nThreadId ) ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nThreads-- - IF ( nPos := aScan( s_aRunningThreads, {|h| h[2] == nThreadId } ) > 0 ) - hb_aDel( s_aRunningThreads, nPos, TRUE ) - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - -RETURN 0 - -STATIC FUNCTION ServiceConnection( nThreadIdRef ) -LOCAL hSocket, cBuf, nLen, cRequest, cSend -LOCAL nMsecs, nParseTime, nPos -LOCAL nThreadId -LOCAL nError := 500013 -#ifdef USE_HB_INET -LOCAL nRcvLen, nContLen -#else -LOCAL aI -#endif - - nThreadId := hb_threadID() - nThreadIdRef := nThreadId - - WriteToConsole( "Starting ServiceConnections() " + hb_CStr( nThreadId ) ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceThreads++ - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - DO WHILE .T. - - // Reset socket - hSocket := NIL - - // releasing resources - WIN_SYSREFRESH( 1 ) - - // Waiting a connection from AcceptConnections() but up to defined time - hb_mutexSubscribe( s_hmtxServiceThreads, THREAD_MAX_WAIT, @hSocket ) - - // received a -1 value, I have to quit - IF HB_ISNUMERIC( hSocket ) - EXIT - // no socket received, thread can graceful quit only if over minimal number - ELSEIF hSocket == NIL - IF hb_mutexLock( s_hmtxBusy ) - IF s_nServiceThreads <= s_nStartServiceThreads - hb_mutexUnlock( s_hmtxBusy ) - LOOP - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - EXIT - ENDIF - - // Connection accepted - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceConnections++ - s_nTotServiceConnections++ - s_nMaxServiceConnections := Max( s_nServiceConnections, s_nMaxServiceConnections ) - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // Save initial time - nMsecs := hb_milliseconds() - - BEGIN SEQUENCE - - /* receive query */ -#ifdef USE_HB_INET - cRequest := "" - nLen := 0 - nRcvLen := 1 - nContLen := 0 - DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 - cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) - //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) - cRequest += cBuf + CR_LF - nLen += nRcvLen - IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 - cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) - nContLen := Val( cBuf ) - ENDIF - ENDDO - - //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) - // if the request has a content-lenght, we must read it - IF nLen > 0 .AND. nContLen > 0 - // cPostData is autoAllocated - cBuf := Space( nContLen ) - IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 - nLen := -1 // force error check - ELSE - cRequest += cBuf - ENDIF - ENDIF -#else - cRequest := "" - nLen := 1 - DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 - nLen := socket_recv( hSocket, @cBuf ) - cRequest += cBuf - ENDDO -#endif - - IF nLen == -1 -#ifdef USE_HB_INET - ? "recv() error:", hb_InetErrorCode( hSocket ), hb_InetErrorDesc( hSocket ) -#else - ? "recv() error:", socket_error() -#endif - ELSEIF nLen == 0 /* connection closed */ - ELSE - - //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) - - PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost - t_cResult := "" - t_aHeader := {} - t_nStatusCode := 200 - t_cErrorMsg := "" - -#ifdef USE_HB_INET - _SERVER["REMOTE_ADDR"] := hb_InetAddress( hSocket ) - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := hb_InetPort( hSocket ) - - _SERVER["SERVER_ADDR"] := s_cLocalAddress - _SERVER["SERVER_PORT"] := s_nLocalPort -#else - IF socket_getpeername( hSocket, @aI ) != -1 - _SERVER["REMOTE_ADDR"] := aI[2] - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := aI[3] - ENDIF - - IF socket_getsockname( hSocket, @aI ) != -1 - _SERVER["SERVER_ADDR"] := aI[2] - _SERVER["SERVER_PORT"] := aI[3] - ENDIF -#endif - - IF ParseRequest( cRequest ) - //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) - define_Env( _SERVER ) - ENDIF - // Error page served - uSetStatusCode( nError ) - cSend := MakeResponse() - -#ifdef USE_HB_INET - DO WHILE LEN( cSend ) > 0 - IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 - ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) - WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO -#else - DO WHILE LEN( cSend ) > 0 - IF ( nLen := socket_send( hSocket, cSend ) ) == -1 - ? "send() error:", socket_error() - WriteToConsole( hb_sprintf( "ServiceConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO -#endif - - WriteToLog( cRequest ) - - ENDIF -#ifdef USE_HB_INET - hb_InetClose( hSocket ) -#else - socket_shutdown( hSocket ) - socket_close( hSocket ) -#endif - END SEQUENCE - - nParseTime := hb_milliseconds() - nMsecs - WriteToConsole( "Page served in : " + Str( nParseTime/1000, 10, 7 ) + " seconds" ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceConnections-- - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - ENDDO - - WriteToConsole( "Quitting ServiceConnections() " + hb_CStr( nThreadId ) ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceThreads-- - IF ( nPos := aScan( s_aServiceThreads, {|h| h[2] == nThreadId } ) > 0 ) - hb_aDel( s_aServiceThreads, nPos, TRUE ) - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - -RETURN 0 - -STATIC FUNCTION ParseRequest( cRequest ) -LOCAL aRequest, aLine, nI, nJ, cI -LOCAL cReq, aVal, cPost - - // RFC2616 - aRequest := split( CR_LF, cRequest ) - - //hb_ToOutDebug( "aRequest = %s\n\r", hb_ValToExp( aRequest ) ) - - WriteToConsole( aRequest[1] ) - aLine := split( " ", aRequest[1] ) - IF LEN( aLine ) != 3 .OR. ; - ( aLine[1] != "GET" .AND. aLine[1] != "POST" ) .OR. ; // Sorry, we support GET and POST only - LEFT( aLine[3], 5 ) != "HTTP/" - RETURN .F. - ENDIF - - // define _SERVER var - _SERVER["REQUEST_METHOD"] := aLine[1] - _SERVER["REQUEST_URI"] := aLine[2] - _SERVER["SERVER_PROTOCOL"] := aLine[3] - - IF ( nI := AT( "?", _SERVER["REQUEST_URI"] ) ) > 0 - _SERVER["SCRIPT_NAME"] := LEFT( _SERVER["REQUEST_URI"], nI - 1) - _SERVER["QUERY_STRING"] := SUBSTR( _SERVER["REQUEST_URI"], nI + 1) - ELSE - _SERVER["SCRIPT_NAME"] := _SERVER["REQUEST_URI"] - _SERVER["QUERY_STRING"] := "" - ENDIF - - _SERVER["HTTP_ACCEPT"] := "" - _SERVER["HTTP_ACCEPT_CHARSET"] := "" - _SERVER["HTTP_ACCEPT_ENCODING"] := "" - _SERVER["HTTP_ACCEPT_LANGUAGE"] := "" - _SERVER["HTTP_CONNECTION"] := "" - _SERVER["HTTP_HOST"] := "" - _SERVER["HTTP_KEEP_ALIVE"] := "" - _SERVER["HTTP_REFERER"] := "" - _SERVER["HTTP_USER_AGENT"] := "" - _SERVER["HTTP_CACHE_CONTROL"] := "" - - FOR nI := 2 TO LEN( aRequest ) - IF aRequest[nI] == ""; EXIT - ELSEIF ( nJ := AT( ":", aRequest[nI] ) ) > 0 - cI := LTRIM( SUBSTR( aRequest[nI], nJ + 1)) - SWITCH UPPER( LEFT( aRequest[nI], nJ - 1)) - CASE "ACCEPT" - CASE "ACCEPT-CHARSET" - CASE "ACCEPT-ENCODING" - CASE "ACCEPT-LANGUAGE" - CASE "CACHE-CONTROL" - CASE "CONNECTION" - CASE "KEEP-ALIVE" - CASE "REFERER" - CASE "USER-AGENT" - _SERVER[ "HTTP_" + STRTRAN( UPPER( LEFT( aRequest[nI], nJ - 1 ) ), "-", "_" ) ] := cI - EXIT - CASE "HOST" - aVal := split( ":", aRequest[ nI ] ) - _SERVER[ "HTTP_" + STRTRAN( UPPER( aVal[ 1 ] ), "-", "_")] := AllTrim( aVal[ 2 ] ) - EXIT - CASE "CONTENT-TYPE" - CASE "CONTENT-LENGTH" - _SERVER[ STRTRAN( UPPER( LEFT( aRequest[ nI ], nJ - 1 ) ), "-", "_" ) ] := cI - EXIT - ENDSWITCH - ENDIF - NEXT - - // GET vars - FOR EACH cI IN split( "&", _SERVER["QUERY_STRING"] ) - IF ( nI := AT( "=", cI ) ) > 0 - _GET[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - _REQUEST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - ELSE - _GET[ cI ] := "" - _REQUEST[ cI ] := "" - ENDIF - NEXT - - // Load _HTTP_REQUEST - FOR EACH cReq IN aRequest - IF cReq:__enumIndex() == 1 // GET request - hb_HSet( _HTTP_REQUEST, "HTTP Request", cReq ) - ELSEIF Empty( cReq ) - EXIT - ELSE - aVal := split( ":", cReq, 1 ) - hb_HSet( _HTTP_REQUEST, aVal[ 1 ], IIF( Len( aVal ) == 2, AllTrim( aVal[ 2 ] ), NIL ) ) - ENDIF - NEXT - - // POST vars - IF "POST" $ Upper( _SERVER[ 'REQUEST_METHOD' ] ) - //hb_ToOutDebug( "POST: %s\n\r", aTail( aRequest ) ) - cPost := aTail( aRequest ) - FOR EACH cI IN split( "&", cPost ) - IF ( nI := AT( "=", cI ) ) > 0 - _POST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - _REQUEST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - ELSE - _POST[ cI ] := "" - _REQUEST[ cI ] := "" - ENDIF - NEXT - m_cPost := cPost - ENDIF - - // Complete _SERVER - _SERVER[ "SERVER_NAME" ] = split( ":", _HTTP_REQUEST[ "HOST" ], 1 )[ 1 ] - _SERVER[ "SERVER_SOFTWARE" ] = APP_NAME + " " + APP_VERSION + " (" + OS() + ")" - _SERVER[ "SERVER_SIGNATURE" ] = "
" + _SERVER[ "SERVER_SOFTWARE" ] + " Server at " + _SERVER[ "SERVER_NAME" ] + " Port " + LTrim( Str( _SERVER[ "SERVER_PORT" ] ) ) + "
" - _SERVER[ "DOCUMENT_ROOT" ] = s_cDocumentRoot - _SERVER[ "SERVER_ADMIN" ] = "root" - _SERVER[ "SCRIPT_FILENAME" ] = STRTRAN( STRTRAN( _SERVER[ "DOCUMENT_ROOT" ] + _SERVER[ "SCRIPT_NAME" ], "//", "/" ), "\", "/" ) - _SERVER[ "GATEWAY_INTERFACE" ] = "CGI/1.1" - _SERVER[ "SCRIPT_URL" ] := _SERVER["SCRIPT_NAME"] - - //hb_ToOutDebug( "_SERVER = %s\n\r", hb_ValToExp( _SERVER ) ) - //hb_ToOutDebug( "_GET = %s\n\r", hb_ValToExp( _GET ) ) - //hb_ToOutDebug( "_POST = %s\n\r", hb_ValToExp( _POST ) ) - //hb_ToOutDebug( "_HTTP_REQUEST = %s\n\r", hb_ValToExp( _HTTP_REQUEST ) ) - -RETURN .T. - - -STATIC FUNCTION MakeResponse() -LOCAL cRet, cReturnCode - - uAddHeader("Connection", "close") - - IF uGetHeader("Location") != NIL - t_nStatusCode := 301 - ENDIF - IF uGetHeader("Content-Type") == NIL - uAddHeader("Content-Type", "text/html") - ENDIF - - cRet := "HTTP/1.1 " - cReturnCode := DecodeStatusCode() - - SWITCH t_nStatusCode - CASE 200 - EXIT - - CASE 301 - CASE 400 - CASE 401 - CASE 402 - CASE 403 - CASE 404 - CASE 503 - t_cResult := "

" + cReturnCode + "

" - EXIT - - // extended error messages - from Microsoft IIS Server - CASE 500013 // error: 500-13 Server too busy - uAddHeader( "Retry-After", "60" ) // retry after 60 seconds - t_cResult := "

500 Server Too Busy

" - EXIT - - CASE 500100 // error: 500-100 Undeclared Variable - - OTHERWISE - cReturnCode := "403 Forbidden" - t_cResult := "

" + cReturnCode + "

" - ENDSWITCH - - WriteToConsole( cReturnCode ) - cRet += cReturnCode + CR_LF - AEVAL( t_aHeader, {|x| cRet += x[1] + ": " + x[2] + CR_LF } ) - cRet += CR_LF - cRet += t_cResult -RETURN cRet - -STATIC FUNCTION DecodeStatusCode() -LOCAL cReturnCode - - SWITCH t_nStatusCode - CASE 200 - cReturnCode := "200 OK" - EXIT - CASE 301 - cReturnCode := "301 Moved Permanently" - EXIT - CASE 400 - cReturnCode := "400 Bad Request" - EXIT - CASE 401 - cReturnCode := "401 Unauthorized" - EXIT - CASE 402 - cReturnCode := "402 Payment Required" - EXIT - CASE 403 - cReturnCode := "403 Forbidden" - EXIT - CASE 404 - cReturnCode := "404 Not Found" - EXIT - CASE 503 - cReturnCode := "503 Service Unavailable" - EXIT - - // extended error messages - from Microsoft IIS Server - CASE 500013 // error: 500-13 Server too busy - cReturnCode := "500-13 Server Too Busy" - EXIT - - CASE 500100 // error: 500-100 Undeclared Variable - - OTHERWISE - cReturnCode := "403 Forbidden" - ENDSWITCH - -RETURN cReturnCode - -STATIC PROCEDURE WriteToLog( cRequest ) - LOCAL cTime, cDate - LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" } - LOCAL aMonths := {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"} - LOCAL cAccess, cError, nDoW, dDate, nDay, nMonth, nYear, nSize, cBias - LOCAL cErrorMsg - LOCAL cReferer - - IF hb_mutexLock( s_hmtxLog ) - - //hb_ToOutDebug( "TIP_TimeStamp() = %s \n\r", TIP_TIMESTAMP() ) - - cTime := TIME() - dDate := Date() - cDate := DTOS( dDate ) - nSize := LEN( t_cResult ) - cReferer := _SERVER["HTTP_REFERER"] - cBias := WIN_TIMEZONEBIAS() - - cAccess := _SERVER["REMOTE_ADDR"] + " - - [" + RIGHT( cDate, 2 ) + "/" + ; - aMonths[ VAL( SUBSTR( cDate, 5, 2 ) ) ] + ; - "/" + LEFT( cDate, 4 ) + ":" + cTime + ' ' + cBias + '] "' + ; - LEFT( cRequest, AT( CR_LF, cRequest ) - 1 ) + '" ' + ; - LTRIM( STR( t_nStatusCode ) ) + " " + IIF( nSize == 0, "-", LTRIM( STR( nSize ) ) ) + ; - ' "' + IIF( Empty( cReferer ), "-", cReferer ) + '" "' + _SERVER["HTTP_USER_AGENT"] + ; - '"' + HB_OSNewLine() - - //hb_ToOutDebug( "AccessLog = %s \n\r", cAccess ) - - FWRITE( s_hfileLogAccess, cAccess ) - - IF !( t_nStatusCode == 200 ) // ok - - nDoW := Dow( dDate ) - nDay := Day( dDate ) - nMonth := Month( dDate ) - nYear := Year( dDate ) - cErrorMsg := t_cErrorMsg - - cError := "[" + Left( aDays[ nDoW ], 3 ) + " " + aMonths[ nMonth ] + " " + StrZero( nDay, 2 ) + " " + ; - PadL( LTrim( cTime ), 8, "0" ) + " " + StrZero( nYear, 4 ) + "] [error] [client " + _SERVER["REMOTE_ADDR"] + "] " + ; - cErrorMsg + HB_OSNewLine() - - //hb_ToOutDebug( "ErrorLog = %s \n\r", cError ) - - FWRITE( s_hfileLogError, cError ) - ENDIF - - hb_mutexUnlock( s_hmtxLog ) - ENDIF - -RETURN - -INIT PROCEDURE SocketInit() -#ifdef USE_HB_INET - hb_InetInit() -#else - IF socket_init() != 0 - ? "socket_init() error" - ENDIF -#endif -RETURN - - -EXIT PROCEDURE Socketxit() -#ifdef USE_HB_INET - hb_InetCleanup() -#else - socket_exit() -#endif -RETURN - - -/******************************************************************** - Public helper functions -********************************************************************/ -STATIC FUNCTION split( cSeparator, cString, nMax ) - LOCAL aRet := {}, nI - LOCAL nIter := 0 - - DEFAULT nMax TO 0 - - DO WHILE ( nI := AT( cSeparator, cString ) ) > 0 - AADD( aRet, LEFT( cString, nI - 1 ) ) - cString := SUBSTR( cString, nI + LEN( cSeparator ) ) - IF nMax > 0 .AND. ++nIter >= nMax - EXIT - ENDIF - ENDDO - AADD( aRet, cString ) -RETURN aRet - -STATIC FUNCTION join( cSeparator, aData ) -LOCAL cRet := "", nI - - FOR nI := 1 TO LEN( aData ) - IF nI > 1; cRet += cSeparator - ENDIF - IF VALTYPE(aData[nI]) $ "CM"; cRet += aData[nI] - ELSEIF VALTYPE(aData[nI]) == "N"; cRet += LTRIM(STR(aData[nI])) - ELSEIF VALTYPE(aData[nI]) == "D"; cRet += IF(!EMPTY(aData[nI]), DTOC(aData[nI]), "") - ELSE - ENDIF - NEXT -RETURN cRet - - -FUNCTION uOSFileName( cFileName ) - IF HB_OSPathSeparator() != "/" - RETURN STRTRAN( cFileName, "/", HB_OSPathSeparator() ) - ENDIF -RETURN cFileName - -PROCEDURE uSetStatusCode(nStatusCode) - t_nStatusCode := nStatusCode -RETURN - - -PROCEDURE uAddHeader( cType, cValue ) -LOCAL nI - - IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 - t_aHeader[ nI, 2 ] := cValue - ELSE - AADD( t_aHeader, { cType, cValue } ) - ENDIF -RETURN - - -FUNCTION uGetHeader( cType ) -LOCAL nI - - IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 - RETURN t_aHeader[ nI, 2 ] - ENDIF -RETURN NIL - - -PROCEDURE uWrite( cString ) - t_cResult += cString -RETURN - -#define XP_SUCCESS 0 - -STATIC PROCEDURE uproc_default() -LOCAL cFileName, nI, cI -LOCAL cExt, xResult, pHRB, oError - - //cFileName := STRTRAN(cRoot + _SERVER["SCRIPT_NAME"], "//", "/") - cFileName := _SERVER[ "SCRIPT_FILENAME" ] - - //hb_ToOutDebug( "cFileName = %s, uOSFileName( cFileName ) = %s,\n\r _SERVER = %s\n\r", cFileName, uOSFileName( cFileName ), hb_ValToExp( _SERVER ) ) - - // Security - IF ".." $ cFileName - uSetStatusCode( 403 ) - t_cErrorMsg := "Characters not allowed" - RETURN - ENDIF - - IF HB_HHasKey( s_hFileAliases, _SERVER[ "SCRIPT_NAME" ] ) - cFileName := _SERVER[ "DOCUMENT_ROOT" ] + hb_hGet( s_hFileAliases, _SERVER[ "SCRIPT_NAME" ] ) - ENDIF - - IF Upper( _SERVER[ "SCRIPT_NAME" ] ) == "/SERVERSTATUS" - ShowServerStatus() - ELSEIF HB_FileExists( uOSFileName( cFileName ) ) - IF ( nI := RAT( ".", cFileName ) ) > 0 - SWITCH ( cExt := LOWER( SUBSTR( cFileName, nI + 1 ) ) ) - CASE "hrb" ; cI := "text/html"; EXIT - CASE "css" ; cI := "text/css"; EXIT - CASE "htm" ; CASE "html"; cI := "text/html"; EXIT - CASE "txt" ; CASE "text"; CASE "asc" - CASE "c" ; CASE "h"; CASE "cpp" - CASE "hpp" ; CASE "log"; cI := "text/plain"; EXIT - CASE "rtf" ; cI := "text/rtf"; EXIT - CASE "xml" ; cI := "text/xml"; EXIT - CASE "xsl" ; cI := "text/xsl"; EXIT - CASE "bmp" ; cI := "image/bmp"; EXIT - CASE "gif" ; cI := "image/gif"; EXIT - CASE "jpg" ; CASE "jpe"; CASE "jpeg"; cI := "image/jpeg"; EXIT - CASE "png" ; cI := "image/png"; EXIT - CASE "tif" ; CASE "tiff"; cI := "image/tiff"; EXIT - CASE "djv" ; CASE "djvu"; cI := "image/vnd.djvu"; EXIT - CASE "ico" ; cI := "image/x-icon"; EXIT - CASE "xls" ; cI := "application/excel"; EXIT - CASE "doc" ; cI := "application/msword"; EXIT - CASE "pdf" ; cI := "application/pdf"; EXIT - CASE "ps" ; CASE "eps"; cI := "application/postscript"; EXIT - CASE "ppt" ; cI := "application/powerpoint"; EXIT - CASE "bz2" ; cI := "application/x-bzip2"; EXIT - CASE "gz" ; cI := "application/x-gzip"; EXIT - CASE "tgz" ; cI := "application/x-gtar"; EXIT - CASE "js" ; cI := "application/x-javascript"; EXIT - CASE "tar" ; cI := "application/x-tar"; EXIT - CASE "tex" ; cI := "application/x-tex"; EXIT - CASE "zip" ; cI := "application/zip"; EXIT - CASE "midi"; cI := "audio/midi"; EXIT - CASE "mp3" ; cI := "audio/mpeg"; EXIT - CASE "wav" ; cI := "audio/x-wav"; EXIT - CASE "qt" ; CASE "mov"; cI := "video/quicktime"; EXIT - CASE "avi" ; cI := "video/x-msvideo"; EXIT - OTHERWISE - cI := "application/octet-stream" - ENDSWITCH - - IF cExt == "hrb" - - // Starting HRB module - - TRY - IF hb_mutexLock( s_hmtxHRB ) - IF !EMPTY( pHRB := __HRBLOAD( uOSFileName(cFileName) ) ) - - xResult := HRBMAIN() - - __HRBUNLOAD( pHRB ) - - ENDIF - hb_mutexUnlock( s_hmtxHRB ) - ENDIF - - IF HB_ISSTRING( xResult ) - uAddHeader( "Content-Type", cI ) - uWrite( xResult ) - ELSE - // Application in HRB module is responsible to send HTML content - ENDIF - - CATCH oError - - WriteToConsole( "Error!" ) - - uAddHeader( "Content-Type", "text/html" ) - uWrite( "Error" ) - uWrite( "
Description: " + hb_cStr( oError:Description ) ) - uWrite( "
Filename: " + hb_cStr( oError:filename ) ) - uWrite( "
Operation: " + hb_cStr( oError:operation ) ) - uWrite( "
OsCode: " + hb_cStr( oError:osCode ) ) - uWrite( "
GenCode: " + hb_cStr( oError:genCode ) ) - uWrite( "
SubCode: " + hb_cStr( oError:subCode ) ) - uWrite( "
SubSystem: " + hb_cStr( oError:subSystem ) ) - uWrite( "
Args: " + hb_cStr( hb_ValToExp( oError:args ) ) ) - uWrite( "
ProcName: " + hb_cStr( procname( 0 ) ) ) - uWrite( "
ProcLine: " + hb_cStr( procline( 0 ) ) ) - END - - - ELSE - uAddHeader( "Content-Type", cI ) - uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) - ENDIF - - ELSE - cI := "application/octet-stream" - uAddHeader( "Content-Type", cI ) - uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) - ENDIF - - ELSEIF HB_DirExists( uOSFileName( cFileName ) ) - IF RIGHT( cFileName, 1 ) != "/" - uAddHeader( "Location", "http://" + _SERVER[ "HTTP_HOST" ] + _SERVER[ "SCRIPT_NAME" ] + "/" ) - RETURN - ENDIF - IF ASCAN( { "index.html", "index.htm" }, ; - {|x| IIF( HB_FileExists( uOSFileName( cFileName + X ) ), ( cFileName += X, .T. ), .F. ) } ) > 0 - uAddHeader( "Content-Type", "text/html" ) - uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) - RETURN - ENDIF - - // If I'm here it's means that I have no page, so, if it is defined, I will display content folder - IF !s_lIndexes - uSetStatusCode( 403 ) - t_cErrorMsg := "Display file list not allowed" - RETURN - ENDIF - - // ----------------------- display folder content ------------------------------------- - ShowFolder( cFileName ) - - ELSE - uSetStatusCode( 404 ) - t_cErrorMsg := "File does not exist: " + cFileName - ENDIF -RETURN - -// Define environment SET variables - TODO: Actually only for windows, make multiplatform -STATIC PROCEDURE Define_Env( hmServer ) - LOCAL v - - FOR EACH v IN hmServer - WIN_SETENV( v:__enumKey(), v:__enumValue() ) - NEXT - -RETURN - -// ------------------------------- DEFAULT PAGES ----------------------------------- - -STATIC PROCEDURE ShowServerStatus() - - uAddHeader( "Content-Type", "text/html" ) - uWrite( '' ) - uWrite( '' ) - uWrite( 'Server Status

Server Status

')
-   //uWrite( '')
-
-   uWrite( 'SERVER: ' + _SERVER[ "SERVER_SOFTWARE" ] + " Server at " + _SERVER[ "SERVER_NAME" ] + " Port " + LTrim( Str( _SERVER[ "SERVER_PORT" ] ) ) )
-   uWrite( '
' )
-   IF hb_mutexLock( s_hmtxBusy )
-      uWrite( '
Thread: ' + Str( s_nThreads ) )
-      uWrite( '
Connections: ' + Str( s_nConnections ) )
-      uWrite( '
Max Connections: ' + Str( s_nMaxConnections ) )
-      uWrite( '
Total Connections: ' + Str( s_nTotConnections ) )
-      uWrite( '
Running Thread: ' + hb_ValToExp( s_aRunningThreads ) )
-
-      uWrite( '
Service Thread: ' + Str( s_nServiceThreads ) )
-      uWrite( '
Service Connections: ' + Str( s_nServiceConnections ) )
-      uWrite( '
Max Service Connections: ' + Str( s_nMaxServiceConnections ) )
-      uWrite( '
Total Service Connections: ' + Str( s_nTotServiceConnections ) )
-      uWrite( '
Service Thread: ' + hb_ValToExp( s_aServiceThreads ) )
-      hb_mutexUnlock( s_hmtxBusy )
-   ENDIF
-   uWrite( '
Time: ' + Time() )
-
-   //uWrite( '
')
-   uWrite( "
" ) - -RETURN - -STATIC PROCEDURE ShowFolder( cDir ) - LOCAL aDir, aF - LOCAL cParentDir, nPos - - uAddHeader( "Content-Type", "text/html" ) - - aDir := DIRECTORY( uOSFileName( cDir ), "D" ) - IF HB_HHasKey( _GET, "s" ) - IF _GET[ "s" ] == "s" - ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ; - IIF( Y[ 5 ] == "D", .F., X[ 2 ] < Y[ 2 ] ) ) } ) - ELSEIF _GET[ "s" ] == "m" - ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T.), ; - IIF( Y[ 5 ] == "D", .F., DTOS( X[ 3 ] ) + X[ 4 ] < DTOS( Y[ 3 ] ) + Y[ 4 ] ) ) } ) - ELSE - ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ; - IIF( Y[ 5 ] == "D", .F., X[ 1 ] < Y[ 1 ] ) ) } ) - ENDIF - ELSE - ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ; - IIF( Y[ 5 ] == "D", .F., X[ 1 ] < Y[ 1 ] ) ) } ) - ENDIF - - uWrite( '

Index of ' + _SERVER[ "SCRIPT_NAME" ] + '

      ')
-   uWrite( 'Name                                                  ')
-   uWrite( 'Modified             ' )
-   uWrite( 'Size' + CR_LF + '
' )
-
-   // Adding Upper Directory
-   nPos := RAT( "/", SUBSTR( cDir, 1, Len( cDir ) - 1 ) )
-   cParentDir := SUBSTR( cDir, 1, nPos )
-   cParentDir := SUBSTR( cParentDir, Len( _SERVER[ "DOCUMENT_ROOT" ] ) + 1 )
-
-   //hb_ToOutDebug( "cDir = %s, nPos = %i, cParentDir = %s\n\r", cDir, nPos, cParentDir )
-
-   IF !Empty( cParentDir )
-      // Add parent directory
-      hb_aIns( aDir, 1, { "", 0, "", "", "D" }, .T. )
-   ENDIF
-
-   FOR EACH aF IN aDir
-       IF aF[ 1 ] == ""
-          uWrite( '[DIR] ..' + ;
-                  CR_LF )
-       ELSEIF LEFT( aF[ 1 ], 1 ) == "."
-       ELSEIF "D" $ aF[ 5 ]
-          uWrite( '[DIR] '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
-                  DTOC( aF[ 3 ] ) + ' ' + aF[ 4 ] + CR_LF )
-       ELSE
-          uWrite( '      '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
-                  DTOC( aF[ 3 ]) + ' ' + aF[ 4 ] + STR( aF[ 2 ], 12 ) + CR_LF )
-       ENDIF
-   NEXT
-   uWrite( "
" ) - -RETURN - -// ------------------------------- Utility functions -------------------------------- - -STATIC PROCEDURE Help() - //LOCAL cPrg := hb_argv( 0 ) - //LOCAL nPos := RAt( "\", cPrg ) - //__OutDebug( hb_argv(0) ) - //IF nPos > 0 - // cPrg := SubStr( cPrg, nPos + 1 ) - //ENDIF - ? - ? "(C) 2009 Francesco Saverio Giudice " - ? - ? APP_NAME + " - web server - v. " + APP_VERSION - ? "Based on original work of Mindaugas Kavaliauskas " - ? - ? "Parameters: (all optionals)" - ? - ? "-p | --port webserver tcp port (default: " + LTrim( Str( LISTEN_PORT ) ) + ")" - ? "-c | --config Configuration file (default: " + APP_NAME + ".ini)" - ? " It is possibile to define file path" - ? "-d | --docroot Document root directory (default: \home)" - ? "-i | --indexes Allow directory view (default: no)" - ? "-s | --stop Stop webserver" - ? "-ts | --start-threads Define starting threads (default: " + LTrim( Str( START_RUNNING_THREADS ) ) + ")" - ? "-tm | --max-threads Define max threads (default: " + LTrim( Str( MAX_RUNNING_THREADS ) ) + ")" - ? "-h | -? | --help This help message" - ? - WAIT -RETURN - -STATIC PROCEDURE SysSettings() - SET SCOREBOARD OFF - SET CENTURY ON - SET DATE ITALIAN - SET BELL OFF - SET DELETED ON - SET EXACT OFF - SET CONFIRM ON - SET ESCAPE ON - SET WRAP ON - SET EPOCH TO 2000 - //RDDSetDefault( "DBFCDX" ) -RETURN - -STATIC FUNCTION Exe_Path() - LOCAL cPath := hb_argv( 0 ) - LOCAL nPos := RAt( "\", cPath ) - IF nPos == 0 - cPath := "" - ELSE - cPath := SubStr( cPath, 1, nPos-1 ) - ENDIF -RETURN cPath - -STATIC FUNCTION Exe_Name() - LOCAL cPrg := hb_argv( 0 ) - LOCAL nPos := RAt( "\", cPrg ) - IF nPos > 0 - cPrg := SubStr( cPrg, nPos+1 ) - ENDIF -RETURN cPrg - -STATIC PROCEDURE Progress( nProgress ) - LOCAL cString := "[" - - DO CASE - CASE nProgress == 0 - cString += "-" - CASE nProgress == 1 - cString += "\" - CASE nProgress == 2 - cString += "|" - CASE nProgress == 3 - cString += "/" - ENDCASE - - cString += "]" - - nProgress++ - - IF nProgress == 4 - nProgress := 0 - ENDIF - - // using hb_dispOutAt() to avoid MT screen updates problem - hb_dispOutAt( 10, 5, cString ) - hb_dispOutAt( 0, 60, "Time: " + Time() ) - -RETURN - -// Show messages in console -#define CONSOLE_FIRSTROW 12 -#define CONSOLE_LASTROW MaxRow() -STATIC PROCEDURE WriteToConsole( ... ) - LOCAL cMsg - - IF hb_mutexLock( s_hmtxConsole ) - IF s_lConsole - - FOR EACH cMsg IN hb_aParams() - - hb_Scroll( CONSOLE_FIRSTROW, 0, CONSOLE_LASTROW, MaxCol(), -1 ) - hb_DispOutAt( CONSOLE_FIRSTROW, 0, PadR( "> " + hb_cStr( cMsg ), MaxCol() ) ) - -#ifdef DEBUG_ACTIVE - hb_ToOutDebug( ">>> %s\n\r", cMsg ) -#endif - - NEXT - - ENDIF - hb_mutexUnlock( s_hmtxConsole ) - ENDIF - -RETURN - -STATIC FUNCTION ParseIni( cConfig ) - LOCAL hIni := HB_ReadIni( cConfig ) - LOCAL cSection, hSect, cKey, xVal, cVal - LOCAL hDefault - - // Define here what attributes I can have in ini config file and their defaults - hDefault := { ; - "MAIN" => { ; - "Port" => LISTEN_PORT ,; - "Document_root" => EXE_Path() + "\home" ,; - "Show_indexes" => FALSE ; - },; - "LOGFILES" => { ; - "access" => FILE_ACCESS_LOG ,; - "error" => FILE_ERROR_LOG ; - },; - "THREADS" => { ; - "Max_Wait" => THREAD_MAX_WAIT ,; - "start_num" => START_RUNNING_THREADS ,; - "max_num" => MAX_RUNNING_THREADS ; - },; - "ALIASES" => { => } ; - } - - // Now read changes from ini file and modify only admited keys - IF !Empty( hIni ) - FOR EACH cSection IN hIni:Keys - - IF cSection $ hDefault - - hSect := hIni[ cSection ] - - IF HB_IsHash( hSect ) - FOR EACH cKey IN hSect:Keys - IF cSection == "ALIASES" - xVal := hSect[ cKey ] - IF xVal <> NIL - hDefault[ cSection ][ cKey ] := xVal - ENDIF - ELSEIF cKey $ hDefault[ cSection ] - cVal := hSect[ cKey ] - - DO CASE - CASE cSection == "MAIN" - DO CASE - CASE cKey == "Port" - xVal := Val( cVal ) - CASE cKey == "Document_root" - IF !Empty( cVal ) - // Change APP_DIR macro with current exe path - xVal := StrTran( cVal, "$(APP_DIR)", Exe_Path() ) - ENDIF - ENDCASE - CASE cSection == "LOGFILES" - DO CASE - CASE cKey == "access" - xVal := cVal - CASE cKey == "error" - xVal := cVal - ENDCASE - CASE cSection == "THREADS" - DO CASE - CASE cKey == "Max_Wait" - xVal := Val( cVal ) - CASE cKey == "start_num" - xVal := Val( cVal ) - CASE cKey == "max_num" - xVal := Val( cVal ) - ENDCASE - ENDCASE - IF xVal <> NIL - hDefault[ cSection ][ cKey ] := xVal - ENDIF - ENDIF - NEXT - ENDIF - ENDIF - NEXT - ENDIF - - RETURN hDefault - - - -//------------------------------------------------------------------------------ -// FUNZIONI C -//------------------------------------------------------------------------------ -#PRAGMA BEGINDUMP - -#ifdef __WIN32__ - -#include -#include "hbapi.h" -#include "hbvm.h" - -BOOL win_SysRefresh( int iMsec ) -{ - int iQuit = (int) FALSE; - - HANDLE hDummyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); - - // Begin the operation and continue until it is complete - // or until the user clicks the mouse or presses a key. - - while (MsgWaitForMultipleObjects(1, &hDummyEvent, FALSE, ( iMsec == 0, INFINITE, iMsec ), QS_ALLINPUT | QS_ALLPOSTMESSAGE) == WAIT_OBJECT_0 + 1) - { - MSG msg; - - while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) - { - - switch(msg.message) - { - case WM_QUIT: - { - iQuit = (int) msg.wParam; - goto stopLoop; - } - //case WM_LBUTTONDOWN: - //case WM_RBUTTONDOWN: - //case WM_KEYDOWN: - //case WM_LBUTTONUP: - //case WM_RBUTTONUP: - //case WM_KEYUP: - // // - // // Perform any required cleanup. - // // - // break; - // //exit; - // - default: - TranslateMessage(&msg); - DispatchMessage(&msg); - } - - } - if (!iQuit) - { - goto stopLoop; - } - } - -stopLoop: - - CloseHandle( hDummyEvent ); - - return iQuit; - -} - -HB_FUNC_STATIC( WIN_SYSREFRESH ) -{ - hb_retl( win_SysRefresh( ( ISNIL( 1 ) ? 0 : hb_parni( 1 ) ) ) ); -} - -HB_FUNC_STATIC( WIN_SETENV ) -{ - hb_retl( SetEnvironmentVariable( hb_parc( 1 ), hb_parc( 2 ) ) ); -} - -HB_FUNC_STATIC( WIN_TIMEZONEBIAS ) -{ - TIME_ZONE_INFORMATION tzInfo; - //LONG lBias; - int nLen; - char *szRet = (char *) hb_xgrab( 6 ); - - if ( GetTimeZoneInformation( &tzInfo ) == TIME_ZONE_ID_INVALID ) - { - tzInfo.Bias = 0; - } - else - { - tzInfo.Bias = -tzInfo.Bias; - } - - hb_snprintf( szRet, 6, "%+03d%02d", - (int)( tzInfo.Bias / 60 ), - (int)( tzInfo.Bias % 60 > 0 ? - tzInfo.Bias % 60 : tzInfo.Bias % 60 ) ); - - nLen = strlen( szRet ); - - if ( nLen < 6 ) - { - szRet = (char *) hb_xrealloc( szRet, nLen + 1 ); - } - hb_retclen_buffer( szRet, nLen ); - -} - -#endif -#PRAGMA ENDDUMP +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * uHTTPD (Micro HTTP server) + * + * Copyright 2009 Francesco Saverio Giudice + * Copyright 2008 Mindaugas Kavaliauskas (dbtopas at dbtopas.lt) + * www - http://www.harbour-project.org + * + * Credits: + * Based on first version posted from Mindaugas Kavaliauskas on + * developers NG on December 15th, 2008 whom give my thanks to have + * shared initial work. + * Francesco. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +/* + * A simple HTTP server. + * + * More description to come. + * + * + */ + +/* + TODO: + +*/ + +// comment out this line to activate hb_toOutDebug() +#define DEBUG_ACTIVE + +#ifndef _XHARBOUR_ + #include "hbcompat.ch" +#endif +#include "fileio.ch" +#include "common.ch" +#include "inkey.ch" + +#include "hbextern.ch" // need this to use with HRB + +#ifdef GD_SUPPORT + // adding GD support + REQUEST GDIMAGE, gdImageChar, GDCHART + #define APP_GD_SUPPORT "_GD" +#else + #define APP_GD_SUPPORT "" +#endif + +#ifdef USE_HB_INET + #define APP_INET_SUPPORT "_INET" +#else + #define APP_INET_SUPPORT "" +#endif + +#define APP_NAME "uhttpd_inet" +#define APP_VER_NUM "0.3" +#define APP_VERSION APP_VER_NUM + APP_GD_SUPPORT + APP_INET_SUPPORT + +#define AF_INET 2 + +// default values - they can changes using line command switch +#define START_RUNNING_THREADS 4 // Start threads to serve connections +#define MAX_RUNNING_THREADS 20 // Max running threads + +#define START_SERVICE_THREADS 1 // Initial number for service connections +#define MAX_SERVICE_THREADS 3 // Max running threads + +#define LISTEN_PORT 8082 // differs from standard 80 port for tests in case + // anyone has a apache/IIS installed +#define FILE_STOP ".uhttpd.stop" +#define FILE_ACCESS_LOG "logs\access.log" +#define FILE_ERROR_LOG "logs\error.log" + +#define PAGE_STATUS_REFRESH 1 +#define THREAD_MAX_WAIT ( 60 ) // HOW MUCH TIME THREAD HAS TO WAIT BEFORE FINISH - IN SECONDS + +#define CR_LF (CHR(13)+CHR(10)) +#define HB_IHASH() HB_HSETCASEMATCH( {=>}, FALSE ) + +#ifndef _XHARBOUR_ + + #ifdef __PLATFORM__WINDOWS + REQUEST HB_GT_WVT_DEFAULT + REQUEST HB_GT_WIN + REQUEST HB_GT_NUL + #ifdef HB_MT_VM + #define THREAD_GT hb_gtVersion() + #endif + #else + REQUEST HB_GT_STD_DEFAULT + REQUEST HB_GT_NUL + #define THREAD_GT "XWC" + #endif + +#else + + REQUEST HB_GT_WVT + REQUEST HB_GT_WIN + REQUEST HB_GT_NUL + +#endif + +// dynamic call for HRB support +DYNAMIC HRBMAIN + +STATIC s_hmtxQueue, s_hmtxServiceThreads, s_hmtxRunningThreads, s_hmtxLog, s_hmtxConsole, s_hmtxBusy +STATIC s_hmtxHRB +STATIC s_hfileLogAccess, s_hfileLogError, s_cDocumentRoot, s_lIndexes, s_lConsole, s_nPort +STATIC s_nThreads, s_nStartThreads, s_nMaxThreads +STATIC s_nServiceThreads, s_nStartServiceThreads, s_nMaxServiceThreads +STATIC s_nConnections, s_nMaxConnections, s_nTotConnections +STATIC s_nServiceConnections, s_nMaxServiceConnections, s_nTotServiceConnections +STATIC s_aRunningThreads := {} +STATIC s_aServiceThreads := {} + +#ifdef USE_HB_INET +STATIC s_cLocalAddress, s_nLocalPort +#endif + +// ALIASES: now read from ini file +//STATIC s_hFileAliases := { "/info" => "/cgi-bin/info.hrb" } +STATIC s_hFileAliases := { => } + +THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_cErrorMsg + +MEMVAR _SERVER, _GET, _POST, _REQUEST, _HTTP_REQUEST, m_cPost + +FUNCTION MAIN( ... ) +LOCAL nPort, hListen, hSocket, aRemote, cI, xVal +LOCAL aThreads, nStartThreads, nMaxThreads, nStartServiceThreads +LOCAL i, cPar, lStop +LOCAL cGT, cDocumentRoot, lIndexes, cConfig +LOCAL lConsole +LOCAL nProgress := 0 +LOCAL hDefault, cLogAccess, cLogError +LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads + + IF !HB_MTVM() + ? "I need multhread support. Please, recompile me!" + WAIT + RETURN 2 + ENDIF + + // ----------------------- Initializations --------------------------------- + + SysSettings() + + // ----------------------- Parameters defaults ----------------------------- + + // defaults not changeble via ini file + lStop := FALSE + cConfig := EXE_Path() + "\" + APP_NAME + ".ini" + lConsole := TRUE + nStartServiceThreads := START_SERVICE_THREADS + + // Check GT version - if I have started app with //GT:NUL then I have to disable + // console + cGT := HB_GT_VERSION() + IF ( cGT == "NUL" ) + lConsole := FALSE + ENDIF + + // TOCHECK: now not force case insensitive + //HB_HSETCASEMATCH( s_hFileAliases, FALSE ) + + // ----------------- Line command parameters checking ---------------------- + + i := 1 + while ( i <= PCount() ) + + cPar := hb_PValue( i++ ) + + do case + case cPar == "--port" .OR. cPar == "-p" + cCmdPort := hb_PValue( i++ ) + + case cPar == "--docroot" .OR. cPar == "-d" + cCmdDocumentRoot := hb_PValue( i++ ) + + case cPar == "--indexes" .OR. cPar == "-i" + lCmdIndexes := TRUE + + case cPar == "--stop" .OR. cPar == "-s" + lStop := TRUE + + case cPar == "--config" .OR. cPar == "-c" + cConfig := hb_PValue( i++ ) + + case cPar == "--start-threads" .OR. cPar == "-ts" + nCmdStartThreads := Val( hb_PValue( i++ ) ) + + case cPar == "--max-threads" .OR. cPar == "-tm" + nCmdMaxThreads := Val( hb_PValue( i++ ) ) + + case cPar == "--help" .OR. Lower( cPar ) == "-h" .OR. cPar == "-?" + help() + RETURN 0 + + otherwise + help() + RETURN 0 + endcase + enddo + + // -------------------- checking STOP request ------------------------------- + + IF lStop + HB_MEMOWRIT( FILE_STOP, "" ) + RETURN 0 + ELSE + FERASE( FILE_STOP ) + ENDIF + + // ----------------- Parse ini file ---------------------------------------- + + hDefault := ParseIni( cConfig ) + + // ------------------- Parameters changeable from ini file ---------------- + + nPort := hDefault[ "MAIN" ][ "Port" ] + cDocumentRoot := hDefault[ "MAIN" ][ "Document_root" ] + lIndexes := hDefault[ "MAIN" ][ "Show_indexes" ] + + cLogAccess := hDefault[ "LOGFILES" ][ "access" ] + cLogError := hDefault[ "LOGFILES" ][ "error" ] + + nStartThreads := hDefault[ "THREADS" ][ "start_num" ] + nMaxThreads := hDefault[ "THREADS" ][ "max_num" ] + + FOR EACH xVal IN hDefault[ "ALIASES" ] + IF HB_ISSTRING( xVal ) + hb_HSet( s_hFileAliases, xVal:__enumKey(), xVal ) + ENDIF + NEXT + + //hb_ToOutDebug( "hDefault = %s\n\r", hb_ValToExp( hDefault ) ) + //hb_ToOutDebug( "s_hFileAliases = %s\n\r", hb_ValToExp( s_hFileAliases ) ) + + // ------------------- Parameters forced from command line ---------------- + + IF cCmdPort != NIL + nPort := Val( cCmdPort ) + ENDIF + + IF cCmdDocumentRoot != NIL + cDocumentRoot := cCmdDocumentRoot + ENDIF + + IF lCmdIndexes != NIL + lIndexes := lCmdIndexes + ENDIF + + IF nCmdStartThreads != NIL + nStartThreads := nCmdStartThreads + ENDIF + + IF nCmdMaxThreads != NIL + nMaxThreads := nCmdMaxThreads + ENDIF + + // -------------------- checking starting values ---------------------------- + + IF nPort <= 0 .OR. nPort > 65535 + ? "Invalid port number:", nPort + WAIT + RETURN 1 + ENDIF + + + IF HB_ISSTRING( cDocumentRoot ) + //cI := STRTRAN( SUBSTR( cDocumentRoot, 2 ), "\", "/" ) + cI := cDocumentRoot + IF HB_DirExists( cI ) + IF RIGHT( cI, 1 ) == "/" .AND. LEN(cI) > 2 .AND. SUBSTR( cI, LEN( cI ) - 2, 1 ) != ":" + s_cDocumentRoot := LEFT( cI, LEN( cI ) - 1 ) + ELSE + s_cDocumentRoot := cI + ENDIF + ELSE + ? "Invalid document root:", cI + WAIT + RETURN 3 + ENDIF + ELSE + ? "Invalid document root" + WAIT + RETURN 3 + ENDIF + + IF nMaxThreads <= 0 + nMaxThreads := MAX_RUNNING_THREADS + ENDIF + + IF nStartThreads < 0 + nStartThreads := 0 + ELSEIF nStartThreads > nMaxThreads + nStartThreads := nMaxThreads + ENDIF + + // -------------------- assign STATIC values -------------------------------- + + s_lIndexes := lIndexes + s_lConsole := lConsole + s_nPort := nPort + s_nThreads := 0 + s_nStartThreads := nStartThreads + s_nMaxThreads := nMaxThreads + s_nServiceThreads := 0 + s_nStartServiceThreads := nStartServiceThreads + s_nMaxServiceThreads := MAX_SERVICE_THREADS + s_nConnections := 0 + s_nMaxConnections := 0 + s_nTotConnections := 0 + s_nServiceConnections := 0 + s_nMaxServiceConnections := 0 + s_nTotServiceConnections := 0 + + // --------------------- Open log files ------------------------------------- + + IF ( s_hfileLogAccess := FOPEN( cLogAccess, FO_CREAT + FO_WRITE ) ) == -1 + ? "Can't open access log file" + WAIT + RETURN 1 + ENDIF + FSEEK( s_hfileLogAccess, 0, FS_END ) + + IF ( s_hfileLogError := FOPEN( cLogError, FO_CREAT + FO_WRITE ) ) == -1 + ? "Can't open error log file" + WAIT + RETURN 1 + ENDIF + FSEEK( s_hfileLogError, 0, FS_END ) + + // --------------------- MAIN PART ------------------------------------------ + + SET CURSOR OFF + + // --------------------- define mutexes ------------------------------------- + + s_hmtxQueue := hb_mutexCreate() + s_hmtxLog := hb_mutexCreate() + s_hmtxConsole := hb_mutexCreate() + s_hmtxBusy := hb_mutexCreate() + s_hmtxRunningThreads := hb_mutexCreate() + s_hmtxServiceThreads := hb_mutexCreate() + s_hmtxHRB := hb_mutexCreate() + + WriteToConsole( "--- Starting " + APP_NAME + " ---" ) + + // -------------------------------------------------------------------------- + // SOCKET CREATION + // -------------------------------------------------------------------------- + +#ifdef USE_HB_INET + hListen := hb_InetServer( nPort ) + + IF hb_InetErrorCode( hListen ) != 0 + ? "Bind Error" + ELSE + + s_nLocalPort := hb_InetPort( hListen ) + s_cLocalAddress := hb_InetAddress( hListen ) + +#else + hListen := socket_create() + IF socket_bind( hListen, { AF_INET, "0.0.0.0", nPort } ) == -1 + ? "bind() error", socket_error() + ELSEIF socket_listen( hListen ) == -1 + ? "listen() error", socket_error() + ELSE +#endif + // --------------------------------------------------------------------------------- // + // Starting Accept connection thread + // --------------------------------------------------------------------------------- // + + WriteToConsole( "Starting AcceptConnection Thread" ) + aThreads := {} + AADD( aThreads, hb_threadStart( @AcceptConnections() ) ) + + // --------------------------------------------------------------------------------- // + // main loop + // --------------------------------------------------------------------------------- // + + WriteToConsole( "Starting main loop" ) + + IF s_lConsole + hb_DispOutAt( 1, 5, APP_NAME + " - web server - v. " + APP_VERSION ) + hb_DispOutAt( 4, 5, "Server listening (Port: " + LTrim( Str( nPort ) ) + ") : ..." ) + hb_DispOutAt( 10, 9, "Waiting." ) + ENDIF + + DO WHILE .T. + + // windows resource releasing - 1 millisecond wait + WIN_SYSREFRESH( 1 ) + + IF s_lConsole + + // Show application infos + IF hb_mutexLock( s_hmtxBusy ) + hb_DispOutAt( 5, 5, "Threads : " + Transform( s_nThreads, "9999999999" ) ) + hb_DispOutAt( 6, 5, "Connections : " + Transform( s_nConnections, "9999999999" ) ) + hb_DispOutAt( 7, 5, "Max Connections : " + Transform( s_nMaxConnections, "9999999999" ) ) + hb_DispOutAt( 8, 5, "Total Connections : " + Transform( s_nTotConnections, "9999999999" ) ) + + hb_DispOutAt( 5, 37, "ServiceThreads : " + Transform( s_nServiceThreads, "9999999999" ) ) + hb_DispOutAt( 6, 37, "Connections : " + Transform( s_nServiceConnections, "9999999999" ) ) + hb_DispOutAt( 7, 37, "Max Connections : " + Transform( s_nMaxServiceConnections, "9999999999" ) ) + hb_DispOutAt( 8, 37, "Total Connections : " + Transform( s_nTotServiceConnections, "9999999999" ) ) + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // Show progress + Progress( @nProgress ) + ENDIF + + // Wait a connection +#ifdef USE_HB_INET + hb_InetTimeOut( hListen, 50 ) + IF HB_InetDataReady( hListen ) > 0 +#else + IF socket_select( { hListen },,, 50 ) > 0 +#endif + // reset remote values + aRemote := NIL + + // Accept a remote connection +#ifdef USE_HB_INET + hSocket := HB_INETACCEPT( hListen ) +#else + hSocket := socket_accept( hListen, @aRemote ) +#endif + IF hSocket == NIL + +#ifdef USE_HB_INET + WriteToConsole( hb_sprintf( "accept() error" ) ) +#else + WriteToConsole( hb_sprintf( "accept() error: %s", socket_error() ) ) +#endif + + ELSE + + // Send accepted connection to AcceptConnections() thread + hb_mutexNotify( s_hmtxQueue, hSocket ) + + ENDIF + + ELSE + + // Checking if I have to quit + IF HB_FileExists( FILE_STOP ) + FERASE( FILE_STOP ) + EXIT + ENDIF + + ENDIF + + ENDDO + + WriteToConsole( "Waiting threads" ) + // Send to thread that they have to stop + AEVAL( aThreads, {|| hb_mutexNotify( s_hmtxQueue, NIL ) } ) + // Wait threads to end + AEVAL( aThreads, {|h| hb_threadJoin( h ) } ) + + ENDIF + + WriteToConsole( "--- Quitting " + APP_NAME + " ---" ) + + // Close socket +#ifdef USE_HB_INET + hb_InetClose( hListen ) +#else + socket_close( hListen ) +#endif + + // Close log files + FCLOSE( s_hfileLogAccess ) + FCLOSE( s_hfileLogError ) + + SET CURSOR ON + +RETURN 0 + +// --------------------------------------------------------------------------------- // +// THREAD FUNCTIONS +// --------------------------------------------------------------------------------- // + +STATIC FUNCTION AcceptConnections() + LOCAL hSocket + LOCAL nConnections, nThreads, nMaxThreads, n + LOCAL nServiceConnections, nServiceThreads, nMaxServiceThreads, nThreadID + LOCAL pThread + + WriteToConsole( "Starting AcceptConnections()" ) + + // Starting initial running threads + FOR n := 1 TO s_nStartThreads + pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) + AADD( s_aRunningThreads, { pThread, nThreadID } ) + NEXT + + // Starting initial service threads + FOR n := 1 TO s_nStartServiceThreads + pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) + AADD( s_aServiceThreads, { pThread, nThreadID } ) + NEXT + + // Main AcceptConnections loop + DO WHILE .T. + + // reset socket + hSocket := NIL + + // releasing resources + WIN_SYSREFRESH( 1 ) + + // Waiting a connection from main application loop + hb_mutexSubscribe( s_hmtxQueue,, @hSocket ) + + // I have a QUIT request + IF hSocket == NIL + + // Requesting to Running threads to quit (using -1 value) + AEVAL( s_aRunningThreads, {|| hb_mutexNotify( s_hmtxRunningThreads, -1 ) } ) + // waiting running threads to quit + AEVAL( s_aRunningThreads, {|h| hb_threadJoin( h[1] ) } ) + + // Requesting to Service threads to quit (using -1 value) + AEVAL( s_aServiceThreads, {|| hb_mutexNotify( s_hmtxServiceThreads, -1 ) } ) + // waiting service threads to quit + AEVAL( s_aServiceThreads, {|h| hb_threadJoin( h[1] ) } ) + + EXIT + ENDIF + + // Load current state + IF hb_mutexLock( s_hmtxBusy ) + nConnections := s_nConnections + nThreads := s_nThreads + nMaxThreads := s_nMaxThreads + nServiceConnections:= s_nServiceConnections + nServiceThreads := s_nServiceThreads + nMaxServiceThreads := s_nMaxServiceThreads + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // If I have no more thread to use ... + IF nConnections > nMaxThreads + + // If I have no more of service threads to use ... (DOS attack ?) + IF nServiceConnections > nMaxServiceThreads + // DROP connection +#ifdef USE_HB_INET + hb_InetClose( hSocket ) +#else + socket_shutdown( hSocket ) + socket_close( hSocket ) +#endif + + // If I have no service threads in use ... + ELSEIF nServiceConnections >= nServiceThreads + // Add one more + pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) + AADD( s_aServiceThreads, { pThread, nThreadID } ) + ENDIF + // Otherwise I send connection to service thread + hb_mutexNotify( s_hmtxServiceThreads, hSocket ) + + LOOP + + // If I have no running threads in use ... + ELSEIF nConnections >= nThreads + // Add one more + pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) + AADD( s_aRunningThreads, { pThread, nThreadID } ) + ENDIF + // Otherwise I send connection to running thread + hb_mutexNotify( s_hmtxRunningThreads, hSocket ) + + ENDDO + + WriteToConsole( "Quitting AcceptConnections()" ) + +RETURN 0 + +// --------------------------------------------------------------------------------- // +// CONNECTIONS +// --------------------------------------------------------------------------------- // +STATIC FUNCTION ProcessConnection( nThreadIdRef ) +LOCAL hSocket, cBuf, nLen, cRequest, cSend +LOCAL nMsecs, nParseTime, nPos +LOCAL nThreadId +#ifdef USE_HB_INET +LOCAL nRcvLen, nContLen +#else +LOCAL aI +#endif + + nThreadId := hb_threadID() + nThreadIdRef := nThreadId + + WriteToConsole( "Starting ProcessConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nThreads++ + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // ProcessConnection Loop + DO WHILE .T. + + // Reset socket + hSocket := NIL + + // releasing resources + WIN_SYSREFRESH( 1 ) + + // Waiting a connection from AcceptConnections() but up to defined time + hb_mutexSubscribe( s_hmtxRunningThreads, THREAD_MAX_WAIT, @hSocket ) + + // received a -1 value, I have to quit + IF HB_ISNUMERIC( hSocket ) + EXIT + // no socket received, thread can graceful quit only if over minimal number + ELSEIF hSocket == NIL + IF hb_mutexLock( s_hmtxBusy ) + IF s_nThreads <= s_nStartThreads + hb_mutexUnlock( s_hmtxBusy ) + LOOP + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + EXIT + ENDIF + + // Connection accepted + IF hb_mutexLock( s_hmtxBusy ) + s_nConnections++ + s_nTotConnections++ + s_nMaxConnections := Max( s_nConnections, s_nMaxConnections ) + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // Save initial time + nMsecs := hb_milliseconds() + + BEGIN SEQUENCE + + /* receive query */ +#ifdef USE_HB_INET + cRequest := "" + nLen := 0 + nRcvLen := 1 + nContLen := 0 + DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 + cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) + //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) + cRequest += cBuf + CR_LF + nLen += nRcvLen + IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 + cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) + nContLen := Val( cBuf ) + ENDIF + ENDDO + + //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) + // if the request has a content-lenght, we must read it + IF nLen > 0 .AND. nContLen > 0 + // cPostData is autoAllocated + cBuf := Space( nContLen ) + IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 + nLen := -1 // force error check + ELSE + cRequest += cBuf + ENDIF + ENDIF +#else + cRequest := "" + nLen := 1 + DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 + nLen := socket_recv( hSocket, @cBuf ) + cRequest += cBuf + ENDDO +#endif + + IF nLen == -1 +#ifdef USE_HB_INET + ? "recv() error:", HB_INETERRORCODE( hSocket ), HB_INETERRORDESC( hSocket ) +#else + ? "recv() error:", socket_error() +#endif + + ELSEIF nLen == 0 /* connection closed */ + ELSE + + //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) + + PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost + t_cResult := "" + t_aHeader := {} + t_nStatusCode := 200 + t_cErrorMsg := "" + +#ifdef USE_HB_INET + _SERVER["REMOTE_ADDR"] := hb_InetAddress( hSocket ) + _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS + _SERVER["REMOTE_PORT"] := hb_InetPort( hSocket ) + + _SERVER["SERVER_ADDR"] := s_cLocalAddress + _SERVER["SERVER_PORT"] := s_nLocalPort +#else + IF socket_getpeername( hSocket, @aI ) != -1 + _SERVER["REMOTE_ADDR"] := aI[2] + _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS + _SERVER["REMOTE_PORT"] := aI[3] + ENDIF + + IF socket_getsockname( hSocket, @aI ) != -1 + _SERVER["SERVER_ADDR"] := aI[2] + _SERVER["SERVER_PORT"] := aI[3] + ENDIF +#endif + IF ParseRequest( cRequest ) + //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) + define_Env( _SERVER ) + uproc_default() + ELSE + uSetStatusCode( 400 ) + ENDIF + cSend := MakeResponse() + + //hb_ToOutDebug( "cSend = %s\n\r", cSend ) + +#ifdef USE_HB_INET + DO WHILE LEN( cSend ) > 0 + IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 + ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) + WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR( cSend, nLen + 1 ) + ENDIF + ENDDO +#else + DO WHILE LEN( cSend ) > 0 + IF ( nLen := socket_send( hSocket, cSend ) ) == -1 + ? "send() error:", socket_error() + WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR( cSend, nLen + 1 ) + ENDIF + ENDDO +#endif + WriteToLog( cRequest ) + + ENDIF + +#ifdef USE_HB_INET + hb_InetClose( hSocket ) +#else + socket_shutdown( hSocket ) + socket_close( hSocket ) +#endif + END SEQUENCE + + nParseTime := hb_milliseconds() - nMsecs + WriteToConsole( "Page served in : " + Str( nParseTime/1000, 10, 7 ) + " seconds" ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nConnections-- + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + ENDDO + + WriteToConsole( "Quitting ProcessConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nThreads-- + IF ( nPos := aScan( s_aRunningThreads, {|h| h[2] == nThreadId } ) > 0 ) + hb_aDel( s_aRunningThreads, nPos, TRUE ) + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + +RETURN 0 + +STATIC FUNCTION ServiceConnection( nThreadIdRef ) +LOCAL hSocket, cBuf, nLen, cRequest, cSend +LOCAL nMsecs, nParseTime, nPos +LOCAL nThreadId +LOCAL nError := 500013 +#ifdef USE_HB_INET +LOCAL nRcvLen, nContLen +#else +LOCAL aI +#endif + + nThreadId := hb_threadID() + nThreadIdRef := nThreadId + + WriteToConsole( "Starting ServiceConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceThreads++ + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + DO WHILE .T. + + // Reset socket + hSocket := NIL + + // releasing resources + WIN_SYSREFRESH( 1 ) + + // Waiting a connection from AcceptConnections() but up to defined time + hb_mutexSubscribe( s_hmtxServiceThreads, THREAD_MAX_WAIT, @hSocket ) + + // received a -1 value, I have to quit + IF HB_ISNUMERIC( hSocket ) + EXIT + // no socket received, thread can graceful quit only if over minimal number + ELSEIF hSocket == NIL + IF hb_mutexLock( s_hmtxBusy ) + IF s_nServiceThreads <= s_nStartServiceThreads + hb_mutexUnlock( s_hmtxBusy ) + LOOP + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + EXIT + ENDIF + + // Connection accepted + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceConnections++ + s_nTotServiceConnections++ + s_nMaxServiceConnections := Max( s_nServiceConnections, s_nMaxServiceConnections ) + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // Save initial time + nMsecs := hb_milliseconds() + + BEGIN SEQUENCE + + /* receive query */ +#ifdef USE_HB_INET + cRequest := "" + nLen := 0 + nRcvLen := 1 + nContLen := 0 + DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 + cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) + //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) + cRequest += cBuf + CR_LF + nLen += nRcvLen + IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 + cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) + nContLen := Val( cBuf ) + ENDIF + ENDDO + + //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) + // if the request has a content-lenght, we must read it + IF nLen > 0 .AND. nContLen > 0 + // cPostData is autoAllocated + cBuf := Space( nContLen ) + IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 + nLen := -1 // force error check + ELSE + cRequest += cBuf + ENDIF + ENDIF +#else + cRequest := "" + nLen := 1 + DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 + nLen := socket_recv( hSocket, @cBuf ) + cRequest += cBuf + ENDDO +#endif + + IF nLen == -1 +#ifdef USE_HB_INET + ? "recv() error:", hb_InetErrorCode( hSocket ), hb_InetErrorDesc( hSocket ) +#else + ? "recv() error:", socket_error() +#endif + ELSEIF nLen == 0 /* connection closed */ + ELSE + + //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) + + PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost + t_cResult := "" + t_aHeader := {} + t_nStatusCode := 200 + t_cErrorMsg := "" + +#ifdef USE_HB_INET + _SERVER["REMOTE_ADDR"] := hb_InetAddress( hSocket ) + _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS + _SERVER["REMOTE_PORT"] := hb_InetPort( hSocket ) + + _SERVER["SERVER_ADDR"] := s_cLocalAddress + _SERVER["SERVER_PORT"] := s_nLocalPort +#else + IF socket_getpeername( hSocket, @aI ) != -1 + _SERVER["REMOTE_ADDR"] := aI[2] + _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS + _SERVER["REMOTE_PORT"] := aI[3] + ENDIF + + IF socket_getsockname( hSocket, @aI ) != -1 + _SERVER["SERVER_ADDR"] := aI[2] + _SERVER["SERVER_PORT"] := aI[3] + ENDIF +#endif + + IF ParseRequest( cRequest ) + //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) + define_Env( _SERVER ) + ENDIF + // Error page served + uSetStatusCode( nError ) + cSend := MakeResponse() + +#ifdef USE_HB_INET + DO WHILE LEN( cSend ) > 0 + IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 + ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) + WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR( cSend, nLen + 1 ) + ENDIF + ENDDO +#else + DO WHILE LEN( cSend ) > 0 + IF ( nLen := socket_send( hSocket, cSend ) ) == -1 + ? "send() error:", socket_error() + WriteToConsole( hb_sprintf( "ServiceConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR( cSend, nLen + 1 ) + ENDIF + ENDDO +#endif + + WriteToLog( cRequest ) + + ENDIF +#ifdef USE_HB_INET + hb_InetClose( hSocket ) +#else + socket_shutdown( hSocket ) + socket_close( hSocket ) +#endif + END SEQUENCE + + nParseTime := hb_milliseconds() - nMsecs + WriteToConsole( "Page served in : " + Str( nParseTime/1000, 10, 7 ) + " seconds" ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceConnections-- + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + ENDDO + + WriteToConsole( "Quitting ServiceConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceThreads-- + IF ( nPos := aScan( s_aServiceThreads, {|h| h[2] == nThreadId } ) > 0 ) + hb_aDel( s_aServiceThreads, nPos, TRUE ) + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + +RETURN 0 + +STATIC FUNCTION ParseRequest( cRequest ) +LOCAL aRequest, aLine, nI, nJ, cI +LOCAL cReq, aVal, cPost + + // RFC2616 + aRequest := split( CR_LF, cRequest ) + + //hb_ToOutDebug( "aRequest = %s\n\r", hb_ValToExp( aRequest ) ) + + WriteToConsole( aRequest[1] ) + aLine := split( " ", aRequest[1] ) + IF LEN( aLine ) != 3 .OR. ; + ( aLine[1] != "GET" .AND. aLine[1] != "POST" ) .OR. ; // Sorry, we support GET and POST only + LEFT( aLine[3], 5 ) != "HTTP/" + RETURN .F. + ENDIF + + // define _SERVER var + _SERVER["REQUEST_METHOD"] := aLine[1] + _SERVER["REQUEST_URI"] := aLine[2] + _SERVER["SERVER_PROTOCOL"] := aLine[3] + + IF ( nI := AT( "?", _SERVER["REQUEST_URI"] ) ) > 0 + _SERVER["SCRIPT_NAME"] := LEFT( _SERVER["REQUEST_URI"], nI - 1) + _SERVER["QUERY_STRING"] := SUBSTR( _SERVER["REQUEST_URI"], nI + 1) + ELSE + _SERVER["SCRIPT_NAME"] := _SERVER["REQUEST_URI"] + _SERVER["QUERY_STRING"] := "" + ENDIF + + _SERVER["HTTP_ACCEPT"] := "" + _SERVER["HTTP_ACCEPT_CHARSET"] := "" + _SERVER["HTTP_ACCEPT_ENCODING"] := "" + _SERVER["HTTP_ACCEPT_LANGUAGE"] := "" + _SERVER["HTTP_CONNECTION"] := "" + _SERVER["HTTP_HOST"] := "" + _SERVER["HTTP_KEEP_ALIVE"] := "" + _SERVER["HTTP_REFERER"] := "" + _SERVER["HTTP_USER_AGENT"] := "" + _SERVER["HTTP_CACHE_CONTROL"] := "" + + FOR nI := 2 TO LEN( aRequest ) + IF aRequest[nI] == ""; EXIT + ELSEIF ( nJ := AT( ":", aRequest[nI] ) ) > 0 + cI := LTRIM( SUBSTR( aRequest[nI], nJ + 1)) + SWITCH UPPER( LEFT( aRequest[nI], nJ - 1)) + CASE "ACCEPT" + CASE "ACCEPT-CHARSET" + CASE "ACCEPT-ENCODING" + CASE "ACCEPT-LANGUAGE" + CASE "CACHE-CONTROL" + CASE "CONNECTION" + CASE "KEEP-ALIVE" + CASE "REFERER" + CASE "USER-AGENT" + _SERVER[ "HTTP_" + STRTRAN( UPPER( LEFT( aRequest[nI], nJ - 1 ) ), "-", "_" ) ] := cI + EXIT + CASE "HOST" + aVal := split( ":", aRequest[ nI ] ) + _SERVER[ "HTTP_" + STRTRAN( UPPER( aVal[ 1 ] ), "-", "_")] := AllTrim( aVal[ 2 ] ) + EXIT + CASE "CONTENT-TYPE" + CASE "CONTENT-LENGTH" + _SERVER[ STRTRAN( UPPER( LEFT( aRequest[ nI ], nJ - 1 ) ), "-", "_" ) ] := cI + EXIT + ENDSWITCH + ENDIF + NEXT + + // GET vars + FOR EACH cI IN split( "&", _SERVER["QUERY_STRING"] ) + IF ( nI := AT( "=", cI ) ) > 0 + _GET[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) + _REQUEST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) + ELSE + _GET[ cI ] := "" + _REQUEST[ cI ] := "" + ENDIF + NEXT + + // Load _HTTP_REQUEST + FOR EACH cReq IN aRequest + IF cReq:__enumIndex() == 1 // GET request + hb_HSet( _HTTP_REQUEST, "HTTP Request", cReq ) + ELSEIF Empty( cReq ) + EXIT + ELSE + aVal := split( ":", cReq, 1 ) + hb_HSet( _HTTP_REQUEST, aVal[ 1 ], IIF( Len( aVal ) == 2, AllTrim( aVal[ 2 ] ), NIL ) ) + ENDIF + NEXT + + // POST vars + IF "POST" $ Upper( _SERVER[ 'REQUEST_METHOD' ] ) + //hb_ToOutDebug( "POST: %s\n\r", aTail( aRequest ) ) + cPost := aTail( aRequest ) + FOR EACH cI IN split( "&", cPost ) + IF ( nI := AT( "=", cI ) ) > 0 + _POST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) + _REQUEST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) + ELSE + _POST[ cI ] := "" + _REQUEST[ cI ] := "" + ENDIF + NEXT + m_cPost := cPost + ENDIF + + // Complete _SERVER + _SERVER[ "SERVER_NAME" ] = split( ":", _HTTP_REQUEST[ "HOST" ], 1 )[ 1 ] + _SERVER[ "SERVER_SOFTWARE" ] = APP_NAME + " " + APP_VERSION + " (" + OS() + ")" + _SERVER[ "SERVER_SIGNATURE" ] = "
" + _SERVER[ "SERVER_SOFTWARE" ] + " Server at " + _SERVER[ "SERVER_NAME" ] + " Port " + LTrim( Str( _SERVER[ "SERVER_PORT" ] ) ) + "
" + _SERVER[ "DOCUMENT_ROOT" ] = s_cDocumentRoot + _SERVER[ "SERVER_ADMIN" ] = "root" + _SERVER[ "SCRIPT_FILENAME" ] = STRTRAN( STRTRAN( _SERVER[ "DOCUMENT_ROOT" ] + _SERVER[ "SCRIPT_NAME" ], "//", "/" ), "\", "/" ) + _SERVER[ "GATEWAY_INTERFACE" ] = "CGI/1.1" + _SERVER[ "SCRIPT_URL" ] := _SERVER["SCRIPT_NAME"] + + //hb_ToOutDebug( "_SERVER = %s\n\r", hb_ValToExp( _SERVER ) ) + //hb_ToOutDebug( "_GET = %s\n\r", hb_ValToExp( _GET ) ) + //hb_ToOutDebug( "_POST = %s\n\r", hb_ValToExp( _POST ) ) + //hb_ToOutDebug( "_HTTP_REQUEST = %s\n\r", hb_ValToExp( _HTTP_REQUEST ) ) + +RETURN .T. + + +STATIC FUNCTION MakeResponse() +LOCAL cRet, cReturnCode + + uAddHeader("Connection", "close") + + IF uGetHeader("Location") != NIL + t_nStatusCode := 301 + ENDIF + IF uGetHeader("Content-Type") == NIL + uAddHeader("Content-Type", "text/html") + ENDIF + + cRet := "HTTP/1.1 " + cReturnCode := DecodeStatusCode() + + SWITCH t_nStatusCode + CASE 200 + EXIT + + CASE 301 + CASE 400 + CASE 401 + CASE 402 + CASE 403 + CASE 404 + CASE 503 + t_cResult := "

" + cReturnCode + "

" + EXIT + + // extended error messages - from Microsoft IIS Server + CASE 500013 // error: 500-13 Server too busy + uAddHeader( "Retry-After", "60" ) // retry after 60 seconds + t_cResult := "

500 Server Too Busy

" + EXIT + + CASE 500100 // error: 500-100 Undeclared Variable + + OTHERWISE + cReturnCode := "403 Forbidden" + t_cResult := "

" + cReturnCode + "

" + ENDSWITCH + + WriteToConsole( cReturnCode ) + cRet += cReturnCode + CR_LF + AEVAL( t_aHeader, {|x| cRet += x[1] + ": " + x[2] + CR_LF } ) + cRet += CR_LF + cRet += t_cResult +RETURN cRet + +STATIC FUNCTION DecodeStatusCode() +LOCAL cReturnCode + + SWITCH t_nStatusCode + CASE 200 + cReturnCode := "200 OK" + EXIT + CASE 301 + cReturnCode := "301 Moved Permanently" + EXIT + CASE 400 + cReturnCode := "400 Bad Request" + EXIT + CASE 401 + cReturnCode := "401 Unauthorized" + EXIT + CASE 402 + cReturnCode := "402 Payment Required" + EXIT + CASE 403 + cReturnCode := "403 Forbidden" + EXIT + CASE 404 + cReturnCode := "404 Not Found" + EXIT + CASE 503 + cReturnCode := "503 Service Unavailable" + EXIT + + // extended error messages - from Microsoft IIS Server + CASE 500013 // error: 500-13 Server too busy + cReturnCode := "500-13 Server Too Busy" + EXIT + + CASE 500100 // error: 500-100 Undeclared Variable + + OTHERWISE + cReturnCode := "403 Forbidden" + ENDSWITCH + +RETURN cReturnCode + +STATIC PROCEDURE WriteToLog( cRequest ) + LOCAL cTime, cDate + LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" } + LOCAL aMonths := {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"} + LOCAL cAccess, cError, nDoW, dDate, nDay, nMonth, nYear, nSize, cBias + LOCAL cErrorMsg + LOCAL cReferer + + IF hb_mutexLock( s_hmtxLog ) + + //hb_ToOutDebug( "TIP_TimeStamp() = %s \n\r", TIP_TIMESTAMP() ) + + cTime := TIME() + dDate := Date() + cDate := DTOS( dDate ) + nSize := LEN( t_cResult ) + cReferer := _SERVER["HTTP_REFERER"] + cBias := WIN_TIMEZONEBIAS() + + cAccess := _SERVER["REMOTE_ADDR"] + " - - [" + RIGHT( cDate, 2 ) + "/" + ; + aMonths[ VAL( SUBSTR( cDate, 5, 2 ) ) ] + ; + "/" + LEFT( cDate, 4 ) + ":" + cTime + ' ' + cBias + '] "' + ; + LEFT( cRequest, AT( CR_LF, cRequest ) - 1 ) + '" ' + ; + LTRIM( STR( t_nStatusCode ) ) + " " + IIF( nSize == 0, "-", LTRIM( STR( nSize ) ) ) + ; + ' "' + IIF( Empty( cReferer ), "-", cReferer ) + '" "' + _SERVER["HTTP_USER_AGENT"] + ; + '"' + HB_OSNewLine() + + //hb_ToOutDebug( "AccessLog = %s \n\r", cAccess ) + + FWRITE( s_hfileLogAccess, cAccess ) + + IF !( t_nStatusCode == 200 ) // ok + + nDoW := Dow( dDate ) + nDay := Day( dDate ) + nMonth := Month( dDate ) + nYear := Year( dDate ) + cErrorMsg := t_cErrorMsg + + cError := "[" + Left( aDays[ nDoW ], 3 ) + " " + aMonths[ nMonth ] + " " + StrZero( nDay, 2 ) + " " + ; + PadL( LTrim( cTime ), 8, "0" ) + " " + StrZero( nYear, 4 ) + "] [error] [client " + _SERVER["REMOTE_ADDR"] + "] " + ; + cErrorMsg + HB_OSNewLine() + + //hb_ToOutDebug( "ErrorLog = %s \n\r", cError ) + + FWRITE( s_hfileLogError, cError ) + ENDIF + + hb_mutexUnlock( s_hmtxLog ) + ENDIF + +RETURN + +INIT PROCEDURE SocketInit() +#ifdef USE_HB_INET + hb_InetInit() +#else + IF socket_init() != 0 + ? "socket_init() error" + ENDIF +#endif +RETURN + + +EXIT PROCEDURE Socketxit() +#ifdef USE_HB_INET + hb_InetCleanup() +#else + socket_exit() +#endif +RETURN + + +/******************************************************************** + Public helper functions +********************************************************************/ +STATIC FUNCTION split( cSeparator, cString, nMax ) + LOCAL aRet := {}, nI + LOCAL nIter := 0 + + DEFAULT nMax TO 0 + + DO WHILE ( nI := AT( cSeparator, cString ) ) > 0 + AADD( aRet, LEFT( cString, nI - 1 ) ) + cString := SUBSTR( cString, nI + LEN( cSeparator ) ) + IF nMax > 0 .AND. ++nIter >= nMax + EXIT + ENDIF + ENDDO + AADD( aRet, cString ) +RETURN aRet + +STATIC FUNCTION join( cSeparator, aData ) +LOCAL cRet := "", nI + + FOR nI := 1 TO LEN( aData ) + IF nI > 1; cRet += cSeparator + ENDIF + IF VALTYPE(aData[nI]) $ "CM"; cRet += aData[nI] + ELSEIF VALTYPE(aData[nI]) == "N"; cRet += LTRIM(STR(aData[nI])) + ELSEIF VALTYPE(aData[nI]) == "D"; cRet += IF(!EMPTY(aData[nI]), DTOC(aData[nI]), "") + ELSE + ENDIF + NEXT +RETURN cRet + + +FUNCTION uOSFileName( cFileName ) + IF HB_OSPathSeparator() != "/" + RETURN STRTRAN( cFileName, "/", HB_OSPathSeparator() ) + ENDIF +RETURN cFileName + +PROCEDURE uSetStatusCode(nStatusCode) + t_nStatusCode := nStatusCode +RETURN + + +PROCEDURE uAddHeader( cType, cValue ) +LOCAL nI + + IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 + t_aHeader[ nI, 2 ] := cValue + ELSE + AADD( t_aHeader, { cType, cValue } ) + ENDIF +RETURN + + +FUNCTION uGetHeader( cType ) +LOCAL nI + + IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 + RETURN t_aHeader[ nI, 2 ] + ENDIF +RETURN NIL + + +PROCEDURE uWrite( cString ) + t_cResult += cString +RETURN + +#define XP_SUCCESS 0 + +STATIC PROCEDURE uproc_default() +LOCAL cFileName, nI, cI +LOCAL cExt, xResult, pHRB, oError + + //cFileName := STRTRAN(cRoot + _SERVER["SCRIPT_NAME"], "//", "/") + cFileName := _SERVER[ "SCRIPT_FILENAME" ] + + //hb_ToOutDebug( "cFileName = %s, uOSFileName( cFileName ) = %s,\n\r _SERVER = %s\n\r", cFileName, uOSFileName( cFileName ), hb_ValToExp( _SERVER ) ) + + // Security + IF ".." $ cFileName + uSetStatusCode( 403 ) + t_cErrorMsg := "Characters not allowed" + RETURN + ENDIF + + IF HB_HHasKey( s_hFileAliases, _SERVER[ "SCRIPT_NAME" ] ) + cFileName := _SERVER[ "DOCUMENT_ROOT" ] + hb_hGet( s_hFileAliases, _SERVER[ "SCRIPT_NAME" ] ) + ENDIF + + IF Upper( _SERVER[ "SCRIPT_NAME" ] ) == "/SERVERSTATUS" + ShowServerStatus() + ELSEIF HB_FileExists( uOSFileName( cFileName ) ) + IF ( nI := RAT( ".", cFileName ) ) > 0 + SWITCH ( cExt := LOWER( SUBSTR( cFileName, nI + 1 ) ) ) + CASE "hrb" ; cI := "text/html"; EXIT + CASE "css" ; cI := "text/css"; EXIT + CASE "htm" ; CASE "html"; cI := "text/html"; EXIT + CASE "txt" ; CASE "text"; CASE "asc" + CASE "c" ; CASE "h"; CASE "cpp" + CASE "hpp" ; CASE "log"; cI := "text/plain"; EXIT + CASE "rtf" ; cI := "text/rtf"; EXIT + CASE "xml" ; cI := "text/xml"; EXIT + CASE "xsl" ; cI := "text/xsl"; EXIT + CASE "bmp" ; cI := "image/bmp"; EXIT + CASE "gif" ; cI := "image/gif"; EXIT + CASE "jpg" ; CASE "jpe"; CASE "jpeg"; cI := "image/jpeg"; EXIT + CASE "png" ; cI := "image/png"; EXIT + CASE "tif" ; CASE "tiff"; cI := "image/tiff"; EXIT + CASE "djv" ; CASE "djvu"; cI := "image/vnd.djvu"; EXIT + CASE "ico" ; cI := "image/x-icon"; EXIT + CASE "xls" ; cI := "application/excel"; EXIT + CASE "doc" ; cI := "application/msword"; EXIT + CASE "pdf" ; cI := "application/pdf"; EXIT + CASE "ps" ; CASE "eps"; cI := "application/postscript"; EXIT + CASE "ppt" ; cI := "application/powerpoint"; EXIT + CASE "bz2" ; cI := "application/x-bzip2"; EXIT + CASE "gz" ; cI := "application/x-gzip"; EXIT + CASE "tgz" ; cI := "application/x-gtar"; EXIT + CASE "js" ; cI := "application/x-javascript"; EXIT + CASE "tar" ; cI := "application/x-tar"; EXIT + CASE "tex" ; cI := "application/x-tex"; EXIT + CASE "zip" ; cI := "application/zip"; EXIT + CASE "midi"; cI := "audio/midi"; EXIT + CASE "mp3" ; cI := "audio/mpeg"; EXIT + CASE "wav" ; cI := "audio/x-wav"; EXIT + CASE "qt" ; CASE "mov"; cI := "video/quicktime"; EXIT + CASE "avi" ; cI := "video/x-msvideo"; EXIT + OTHERWISE + cI := "application/octet-stream" + ENDSWITCH + + IF cExt == "hrb" + + // Starting HRB module + + TRY + IF hb_mutexLock( s_hmtxHRB ) + IF !EMPTY( pHRB := __HRBLOAD( uOSFileName(cFileName) ) ) + + xResult := HRBMAIN() + + __HRBUNLOAD( pHRB ) + + ENDIF + hb_mutexUnlock( s_hmtxHRB ) + ENDIF + + IF HB_ISSTRING( xResult ) + uAddHeader( "Content-Type", cI ) + uWrite( xResult ) + ELSE + // Application in HRB module is responsible to send HTML content + ENDIF + + CATCH oError + + WriteToConsole( "Error!" ) + + uAddHeader( "Content-Type", "text/html" ) + uWrite( "Error" ) + uWrite( "
Description: " + hb_cStr( oError:Description ) ) + uWrite( "
Filename: " + hb_cStr( oError:filename ) ) + uWrite( "
Operation: " + hb_cStr( oError:operation ) ) + uWrite( "
OsCode: " + hb_cStr( oError:osCode ) ) + uWrite( "
GenCode: " + hb_cStr( oError:genCode ) ) + uWrite( "
SubCode: " + hb_cStr( oError:subCode ) ) + uWrite( "
SubSystem: " + hb_cStr( oError:subSystem ) ) + uWrite( "
Args: " + hb_cStr( hb_ValToExp( oError:args ) ) ) + uWrite( "
ProcName: " + hb_cStr( procname( 0 ) ) ) + uWrite( "
ProcLine: " + hb_cStr( procline( 0 ) ) ) + END + + + ELSE + uAddHeader( "Content-Type", cI ) + uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) + ENDIF + + ELSE + cI := "application/octet-stream" + uAddHeader( "Content-Type", cI ) + uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) + ENDIF + + ELSEIF HB_DirExists( uOSFileName( cFileName ) ) + IF RIGHT( cFileName, 1 ) != "/" + uAddHeader( "Location", "http://" + _SERVER[ "HTTP_HOST" ] + _SERVER[ "SCRIPT_NAME" ] + "/" ) + RETURN + ENDIF + IF ASCAN( { "index.html", "index.htm" }, ; + {|x| IIF( HB_FileExists( uOSFileName( cFileName + X ) ), ( cFileName += X, .T. ), .F. ) } ) > 0 + uAddHeader( "Content-Type", "text/html" ) + uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) + RETURN + ENDIF + + // If I'm here it's means that I have no page, so, if it is defined, I will display content folder + IF !s_lIndexes + uSetStatusCode( 403 ) + t_cErrorMsg := "Display file list not allowed" + RETURN + ENDIF + + // ----------------------- display folder content ------------------------------------- + ShowFolder( cFileName ) + + ELSE + uSetStatusCode( 404 ) + t_cErrorMsg := "File does not exist: " + cFileName + ENDIF +RETURN + +// Define environment SET variables - TODO: Actually only for windows, make multiplatform +STATIC PROCEDURE Define_Env( hmServer ) + LOCAL v + + FOR EACH v IN hmServer + WIN_SETENV( v:__enumKey(), v:__enumValue() ) + NEXT + +RETURN + +// ------------------------------- DEFAULT PAGES ----------------------------------- + +STATIC PROCEDURE ShowServerStatus() + + uAddHeader( "Content-Type", "text/html" ) + uWrite( '' ) + uWrite( '' ) + uWrite( 'Server Status

Server Status

')
+   //uWrite( '')
+
+   uWrite( 'SERVER: ' + _SERVER[ "SERVER_SOFTWARE" ] + " Server at " + _SERVER[ "SERVER_NAME" ] + " Port " + LTrim( Str( _SERVER[ "SERVER_PORT" ] ) ) )
+   uWrite( '
' )
+   IF hb_mutexLock( s_hmtxBusy )
+      uWrite( '
Thread: ' + Str( s_nThreads ) )
+      uWrite( '
Connections: ' + Str( s_nConnections ) )
+      uWrite( '
Max Connections: ' + Str( s_nMaxConnections ) )
+      uWrite( '
Total Connections: ' + Str( s_nTotConnections ) )
+      uWrite( '
Running Thread: ' + hb_ValToExp( s_aRunningThreads ) )
+
+      uWrite( '
Service Thread: ' + Str( s_nServiceThreads ) )
+      uWrite( '
Service Connections: ' + Str( s_nServiceConnections ) )
+      uWrite( '
Max Service Connections: ' + Str( s_nMaxServiceConnections ) )
+      uWrite( '
Total Service Connections: ' + Str( s_nTotServiceConnections ) )
+      uWrite( '
Service Thread: ' + hb_ValToExp( s_aServiceThreads ) )
+      hb_mutexUnlock( s_hmtxBusy )
+   ENDIF
+   uWrite( '
Time: ' + Time() )
+
+   //uWrite( '
')
+   uWrite( "
" ) + +RETURN + +STATIC PROCEDURE ShowFolder( cDir ) + LOCAL aDir, aF + LOCAL cParentDir, nPos + + uAddHeader( "Content-Type", "text/html" ) + + aDir := DIRECTORY( uOSFileName( cDir ), "D" ) + IF HB_HHasKey( _GET, "s" ) + IF _GET[ "s" ] == "s" + ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ; + IIF( Y[ 5 ] == "D", .F., X[ 2 ] < Y[ 2 ] ) ) } ) + ELSEIF _GET[ "s" ] == "m" + ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T.), ; + IIF( Y[ 5 ] == "D", .F., DTOS( X[ 3 ] ) + X[ 4 ] < DTOS( Y[ 3 ] ) + Y[ 4 ] ) ) } ) + ELSE + ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ; + IIF( Y[ 5 ] == "D", .F., X[ 1 ] < Y[ 1 ] ) ) } ) + ENDIF + ELSE + ASORT( aDir,,, {|X,Y| IIF( X[ 5 ] == "D", IIF( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ; + IIF( Y[ 5 ] == "D", .F., X[ 1 ] < Y[ 1 ] ) ) } ) + ENDIF + + uWrite( '

Index of ' + _SERVER[ "SCRIPT_NAME" ] + '

      ')
+   uWrite( 'Name                                                  ')
+   uWrite( 'Modified             ' )
+   uWrite( 'Size' + CR_LF + '
' )
+
+   // Adding Upper Directory
+   nPos := RAT( "/", SUBSTR( cDir, 1, Len( cDir ) - 1 ) )
+   cParentDir := SUBSTR( cDir, 1, nPos )
+   cParentDir := SUBSTR( cParentDir, Len( _SERVER[ "DOCUMENT_ROOT" ] ) + 1 )
+
+   //hb_ToOutDebug( "cDir = %s, nPos = %i, cParentDir = %s\n\r", cDir, nPos, cParentDir )
+
+   IF !Empty( cParentDir )
+      // Add parent directory
+      hb_aIns( aDir, 1, { "", 0, "", "", "D" }, .T. )
+   ENDIF
+
+   FOR EACH aF IN aDir
+       IF aF[ 1 ] == ""
+          uWrite( '[DIR] ..' + ;
+                  CR_LF )
+       ELSEIF LEFT( aF[ 1 ], 1 ) == "."
+       ELSEIF "D" $ aF[ 5 ]
+          uWrite( '[DIR] '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
+                  DTOC( aF[ 3 ] ) + ' ' + aF[ 4 ] + CR_LF )
+       ELSE
+          uWrite( '      '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
+                  DTOC( aF[ 3 ]) + ' ' + aF[ 4 ] + STR( aF[ 2 ], 12 ) + CR_LF )
+       ENDIF
+   NEXT
+   uWrite( "
" ) + +RETURN + +// ------------------------------- Utility functions -------------------------------- + +STATIC PROCEDURE Help() + //LOCAL cPrg := hb_argv( 0 ) + //LOCAL nPos := RAt( "\", cPrg ) + //__OutDebug( hb_argv(0) ) + //IF nPos > 0 + // cPrg := SubStr( cPrg, nPos + 1 ) + //ENDIF + ? + ? "(C) 2009 Francesco Saverio Giudice " + ? + ? APP_NAME + " - web server - v. " + APP_VERSION + ? "Based on original work of Mindaugas Kavaliauskas " + ? + ? "Parameters: (all optionals)" + ? + ? "-p | --port webserver tcp port (default: " + LTrim( Str( LISTEN_PORT ) ) + ")" + ? "-c | --config Configuration file (default: " + APP_NAME + ".ini)" + ? " It is possibile to define file path" + ? "-d | --docroot Document root directory (default: \home)" + ? "-i | --indexes Allow directory view (default: no)" + ? "-s | --stop Stop webserver" + ? "-ts | --start-threads Define starting threads (default: " + LTrim( Str( START_RUNNING_THREADS ) ) + ")" + ? "-tm | --max-threads Define max threads (default: " + LTrim( Str( MAX_RUNNING_THREADS ) ) + ")" + ? "-h | -? | --help This help message" + ? + WAIT +RETURN + +STATIC PROCEDURE SysSettings() + SET SCOREBOARD OFF + SET CENTURY ON + SET DATE ITALIAN + SET BELL OFF + SET DELETED ON + SET EXACT OFF + SET CONFIRM ON + SET ESCAPE ON + SET WRAP ON + SET EPOCH TO 2000 + //RDDSetDefault( "DBFCDX" ) +RETURN + +STATIC FUNCTION Exe_Path() + LOCAL cPath := hb_argv( 0 ) + LOCAL nPos := RAt( "\", cPath ) + IF nPos == 0 + cPath := "" + ELSE + cPath := SubStr( cPath, 1, nPos-1 ) + ENDIF +RETURN cPath + +STATIC FUNCTION Exe_Name() + LOCAL cPrg := hb_argv( 0 ) + LOCAL nPos := RAt( "\", cPrg ) + IF nPos > 0 + cPrg := SubStr( cPrg, nPos+1 ) + ENDIF +RETURN cPrg + +STATIC PROCEDURE Progress( nProgress ) + LOCAL cString := "[" + + DO CASE + CASE nProgress == 0 + cString += "-" + CASE nProgress == 1 + cString += "\" + CASE nProgress == 2 + cString += "|" + CASE nProgress == 3 + cString += "/" + ENDCASE + + cString += "]" + + nProgress++ + + IF nProgress == 4 + nProgress := 0 + ENDIF + + // using hb_dispOutAt() to avoid MT screen updates problem + hb_dispOutAt( 10, 5, cString ) + hb_dispOutAt( 0, 60, "Time: " + Time() ) + +RETURN + +// Show messages in console +#define CONSOLE_FIRSTROW 12 +#define CONSOLE_LASTROW MaxRow() +STATIC PROCEDURE WriteToConsole( ... ) + LOCAL cMsg + + IF hb_mutexLock( s_hmtxConsole ) + IF s_lConsole + + FOR EACH cMsg IN hb_aParams() + + hb_Scroll( CONSOLE_FIRSTROW, 0, CONSOLE_LASTROW, MaxCol(), -1 ) + hb_DispOutAt( CONSOLE_FIRSTROW, 0, PadR( "> " + hb_cStr( cMsg ), MaxCol() ) ) + +#ifdef DEBUG_ACTIVE + hb_ToOutDebug( ">>> %s\n\r", cMsg ) +#endif + + NEXT + + ENDIF + hb_mutexUnlock( s_hmtxConsole ) + ENDIF + +RETURN + +STATIC FUNCTION ParseIni( cConfig ) + LOCAL hIni := HB_ReadIni( cConfig ) + LOCAL cSection, hSect, cKey, xVal, cVal + LOCAL hDefault + + // Define here what attributes I can have in ini config file and their defaults + hDefault := { ; + "MAIN" => { ; + "Port" => LISTEN_PORT ,; + "Document_root" => EXE_Path() + "\home" ,; + "Show_indexes" => FALSE ; + },; + "LOGFILES" => { ; + "access" => FILE_ACCESS_LOG ,; + "error" => FILE_ERROR_LOG ; + },; + "THREADS" => { ; + "Max_Wait" => THREAD_MAX_WAIT ,; + "start_num" => START_RUNNING_THREADS ,; + "max_num" => MAX_RUNNING_THREADS ; + },; + "ALIASES" => { => } ; + } + + // Now read changes from ini file and modify only admited keys + IF !Empty( hIni ) + FOR EACH cSection IN hIni:Keys + + IF cSection $ hDefault + + hSect := hIni[ cSection ] + + IF HB_IsHash( hSect ) + FOR EACH cKey IN hSect:Keys + IF cSection == "ALIASES" + xVal := hSect[ cKey ] + IF xVal <> NIL + hDefault[ cSection ][ cKey ] := xVal + ENDIF + ELSEIF cKey $ hDefault[ cSection ] + cVal := hSect[ cKey ] + + DO CASE + CASE cSection == "MAIN" + DO CASE + CASE cKey == "Port" + xVal := Val( cVal ) + CASE cKey == "Document_root" + IF !Empty( cVal ) + // Change APP_DIR macro with current exe path + xVal := StrTran( cVal, "$(APP_DIR)", Exe_Path() ) + ENDIF + ENDCASE + CASE cSection == "LOGFILES" + DO CASE + CASE cKey == "access" + xVal := cVal + CASE cKey == "error" + xVal := cVal + ENDCASE + CASE cSection == "THREADS" + DO CASE + CASE cKey == "Max_Wait" + xVal := Val( cVal ) + CASE cKey == "start_num" + xVal := Val( cVal ) + CASE cKey == "max_num" + xVal := Val( cVal ) + ENDCASE + ENDCASE + IF xVal <> NIL + hDefault[ cSection ][ cKey ] := xVal + ENDIF + ENDIF + NEXT + ENDIF + ENDIF + NEXT + ENDIF + + RETURN hDefault + + + +//------------------------------------------------------------------------------ +// FUNZIONI C +//------------------------------------------------------------------------------ +#PRAGMA BEGINDUMP + +#ifdef __WIN32__ + +#include +#include "hbapi.h" +#include "hbvm.h" + +BOOL win_SysRefresh( int iMsec ) +{ + int iQuit = (int) FALSE; + + HANDLE hDummyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + + // Begin the operation and continue until it is complete + // or until the user clicks the mouse or presses a key. + + while (MsgWaitForMultipleObjects(1, &hDummyEvent, FALSE, ( iMsec == 0, INFINITE, iMsec ), QS_ALLINPUT | QS_ALLPOSTMESSAGE) == WAIT_OBJECT_0 + 1) + { + MSG msg; + + while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) + { + + switch(msg.message) + { + case WM_QUIT: + { + iQuit = (int) msg.wParam; + goto stopLoop; + } + //case WM_LBUTTONDOWN: + //case WM_RBUTTONDOWN: + //case WM_KEYDOWN: + //case WM_LBUTTONUP: + //case WM_RBUTTONUP: + //case WM_KEYUP: + // // + // // Perform any required cleanup. + // // + // break; + // //exit; + // + default: + TranslateMessage(&msg); + DispatchMessage(&msg); + } + + } + if (!iQuit) + { + goto stopLoop; + } + } + +stopLoop: + + CloseHandle( hDummyEvent ); + + return iQuit; + +} + +HB_FUNC_STATIC( WIN_SYSREFRESH ) +{ + hb_retl( win_SysRefresh( ( ISNIL( 1 ) ? 0 : hb_parni( 1 ) ) ) ); +} + +HB_FUNC_STATIC( WIN_SETENV ) +{ + hb_retl( SetEnvironmentVariable( hb_parc( 1 ), hb_parc( 2 ) ) ); +} + +HB_FUNC_STATIC( WIN_TIMEZONEBIAS ) +{ + TIME_ZONE_INFORMATION tzInfo; + //LONG lBias; + int nLen; + char *szRet = (char *) hb_xgrab( 6 ); + + if ( GetTimeZoneInformation( &tzInfo ) == TIME_ZONE_ID_INVALID ) + { + tzInfo.Bias = 0; + } + else + { + tzInfo.Bias = -tzInfo.Bias; + } + + hb_snprintf( szRet, 6, "%+03d%02d", + (int)( tzInfo.Bias / 60 ), + (int)( tzInfo.Bias % 60 > 0 ? - tzInfo.Bias % 60 : tzInfo.Bias % 60 ) ); + + nLen = strlen( szRet ); + + if ( nLen < 6 ) + { + szRet = (char *) hb_xrealloc( szRet, nLen + 1 ); + } + hb_retclen_buffer( szRet, nLen ); + +} + +#endif +#PRAGMA ENDDUMP diff --git a/harbour/contrib/hbssl/Makefile b/harbour/contrib/hbssl/Makefile new file mode 100644 index 0000000000..13e130374c --- /dev/null +++ b/harbour/contrib/hbssl/Makefile @@ -0,0 +1,44 @@ +# +# $Id$ +# + +ROOT = ../../ + +LIBNAME=hbssl + +HB_INC_OPENSSL_OK = + +ifneq ($(HB_ARCHITECTURE),dos) + +ifeq ($(HB_INC_OPENSSL),) +ifeq ($(HB_XBUILD),) +HB_INC_OPENSSL = /usr/include +endif +endif + +HB_INC_OPENSSL_OK += $(foreach d, $(HB_INC_OPENSSL), $(if $(wildcard $(d)/openssl/ssl.h),$(d),)) + +endif + +ifneq ($(strip $(HB_INC_OPENSSL_OK)),) + +C_USR += $(foreach d, $(HB_INC_OPENSSL_OK), -I$(d)) + +C_SOURCES=\ + ssl.c \ + sslctx.c \ + sslrand.c \ + +PRG_HEADERS=\ + hbssl.ch \ + +include $(TOP)$(ROOT)config/header.cf +INSTALL_RULE_HEADERS := $(INSTALL_RULE) +include $(TOP)$(ROOT)config/lib.cf + +install:: + $(INSTALL_RULE_HEADERS) + +else +include $(TOP)$(ROOT)config/none.cf +endif diff --git a/harbour/contrib/hbssl/common.mak b/harbour/contrib/hbssl/common.mak new file mode 100644 index 0000000000..4a3dfc9037 --- /dev/null +++ b/harbour/contrib/hbssl/common.mak @@ -0,0 +1,18 @@ +# +# $Id$ +# + +LIBNAME = $(LIBPREF)hbssl + +LIB_PATH = $(LIB_DIR)$(LIBNAME)$(LIBEXT) + +PRG_HEADERS = \ + hbssl.ch \ + +LIB_OBJS = \ + $(OBJ_DIR)ssl$(OBJEXT) \ + $(OBJ_DIR)sslctx$(OBJEXT) \ + $(OBJ_DIR)sslrand$(OBJEXT) \ + +all: \ + $(LIB_PATH) \ diff --git a/harbour/contrib/hbssl/hbssl.ch b/harbour/contrib/hbssl/hbssl.ch new file mode 100644 index 0000000000..47db3e8b77 --- /dev/null +++ b/harbour/contrib/hbssl/hbssl.ch @@ -0,0 +1,77 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * OpenSSL API - Harbour header. + * + * Copyright 2009 Viktor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#ifndef HBSSL_CH_ +#define HBSSL_CH_ + +/* NOTE: This file is also used by C code. */ + +#define HB_SSL_CTX_NEW_METHOD_SSLV2 0 +#define HB_SSL_CTX_NEW_METHOD_SSLV2_SERVER 1 +#define HB_SSL_CTX_NEW_METHOD_SSLV2_CLIENT 2 +#define HB_SSL_CTX_NEW_METHOD_SSLV3 3 +#define HB_SSL_CTX_NEW_METHOD_SSLV3_SERVER 4 +#define HB_SSL_CTX_NEW_METHOD_SSLV3_CLIENT 5 +#define HB_SSL_CTX_NEW_METHOD_TLSV1 6 +#define HB_SSL_CTX_NEW_METHOD_TLSV1_SERVER 7 +#define HB_SSL_CTX_NEW_METHOD_TLSV1_CLIENT 8 +#define HB_SSL_CTX_NEW_METHOD_SSLV23 9 +#define HB_SSL_CTX_NEW_METHOD_SSLV23_SERVER 10 +#define HB_SSL_CTX_NEW_METHOD_SSLV23_CLIENT 11 + +#define HB_SSLEAY_VERSION 0 +#define HB_SSLEAY_CFLAGS 1 +#define HB_SSLEAY_BUILT_ON 2 +#define HB_SSLEAY_PLATFORM 3 +#define HB_SSLEAY_DIR 4 + +#endif /* HBSSL_CH_ */ diff --git a/harbour/contrib/hbssl/hbssl.h b/harbour/contrib/hbssl/hbssl.h new file mode 100644 index 0000000000..2d8746cb6a --- /dev/null +++ b/harbour/contrib/hbssl/hbssl.h @@ -0,0 +1,66 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * OpenSSL API - C header. + * + * Copyright 2009 Viktor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#ifndef HBSSL_H_ +#define HBSSL_H_ + +#include + +#include "hbssl.ch" + +extern void * hb_SSL_CTX_is( int iParam ); +extern SSL_CTX * hb_SSL_CTX_par( int iParam ); + +extern void * hb_SSL_is( int iParam ); +extern SSL * hb_SSL_par( int iParam ); + +#endif /* HBSSL_H_ */ diff --git a/harbour/contrib/hbssl/make_b32.bat b/harbour/contrib/hbssl/make_b32.bat new file mode 100644 index 0000000000..6b03f21971 --- /dev/null +++ b/harbour/contrib/hbssl/make_b32.bat @@ -0,0 +1,81 @@ +@echo off +rem +rem $Id$ +rem + +if not "%HB_INC_OPENSSL%%HB_DIR_OPENSSL%" == "" goto DIR_OK + +echo --------------------------------------------------------------- +echo IMPORTANT: You'll need the 'OpenSSL' package and this envvar +echo to be set to successfully build this library: +echo set HB_INC_OPENSSL=C:\openssl +echo or +echo set HB_DIR_OPENSSL=C:\openssl +echo if you want to generate .lib for the .dll. +echo --------------------------------------------------------------- +goto POST_EXIT + +:DIR_OK + +if "%HB_INC_OPENSSL%" == "" set HB_INC_OPENSSL=%HB_DIR_OPENSSL%\inc32 +set CFLAGS=-I"%HB_INC_OPENSSL%" +set _HB_DLL_NAME1=libeay32 +set _HB_DLL_NAME2=ssleay32 +if exist "%HB_DIR_OPENSSL%\out32dll\%_HB_DLL_NAME1%.dll" set _HB_DLL_DIR=%HB_DIR_OPENSSL%\out32dll +if exist "%HB_DIR_OPENSSL%\dll\%_HB_DLL_NAME1%.dll" set _HB_DLL_DIR=%HB_DIR_OPENSSL%\dll +if exist "%HB_DIR_OPENSSL%\%_HB_DLL_NAME1%.dll" set _HB_DLL_DIR=%HB_DIR_OPENSSL% + +if not "%HB_DIR_OPENSSL%" == "" echo Using .dll: "%_HB_DLL_DIR%\%_HB_DLL_NAME1%.dll" + +rem --------------------------------------------------------------- + +call ..\mtpl_b32.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 + +rem --------------------------------------------------------------- + +if "%HB_DIR_OPENSSL%" == "" goto POST_EXIT + +set _HB_INSTALL_PREFIX=%HB_INSTALL_PREFIX% +if "%_HB_INSTALL_PREFIX%" == "" set _HB_INSTALL_PREFIX=..\.. +set _HB_LIB_INSTALL=%HB_LIB_INSTALL% +if "%_HB_LIB_INSTALL%" == "" set _HB_LIB_INSTALL=%_HB_INSTALL_PREFIX%\lib + +if "%1" == "clean" goto POST_CLEAN +if "%1" == "Clean" goto POST_CLEAN +if "%1" == "CLEAN" goto POST_CLEAN +if "%1" == "install" goto POST_INSTALL +if "%1" == "Install" goto POST_INSTALL +if "%1" == "INSTALL" goto POST_INSTALL + +:POST_BUILD + + implib -a ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib "%_HB_DLL_DIR%\%_HB_DLL_NAME1%.dll" >> %_HB_MAKELOG% + implib -a ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib "%_HB_DLL_DIR%\%_HB_DLL_NAME2%.dll" >> %_HB_MAKELOG% + goto POST_EXIT + +:POST_CLEAN + + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib > nul + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.exp del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.exp > nul + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib > nul + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib > nul + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.exp del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.exp > nul + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib > nul + goto POST_EXIT + +:POST_INSTALL + + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib copy ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib %_HB_LIB_INSTALL% + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib copy ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib %_HB_LIB_INSTALL% + goto POST_EXIT + +:POST_EXIT + +set CFLAGS= +set _HB_DLL_NAME1= +set _HB_DLL_NAME2= +set _HB_DLL_DIR= +set _HB_INSTALL_PREFIX= +set _HB_LIB_INSTALL= diff --git a/harbour/contrib/hbssl/make_gcc.sh b/harbour/contrib/hbssl/make_gcc.sh new file mode 100755 index 0000000000..750c1a8c58 --- /dev/null +++ b/harbour/contrib/hbssl/make_gcc.sh @@ -0,0 +1,24 @@ +#!/bin/sh + +# +# $Id$ +# + +if [ "${HB_INC_OPENSSL}" = "" ] +then + echo "---------------------------------------------------------------" + echo "IMPORTANT: You will need the 'OpenSSL' package installed and this" + echo " envvar to be set to successfully build this library:" + echo " export HB_INC_OPENSSL=C:/openssl/inc32" + echo " or" + echo " export HB_INC_OPENSSL=/usr/include" + echo "---------------------------------------------------------------" + exit 1 +fi + +export CFLAGS="" +for I in ${HB_INC_OPENSSL}; do + CFLAGS="${CFLAGS} -I${I}" +done +../mtpl_gcc.sh $1 $2 $3 $4 $5 $6 $7 $8 $9 +unset CFLAGS diff --git a/harbour/contrib/hbssl/make_vc.bat b/harbour/contrib/hbssl/make_vc.bat new file mode 100644 index 0000000000..c4ff0f773b --- /dev/null +++ b/harbour/contrib/hbssl/make_vc.bat @@ -0,0 +1,82 @@ +@echo off +rem +rem $Id$ +rem + +if not "%HB_INC_OPENSSL%%HB_DIR_OPENSSL%" == "" goto DIR_OK + +echo --------------------------------------------------------------- +echo IMPORTANT: You'll need the 'OpenSSL' package and this envvar +echo to be set to successfully build this library: +echo set HB_INC_OPENSSL=C:\openssl +echo or +echo set HB_DIR_OPENSSL=C:\openssl +echo if you want to generate .lib for the .dll. +echo --------------------------------------------------------------- +goto POST_EXIT + +:DIR_OK + +if "%HB_INC_OPENSSL%" == "" set HB_INC_OPENSSL=%HB_DIR_OPENSSL%\inc32 +set CFLAGS=-I"%HB_INC_OPENSSL%" +set _HB_DLL_NAME1=libeay32 +set _HB_DLL_NAME2=ssleay32 +if exist "%HB_DIR_OPENSSL%\out32dll\%_HB_DLL_NAME1%.dll" set _HB_DLL_DIR=%HB_DIR_OPENSSL%\out32dll +if exist "%HB_DIR_OPENSSL%\dll\%_HB_DLL_NAME1%.dll" set _HB_DLL_DIR=%HB_DIR_OPENSSL%\dll +if exist "%HB_DIR_OPENSSL%\%_HB_DLL_NAME1%.dll" set _HB_DLL_DIR=%HB_DIR_OPENSSL% + +if not "%HB_DIR_OPENSSL%" == "" echo Using .dll: "%_HB_DLL_DIR%\%_HB_DLL_NAME1%.dll" + +rem --------------------------------------------------------------- + +call ..\mtpl_vc.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 + +rem --------------------------------------------------------------- + +if "%HB_DIR_OPENSSL%" == "" goto POST_EXIT + +set _HB_INSTALL_PREFIX=%HB_INSTALL_PREFIX% +if "%_HB_INSTALL_PREFIX%" == "" set _HB_INSTALL_PREFIX=..\.. +set _HB_LIB_INSTALL=%HB_LIB_INSTALL% +if "%_HB_LIB_INSTALL%" == "" set _HB_LIB_INSTALL=%_HB_INSTALL_PREFIX%\lib + +if "%1" == "clean" goto POST_CLEAN +if "%1" == "Clean" goto POST_CLEAN +if "%1" == "CLEAN" goto POST_CLEAN +if "%1" == "install" goto POST_INSTALL +if "%1" == "Install" goto POST_INSTALL +if "%1" == "INSTALL" goto POST_INSTALL + +:POST_BUILD + + rem Use supplied .lib file. + if not exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib copy "%_HB_DLL_DIR%\%_HB_DLL_NAME1%.lib" ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib > nul + if not exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib copy "%_HB_DLL_DIR%\%_HB_DLL_NAME2%.lib" ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib > nul + goto POST_EXIT + +:POST_CLEAN + + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib > nul + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.exp del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.exp > nul + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib > nul + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib > nul + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.exp del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.exp > nul + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib > nul + goto POST_EXIT + +:POST_INSTALL + + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME1%.lib + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib copy ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME1%.lib %_HB_LIB_INSTALL% + if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME2%.lib + if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib copy ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME2%.lib %_HB_LIB_INSTALL% + goto POST_EXIT + +:POST_EXIT + +set CFLAGS= +set _HB_DLL_NAME1= +set _HB_DLL_NAME2= +set _HB_DLL_DIR= +set _HB_INSTALL_PREFIX= +set _HB_LIB_INSTALL= diff --git a/harbour/contrib/hbssl/ssl.c b/harbour/contrib/hbssl/ssl.c new file mode 100644 index 0000000000..7168c1a839 --- /dev/null +++ b/harbour/contrib/hbssl/ssl.c @@ -0,0 +1,440 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * OpenSSL API (SSL) - Harbour interface. + * + * Copyright 2009 Viktor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbapi.h" +#include "hbapierr.h" +#include "hbapiitm.h" + +#include "hbssl.h" + +static HB_GARBAGE_FUNC( SSL_release ) +{ + void ** ph = ( void ** ) Cargo; + + /* Check if pointer is not NULL to avoid multiple freeing */ + if( ph && * ph ) + { + /* Destroy the object */ + SSL_free( ( SSL * ) * ph ); + + /* set pointer to NULL just in case */ + * ph = NULL; + } +} + +void * hb_SSL_is( int iParam ) +{ + return hb_parptrGC( SSL_release, iParam ); +} + +SSL * hb_SSL_par( int iParam ) +{ + void ** ph = ( void ** ) hb_parptrGC( SSL_release, iParam ); + + return ph ? ( SSL * ) * ph : NULL; +} + +HB_FUNC( SSL_NEW ) +{ + if( hb_SSL_CTX_is( 1 ) ) + { + SSL_CTX * ctx = hb_SSL_CTX_par( 1 ); + + if( ctx ) + { + void ** ph = ( void ** ) hb_gcAlloc( sizeof( SSL * ), SSL_release ); + + SSL * ssl = SSL_new( ctx ); + + * ph = ( void * ) ssl; + + hb_retptrGC( ph ); + } + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_DUP ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl_par = hb_SSL_par( 1 ); + + if( ssl_par ) + { + void ** ph = ( void ** ) hb_gcAlloc( sizeof( SSL * ), SSL_release ); + + SSL * ssl = SSL_dup( ssl_par ); + + * ph = ( void * ) ssl; + + hb_retptrGC( ph ); + } + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_ACCEPT ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_accept( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_CLEAR ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + SSL_clear( ssl ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_STATE ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_state( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_PENDING ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_pending( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_CONNECT ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_connect( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_SHUTDOWN ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_shutdown( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_VERSION ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_version( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_GET_VERSION ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retc( SSL_get_version( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_GET_CIPHER ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retc_const( SSL_get_cipher( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_DO_HANDSHAKE ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_do_handshake( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_RENEGOTIATE ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_renegotiate( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_SET_FD ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_set_fd( ssl, hb_parni( 2 ) ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_WANT ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_want( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_WANT_NOTHING ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_want_nothing( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_WANT_X509_LOOKUP ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_want_x509_lookup( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_WANT_READ ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_want_read( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_READ ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + { + PHB_ITEM pBuffer = hb_param( 2, HB_IT_STRING ); + int nRead; + + if( pBuffer && ISBYREF( 2 ) && ISNUM( 3 ) ) + { + nRead = hb_parni( 3 ); + + if( ( ULONG ) nRead <= hb_parcsiz( 2 ) ) + { + pBuffer = hb_itemUnShareString( pBuffer ); + + nRead = SSL_read( ssl, ( void * ) hb_itemGetCPtr( pBuffer ), nRead ); + } + else + nRead = 0; + } + else + nRead = 0; + + hb_retni( nRead ); + } + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_PEEK ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + { + PHB_ITEM pBuffer = hb_param( 2, HB_IT_STRING ); + int nRead; + + if( pBuffer && ISBYREF( 2 ) && ISNUM( 3 ) ) + { + nRead = hb_parni( 3 ); + + if( ( ULONG ) nRead <= hb_parcsiz( 2 ) ) + { + pBuffer = hb_itemUnShareString( pBuffer ); + + nRead = SSL_peek( ssl, ( void * ) hb_itemGetCPtr( pBuffer ), nRead ); + } + else + nRead = 0; + } + else + nRead = 0; + + hb_retni( nRead ); + } + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_WANT_WRITE ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + hb_retni( SSL_want_write( ssl ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_WRITE ) +{ + if( hb_SSL_is( 1 ) ) + { + SSL * ssl = hb_SSL_par( 1 ); + + if( ssl ) + { + PHB_ITEM pBuffer = hb_param( 2, HB_IT_STRING ); + ULONG nLen = hb_itemGetCLen( pBuffer ); + + if( ISNUM( 3 ) ) + { + ULONG nWrite = ( ULONG ) hb_parnl( 3 ); + if( nWrite < nLen ) + nLen = nWrite; + } + + hb_retni( SSL_read( ssl, ( void * ) hb_itemGetCPtr( pBuffer ), ( int ) nLen ) ); + } + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} diff --git a/harbour/contrib/hbssl/sslctx.c b/harbour/contrib/hbssl/sslctx.c new file mode 100644 index 0000000000..a727de0838 --- /dev/null +++ b/harbour/contrib/hbssl/sslctx.c @@ -0,0 +1,193 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * OpenSSL API (SSL_CTX) - Harbour interface. + * + * Copyright 2009 Viktor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbapi.h" +#include "hbapierr.h" + +#include "hbssl.h" + +HB_FUNC( SSL_INIT ) +{ + SSL_load_error_strings(); + SSL_library_init(); +} + +HB_FUNC( SSLEAY_VERSION ) +{ + int value = hb_parni( 1 ); + + switch( value ) + { + case HB_SSLEAY_VERSION : value = SSLEAY_VERSION; break; + case HB_SSLEAY_CFLAGS : value = SSLEAY_CFLAGS; break; + case HB_SSLEAY_BUILT_ON : value = SSLEAY_BUILT_ON; break; + case HB_SSLEAY_PLATFORM : value = SSLEAY_PLATFORM; break; + case HB_SSLEAY_DIR : value = SSLEAY_DIR; break; + } + + hb_retc_const( SSLeay_version( value ) ); +} + +static HB_GARBAGE_FUNC( SSL_CTX_release ) +{ + void ** ph = ( void ** ) Cargo; + + /* Check if pointer is not NULL to avoid multiple freeing */ + if( ph && * ph ) + { + /* Destroy the object */ + SSL_CTX_free( ( SSL_CTX * ) * ph ); + + /* set pointer to NULL just in case */ + * ph = NULL; + } +} + +void * hb_SSL_CTX_is( int iParam ) +{ + return hb_parptrGC( SSL_CTX_release, iParam ); +} + +SSL_CTX * hb_SSL_CTX_par( int iParam ) +{ + void ** ph = ( void ** ) hb_parptrGC( SSL_CTX_release, iParam ); + + return ph ? ( SSL_CTX * ) * ph : NULL; +} + +HB_FUNC( SSL_CTX_NEW ) +{ + void ** ph = ( void ** ) hb_gcAlloc( sizeof( SSL_CTX * ), SSL_CTX_release ); + + SSL_CTX * ctx; + SSL_METHOD * method; + + switch( hb_parni( 1 ) ) + { + case HB_SSL_CTX_NEW_METHOD_SSLV2 : method = SSLv2_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV2_SERVER : method = SSLv2_server_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV2_CLIENT : method = SSLv2_client_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV3 : method = SSLv3_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV3_SERVER : method = SSLv3_server_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV3_CLIENT : method = SSLv3_client_method(); break; + case HB_SSL_CTX_NEW_METHOD_TLSV1 : method = TLSv1_method(); break; + case HB_SSL_CTX_NEW_METHOD_TLSV1_SERVER : method = TLSv1_server_method(); break; + case HB_SSL_CTX_NEW_METHOD_TLSV1_CLIENT : method = TLSv1_client_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV23 : method = SSLv23_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV23_SERVER : method = SSLv23_server_method(); break; + case HB_SSL_CTX_NEW_METHOD_SSLV23_CLIENT : method = SSLv23_client_method(); break; + default : method = SSLv23_method(); + } + + ctx = SSL_CTX_new( method ); + + * ph = ( void * ) ctx; + + hb_retptrGC( ph ); +} + +HB_FUNC( SSL_CTX_FLUSH_SESSIONS ) +{ + if( hb_SSL_CTX_is( 1 ) ) + { + SSL_CTX * ctx = hb_SSL_CTX_par( 1 ); + + if( ctx ) + SSL_CTX_flush_sessions( ctx, hb_parnl( 2 ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_CTX_GET_TIMEOUT ) +{ + if( hb_SSL_CTX_is( 1 ) ) + { + SSL_CTX * ctx = hb_SSL_CTX_par( 1 ); + + if( ctx ) + hb_retnl( SSL_CTX_get_timeout( ctx ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_CTX_SET_TIMEOUT ) +{ + if( hb_SSL_CTX_is( 1 ) ) + { + SSL_CTX * ctx = hb_SSL_CTX_par( 1 ); + + if( ctx ) + SSL_CTX_set_timeout( ctx, hb_parnl( 2 ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( SSL_CTX_SET_CIPHER_LIST ) +{ + if( hb_SSL_CTX_is( 1 ) ) + { + SSL_CTX * ctx = hb_SSL_CTX_par( 1 ); + + if( ctx ) + SSL_CTX_set_cipher_list( ctx, hb_parcx( 2 ) ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} + +/* +X509_STORE *SSL_CTX_get_cert_store(const SSL_CTX *); +void SSL_CTX_set_cert_store(SSL_CTX *,X509_STORE *); +*/ diff --git a/harbour/contrib/hbssl/sslrand.c b/harbour/contrib/hbssl/sslrand.c new file mode 100644 index 0000000000..f8be44e22f --- /dev/null +++ b/harbour/contrib/hbssl/sslrand.c @@ -0,0 +1,89 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * OpenSSL API (RAND) - Harbour interface. + * + * Copyright 2009 Viktor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#define HB_OS_WIN_32_USED + +#include "hbapi.h" +#include "hbapierr.h" + +#include + +HB_FUNC( SSL_RAND_SEED ) +{ + RAND_seed( hb_parcx( 1 ), hb_parclen( 1 ) ); +} + +HB_FUNC( SSL_RAND_ADD ) +{ + RAND_add( hb_parcx( 1 ), hb_parclen( 1 ), hb_parnd( 2 ) ); +} + +HB_FUNC( SSL_RAND_STATUS ) +{ + hb_retni( RAND_status() ); +} + +HB_FUNC( SSL_RAND_EVENT ) +{ +#if defined( HB_OS_WIN_32 ) + hb_retni( RAND_event( hb_parni( 1 ), ( WPARAM ) hb_parnint( 2 ), ( LPARAM ) hb_parnint( 3 ) ) ); +#else + hb_retni( 0 ); +#endif +} + +HB_FUNC( SSL_RAND_SCREEN ) +{ +#if defined( HB_OS_WIN_32 ) + RAND_screen(); +#endif +} diff --git a/harbour/contrib/hbssl/tests/hbmk_b32.bat b/harbour/contrib/hbssl/tests/hbmk_b32.bat new file mode 100644 index 0000000000..644b77f6ce --- /dev/null +++ b/harbour/contrib/hbssl/tests/hbmk_b32.bat @@ -0,0 +1,14 @@ +@echo off +rem +rem $Id$ +rem + +if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\bin +if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\lib +if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\include + +set HB_ARCHITECTURE=w32 +set HB_COMPILER=bcc32 +set HB_USER_LIBS=hbssl.lib libeay32.lib ssleay32.lib + +call %HB_BIN_INSTALL%\hbmk.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 diff --git a/harbour/contrib/hbssl/tests/hbmk_vc.bat b/harbour/contrib/hbssl/tests/hbmk_vc.bat new file mode 100644 index 0000000000..8cf259794d --- /dev/null +++ b/harbour/contrib/hbssl/tests/hbmk_vc.bat @@ -0,0 +1,14 @@ +@echo off +rem +rem $Id$ +rem + +if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\bin +if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\lib +if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\include + +set HB_ARCHITECTURE=w32 +set HB_COMPILER=msvc +set HB_USER_LIBS=hbssl.lib libeay32.lib ssleay32.lib + +call %HB_BIN_INSTALL%\hbmk.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 diff --git a/harbour/contrib/hbssl/tests/test.prg b/harbour/contrib/hbssl/tests/test.prg new file mode 100644 index 0000000000..84cad7d592 --- /dev/null +++ b/harbour/contrib/hbssl/tests/test.prg @@ -0,0 +1,37 @@ +/* + * $Id$ + */ + +/* + * Copyright 2009 Viktor Szakats + * www - http://www.harbour-project.org + */ + +#include "hbssl.ch" + +PROCEDURE Main() + LOCAL ssl_ctx + LOCAL ssl + + SSL_INIT() + + ? SSLEAY_VERSION() + ? SSLEAY_VERSION( HB_SSLEAY_VERSION ) + ? SSLEAY_VERSION( HB_SSLEAY_CFLAGS ) + ? SSLEAY_VERSION( HB_SSLEAY_BUILT_ON ) + ? SSLEAY_VERSION( HB_SSLEAY_PLATFORM ) + ? SSLEAY_VERSION( HB_SSLEAY_DIR ) + + SSL_RAND_seed( "some entropy" ) + + ssl_ctx := SSL_CTX_NEW() + + ? ssl_ctx + + ssl := SSL_NEW( ssl_ctx ) + + ? ssl + ? SSL_VERSION( ssl ) + ? SSL_GET_VERSION( ssl ) + + RETURN diff --git a/harbour/contrib/make_b32_all.bat b/harbour/contrib/make_b32_all.bat index fef920a2a9..00cb852f2a 100644 --- a/harbour/contrib/make_b32_all.bat +++ b/harbour/contrib/make_b32_all.bat @@ -61,6 +61,7 @@ if not "%HB_INC_GD%%HB_DIR_GD%" == "" set _HB_DIRS=%_HB_DIRS% hbgd if not "%HB_INC_LIBHARU%%HB_DIR_LIBHARU%" == "" set _HB_DIRS=%_HB_DIRS% hbhpdf if not "%HB_INC_MYSQL%%HB_DIR_MYSQL%" == "" set _HB_DIRS=%_HB_DIRS% hbmysql if not "%HB_INC_PGSQL%%HB_DIR_PGSQL%" == "" set _HB_DIRS=%_HB_DIRS% hbpgsql +if not "%HB_INC_OPENSSL%%HB_DIR_OPENSSL%" == "" set _HB_DIRS=%_HB_DIRS% hbssl if not "%HB_INC_ADS%%HB_DIR_ADS%" == "" set _HB_DIRS=%_HB_DIRS% rddads if not "%HB_INC_MYSQL%%HB_DIR_MYSQL%" == "" set _HB_DIRS=%_HB_DIRS% rddsql :OVERRIDE diff --git a/harbour/contrib/make_gcc_all.sh b/harbour/contrib/make_gcc_all.sh index 0a69dea9a9..5cfdd45dc2 100755 --- a/harbour/contrib/make_gcc_all.sh +++ b/harbour/contrib/make_gcc_all.sh @@ -59,6 +59,7 @@ else if [ "${HB_INC_LIBHARU}" != "" ]; then _HB_DIRS="${_HB_DIRS} hbhpdf" ; fi; if [ "${HB_INC_MYSQL}" != "" ]; then _HB_DIRS="${_HB_DIRS} hbmysql" ; fi; if [ "${HB_INC_PGSQL}" != "" ]; then _HB_DIRS="${_HB_DIRS} hbpgsql" ; fi; + if [ "${HB_INC_OPENSSL}" != "" ]; then _HB_DIRS="${_HB_DIRS} hbssl" ; fi; if [ "${HB_INC_ADS}" != "" ]; then _HB_DIRS="${_HB_DIRS} rddads" ; fi; if [ "${HB_INC_MYSQL}" != "" ]; then _HB_DIRS="${_HB_DIRS} rddsql" ; fi; fi diff --git a/harbour/contrib/make_vc_all.bat b/harbour/contrib/make_vc_all.bat index dfd2ca337d..5d83334ae3 100644 --- a/harbour/contrib/make_vc_all.bat +++ b/harbour/contrib/make_vc_all.bat @@ -61,6 +61,7 @@ if not "%HB_INC_GD%%HB_DIR_GD%" == "" set _HB_DIRS=%_HB_DIRS% hbgd if not "%HB_INC_LIBHARU%%HB_DIR_LIBHARU%" == "" set _HB_DIRS=%_HB_DIRS% hbhpdf if not "%HB_INC_MYSQL%%HB_DIR_MYSQL%" == "" set _HB_DIRS=%_HB_DIRS% hbmysql if not "%HB_INC_PGSQL%%HB_DIR_PGSQL%" == "" set _HB_DIRS=%_HB_DIRS% hbpgsql +if not "%HB_INC_OPENSSL%%HB_DIR_OPENSSL%" == "" set _HB_DIRS=%_HB_DIRS% hbssl if not "%HB_INC_ADS%%HB_DIR_ADS%" == "" set _HB_DIRS=%_HB_DIRS% rddads if not "%HB_INC_MYSQL%%HB_DIR_MYSQL%" == "" set _HB_DIRS=%_HB_DIRS% rddsql :OVERRIDE