2009-02-10 01:38 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)

* harbour/contrib/examples/uhttpd/uhttpd.prg
    * Updated uHTTPD (Work in progress)
      + Added support for Sessions
      * Fixed ini file support
  * harbour/contrib/examples/uhttpd/cgifunc.prg
    * Fixed some functions
  + harbour/contrib/examples/uhttpd/session.prg
    + Session class
  * harbour/contrib/examples/uhttpd/modules/info.prg
    + Added display of SESSION vars
    + Added a simple example of SESSIONS
  * harbour/contrib/examples/uhttpd/hbmk_b32.bat
  * harbour/contrib/examples/uhttpd/hbmk_b32.bat
    + Added new files
  + harbour/contrib/examples/uhttpd/sessions
    + Added folder used in samples
This commit is contained in:
Francesco Saverio Giudice
2009-02-10 00:39:40 +00:00
parent c030c2aba6
commit d6c2e99434
8 changed files with 1057 additions and 130 deletions

View File

@@ -8,6 +8,24 @@
2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-02-10 01:38 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)
* harbour/contrib/examples/uhttpd/uhttpd.prg
* Updated uHTTPD (Work in progress)
+ Added support for Sessions
* Fixed ini file support
* harbour/contrib/examples/uhttpd/cgifunc.prg
* Fixed some functions
+ harbour/contrib/examples/uhttpd/session.prg
+ Session class
* harbour/contrib/examples/uhttpd/modules/info.prg
+ Added display of SESSION vars
+ Added a simple example of SESSIONS
* harbour/contrib/examples/uhttpd/hbmk_b32.bat
* harbour/contrib/examples/uhttpd/hbmk_b32.bat
+ Added new files
+ harbour/contrib/examples/uhttpd/sessions
+ Added folder used in samples
2009-02-10 00:50 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* ChangeLog
* Updated [DONE] statuses.

View File

@@ -59,6 +59,7 @@
#define CRLF (Chr(13)+Chr(10))
#xtranslate THROW( <oErr> ) => ( Eval( ErrorBlock(), <oErr> ), Break( <oErr> ) )
#define HB_IHASH() HB_HSETCASEMATCH( {=>}, FALSE )
MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST
@@ -130,7 +131,7 @@ FUNCTION uhttpd_GetVars( cFields, cSeparator )
*/
FUNCTION uhttpd_SplitUrl( cUrl )
LOCAL hUrl := Hash()
LOCAL hUrl := hb_Hash()
LOCAL nPos, cTemp, cUserNamePassword, cHostnamePort
LOCAL cProto, cHost, cPort, nPort, cUser, cPass, cPath, cQuery, cFragment
@@ -240,16 +241,14 @@ FUNCTION uhttpd_SplitUrl( cUrl )
ENDIF
// Assemble hash
WITH OBJECT hUrl
:SCHEME := cProto
:HOST := cHost
:PORT := nPort
:USER := cUser
:PASS := cPass
:PATH := cPath
:QUERY := cQuery
:FRAGMENT := cFragment
END
hb_hSet( hUrl, "SCHEME" , cProto )
hb_hSet( hUrl, "HOST" , cHost )
hb_hSet( hUrl, "PORT" , nPort )
hb_hSet( hUrl, "USER" , cUser )
hb_hSet( hUrl, "PASS" , cPass )
hb_hSet( hUrl, "PATH" , cPath )
hb_hSet( hUrl, "QUERY" , cQuery )
hb_hSet( hUrl, "FRAGMENT", cFragment )
// Prevents externals to add something else to this Hash
HSetAutoAdd( hUrl, FALSE )
@@ -320,6 +319,8 @@ FUNCTION uhttpd_URLEncode( cString, lComplete )
#else
LOCAL cRet := "", i, nVal, cChar
DEFAULT lComplete TO TRUE
FOR i := 1 TO Len( cString )
cChar := SubStr( cString, i, 1)
DO CASE
@@ -857,3 +858,4 @@ FUNCTION uhttpd_HGetValue( hHash, cKey )
ENDIF
//RETURN IIF( cKey IN hHash:Keys, hHash[ cKey ], NIL )
RETURN xVal

View File

@@ -1,3 +1,54 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* uHTTPD (Micro HTTP server) cookie functions
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* 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"
@@ -16,11 +67,13 @@ RETURN uhttpd_Cookie():New( cDomain, cPath, nExpireDays, nExpireSecs )
CLASS uhttpd_Cookie
// Data for cookies
DATA cCookieDomain
DATA cCookiePath INIT "/"
DATA cCookieExpire
DATA nCookieExpireDays INIT 0
DATA nCookieExpireSecs INIT 7200 // 1 hour - TODO set environment constant
DATA cDomain
DATA cPath INIT "/"
DATA cExpire
DATA lSecure INIT FALSE
DATA lHttpOnly
DATA nExpireDays INIT 0
DATA nExpireSecs INIT 7200 // 1 hour - TODO set environment constant
DATA lCookiesSent INIT FALSE
METHOD SetCookie()
@@ -36,18 +89,21 @@ ENDCLASS
// ------------------------------ ***************************** -----------------------------------
METHOD SetCookieDefaults( cDomain, cPath, nExpireDays, nExpireSecs ) CLASS uhttpd_Cookie
IF cDomain <> NIL THEN ::cCookieDomain := cDomain
IF cPath <> NIL THEN ::cCookiePath := cPath
IF nExpireDays <> NIL THEN ::nCookieExpireDays := nExpireDays
IF nExpireSecs <> NIL THEN ::nCookieExpireSecs := nExpireSecs
RETURN NIL
IF cDomain <> NIL THEN ::cDomain := cDomain
IF cPath <> NIL THEN ::cPath := cPath
IF nExpireDays <> NIL THEN ::nExpireDays := nExpireDays
IF nExpireSecs <> NIL THEN ::nExpireSecs := nExpireSecs
RETURN NIL
METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure ) CLASS uhttpd_Cookie
METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure, lHttpOnly ) CLASS uhttpd_Cookie
LOCAL cStr
DEFAULT cDomain TO ::cCookieDomain
DEFAULT cPath TO ::cCookiePath
DEFAULT cExpires TO uhttpd_DateToGMT( Date(), Time(), ::nCookieExpireDays, ::nCookieExpireSecs )
DEFAULT cDomain TO ::cDomain
DEFAULT cPath TO ::cPath
DEFAULT cExpires TO uhttpd_DateToGMT( Date(), Time(), ::nExpireDays, ::nExpireSecs )
DEFAULT lHttpOnly TO FALSE
::lHttpOnly := lHttpOnly
cStr := cCookieName + "=" + uhttpd_UrlEncode( hb_cStr( xValue ) )

View File

@@ -46,9 +46,9 @@ if %UHTTP_INET_SUPPORT%.==no. SET UHTTP_INET_SOCKET=socket.c
if exist uhttpd.exe uhttpd -s
..\..\..\bin\harbour uhttpd cgifunc cookie /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
..\..\..\bin\harbour uhttpd cgifunc cookie session /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
if errorlevel 1 goto DOERROR
bcc32 -O2 -tW -d -a8 -I..\..\..\include -L..\..\..\lib uhttpd.c cgifunc.c cookie.c uhttpdc.c %UHTTP_INET_SOCKET% hbdebug.lib hbvmmt.lib hbrtl.lib gtwvt.lib gtwin.lib gtgui.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbcpage.lib hbsix.lib hbcommon.lib hbpcre.lib hbhsx.lib hbzlib.lib xhb.lib hbct.lib cw32mt.lib %UHTTP_GD_LIBS%
bcc32 -O2 -tW -d -a8 -I..\..\..\include -L..\..\..\lib uhttpd.c cgifunc.c cookie.c session.c uhttpdc.c %UHTTP_INET_SOCKET% hbdebug.lib hbvmmt.lib hbrtl.lib gtwvt.lib gtwin.lib gtgui.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbcpage.lib hbsix.lib hbcommon.lib hbpcre.lib hbhsx.lib hbzlib.lib xhb.lib hbct.lib cw32mt.lib %UHTTP_GD_LIBS%
if errorlevel 1 goto DOERROR
:CLEAN
@@ -57,6 +57,7 @@ del *.tds
del uhttpd.c
del cgifunc.c
del cookie.c
del session.c
if not exist uhttpd.exe goto :EXIT
if %UHTTP_GD_SUPPORT%.==no. goto BUILD_OK

View File

@@ -46,14 +46,17 @@ if %UHTTP_INET_SUPPORT%.==no. SET UHTTP_INET_SOCKET=socket.c
if exist uhttpd.exe uhttpd -s
..\..\..\bin\harbour uhttpd cgifunc cookie /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
..\..\..\bin\harbour uhttpd cgifunc cookie session /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
if errorlevel 1 goto DOERROR
cl -nologo -O2 -W3 -I..\..\..\include uhttpd.c cgifunc.c cookie.c uhttpdc.c %UHTTP_INET_SOCKET% /link /subsystem:windows /libpath:..\..\..\lib hbcpage.lib hbdebug.lib hbvmmt.lib hbrtl.lib gtwin.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbsix.lib hbcommon.lib hbpcre.lib hbzlib.lib user32.lib wsock32.lib advapi32.lib hbct.lib gdi32.lib hbwin.lib hbhsx.lib gtwvt.lib %UHTTP_GD_LIBS% xhb.lib
cl -nologo -O2 -W3 -I..\..\..\include uhttpd.c cgifunc.c cookie.c session.c uhttpdc.c %UHTTP_INET_SOCKET% /link /subsystem:windows /libpath:..\..\..\lib hbcpage.lib hbdebug.lib hbvmmt.lib hbrtl.lib gtwin.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbsix.lib hbcommon.lib hbpcre.lib hbzlib.lib user32.lib wsock32.lib advapi32.lib hbct.lib gdi32.lib hbwin.lib hbhsx.lib gtwvt.lib %UHTTP_GD_LIBS% xhb.lib
if errorlevel 1 goto DOERROR
:CLEAN
del *.obj
del uhttpd.c
del cgifunc.c
del cookie.c
del session.c
if not exist uhttpd.exe goto :EXIT
if %UHTTP_GD_SUPPORT%.==no. goto BUILD_OK

View File

@@ -59,7 +59,7 @@
#include "common.ch"
#include "hbclass.ch"
MEMVAR _SERVER, _REQUEST, _GET, _POST, _COOKIE, _HTTP_REQUEST
MEMVAR _SERVER, _REQUEST, _GET, _POST, _COOKIE, _SESSION, _HTTP_REQUEST
FUNCTION HRBMAIN()
LOCAL cHtml
@@ -90,14 +90,17 @@ STATIC FUNCTION ShowServerInfo()
//cHtml += "<br>"
cHtml += DisplayVars( _Request, "REQUEST Vars" )
cHtml += "<br>"
//cHtml += DisplayVars( _Session, "SESSION Vars" )
//cHtml += "<br>"
cHtml += DisplayVars( _Session, "SESSION Vars" )
cHtml += "<br>"
// Set a simple cookie
//oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
//oCookie:SetCookie( "samplecookie", "test" )
//oCookie:SetCookie( "samplecookie2", "test2" )
_SESSION[ "Session_Var1" ] := "Test1"
_SESSION[ "Session_Var2" ] := "Test2"
RETURN cHtml
STATIC FUNCTION DisplayVars( hHash, cTitle )

View File

@@ -0,0 +1,816 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* uHTTPD (Micro HTTP server) session functions
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* 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 "hbcompat.ch"
#include "common.ch"
#include "hbclass.ch"
#include "fileio.ch"
#include "directry.ch"
#command IF <lexpr> THEN <*statement*> =>;
IF (<lexpr>) ; <statement> ; END
#command IF <lexpr> THEN <statement1> ELSE <statement2> =>;
IF (<lexpr>) ; <statement1> ; ELSE ; <statement2> ; END
#xtranslate SetNewValueReturnOld( <p>, <v> ) => LOCAL xOld, xOld := <p>, IIF( <v> <> NIL, <p> := <v>, ), xOld
#xtranslate DEFAULT( <p>, <v> ) => ( <p> := IIF( <p> == NIL, <v>, <p> ) )
MEMVAR _COOKIE, _SESSION, _REQUEST, _SERVER
#define MY_CRCKEY "UhTTpK3y!@"
FUNCTION uhttpd_SessionNew( cSessionName, cSessionPath )
RETURN uhttpd_Session():New( cSessionName, cSessionPath )
CLASS uhttpd_Session
METHOD New()
DESTRUCTOR DestroyObject()
METHOD Start()
METHOD IsRegistered()
METHOD CacheExpire( nTimeInMinutes ) INLINE SetNewValueReturnOld( ::nCache_Expire, nTimeInMinutes )
METHOD CacheLimiter()
METHOD GetCookieParams() INLINE { ::nCookie_LifeTime, ::cCookie_Path, ::cCookie_Domain, ::lCookie_Secure }
METHOD SetCookieParams()
METHOD ID( cID ) INLINE SetNewValueReturnOld( ::cSID, cID )
METHOD Name( cName ) INLINE SetNewValueReturnOld( ::cName, cName )
METHOD RegenerateID()
METHOD SavePath( cPath ) INLINE SetNewValueReturnOld( ::cSavePath, cPath )
METHOD IsStarted() INLINE ( ::nActiveSessions > 0 )
METHOD UseOnlyCookies() INLINE ::lUse_Only_Cookies
METHOD UseTransSID() INLINE ::lUse_Only_Cookies
METHOD SaveCookie()
METHOD GetSessionVars()
METHOD GetVar( cVar ) INLINE uhttpd_HGetValue( _SESSION, cVar )
METHOD SetVar( cVar, xValue ) INLINE _SESSION[ cVar ] := xValue
METHOD SetSaveHandler()
METHOD Open( cPath, cName )
METHOD Close()
METHOD Read( cID )
METHOD Write( cID, cData )
METHOD Destroy( cID )
METHOD GC( nMaxLifeTime )
METHOD SessionContainer( hHash ) INLINE SetNewValueReturnOld( _SESSION, hHash )
METHOD Encode() // INLINE HB_Serialize( _SESSION )
METHOD Decode()
HIDDEN:
DATA oCookie
DATA cSID
DATA cSavePath INIT "/tmp"
DATA cName // INIT "SESSIONID"
DATA lAuto_Start INIT FALSE // FALSE = no autostart
DATA nGc_Probability INIT 33 // Every 1/3 of checks i'll lunch Session GC
DATA nGc_MaxLifeTime INIT 1440 // seconds - Number of seconds after gc can delete a session
// DATA cSerialize_Handler INIT "HBHTMLLIB"
DATA nCookie_LifeTime INIT 3600 //0 // Number of seconds to keep cookie, 0 = until browser is closed
DATA cCookie_Path INIT "/"
DATA cCookie_Domain
DATA lCookie_Secure INIT FALSE
DATA lUse_Cookies INIT TRUE // TRUE = Use cookies to store session id on client side
DATA lUse_Only_Cookies INIT FALSE
DATA cReferrer_Check // If is set check if referrer is equal to, if it isn't block
// DATA cEntropy_File
// DATA nEntropy_Lenght
DATA cCache_Limiter INIT "nocache" // Possible values are: none, nocache, private, private_no_expire, public
DATA nCache_Expire INIT 180 // in minutes, not checked if cCache_Limiter == none or nocache
DATA lUse_Trans_SID INIT FALSE // FALSE = no SID appended to URL
// Session Storage code blocks
DATA bOpen //INIT {|cPath, cName| ::SessionOpen( cPath, cName ) }
DATA bClose //INIT {|| ::SessionClose() }
DATA bRead //INIT {|cID| ::SessionRead( cID ) }
DATA bWrite //INIT {|cID, cData| ::SessionWrite( cID, cData ) }
DATA bDestroy //INIT {|cID| ::SessionDestroy( cID ) }
DATA bGC //INIT {|nMaxLifeTime| ::SessionGC( nMaxLifeTime ) }
DATA nActiveSessions INIT 0
DATA lSessionActive INIT FALSE
METHOD GenerateSID()
METHOD CheckSID()
METHOD SessionOpen()
METHOD SessionClose()
METHOD SessionRead()
METHOD SessionWrite()
METHOD SessionDestroy()
METHOD SessionGC()
METHOD SendCacheLimiter()
ENDCLASS
// ------------------------------ ***************************** -----------------------------------
METHOD New( cSessionName, cSessionPath ) CLASS uhttpd_Session
//hb_ToOutDebug( "cSessionName = %s, cSessionPath = %s\n\r", cSessionName, cSessionPath )
DEFAULT cSessionName TO "SESSION"
DEFAULT cSessionPath TO ::cSavePath
// ::cSID := ::GenerateSID()
// As default we will use FILES - this is FILE version
::bOpen := {|cPath, cName| ::SessionOpen( cPath, cName ) }
::bClose := {|| ::SessionClose() }
::bRead := {|cID| ::SessionRead( cID ) }
::bWrite := {|cID, cData| ::SessionWrite( cID, cData ) }
::bDestroy := {|cID| ::SessionDestroy( cID ) }
::bGC := {|nMaxLifeTime| ::SessionGC( nMaxLifeTime ) }
/*
// DBF version - we will store in a DBF - this only an example
::bOpen := {|cPath, cName| DBF_Session_Open( cPath, cName ) }
::bClose := {|| DBF_Session_Close() }
::bRead := {|cID| DBF_Session_Read( cID ) }
::bWrite := {|cID, cData| DBF_Session_Write( cID, cData ) }
::bDestroy := {|cID| DBF_Session_Destroy( cID ) }
::bGC := {|nMaxLifeTime| DBF_Session_GC( nMaxLifeTime ) }
*/
::cName := cSessionName + "ID"
::cReferrer_Check := _SERVER[ "HTTP_REFERER" ]
::cSavePath := cSessionPath
::oCookie := uhttpd_CookieNew( ::cCookie_Domain, ::cCookie_Path )
RETURN Self
METHOD Start( cSID ) CLASS uhttpd_Session
LOCAL lSendCookie := TRUE
LOCAL lDefine_SID := TRUE
LOCAL xVal, nRand, nPos
LOCAL hUrl
IF cSID <> NIL
::cSID := cSID
ENDIF
//TraceLog( "Active Sessions : " + hb_cStr( ::nActiveSessions ) )
IF ::nActiveSessions <> 0
RETURN FALSE
ENDIF
// Start checking ID from global vars
IF ( nPos := hb_HPos( _REQUEST, ::cName ) ) > 0
//::cSID := ::oCGI:h_Request[ ::cName ]
::cSID := hb_HValueAt( _REQUEST, nPos )
lSendCookie := FALSE
lDefine_SID := FALSE
//::oCGI:ToLogFile( "::cSID = " + hb_cStr( ::cSID ), "/pointtoit/tmp/log.txt" )
ENDIF
IF !Empty( ::cSID ) .AND. !::CheckSID()
// Check if the SID is NOT valid, someone altered it
//::oCGI:ToLogFile( "::cSID = " + hb_cStr( ::cSID ) + " SID is NOT valid, someone altered it", "/pointtoit/tmp/log.txt" )
::cSID := NIL // invalidate current SID, i'll generate a new one
lSendCookie := TRUE
lDefine_SID := TRUE
ENDIF
IF !Empty( ::cSID ) .AND. !Empty( ::cReferrer_Check )
// TODO: fix
//oUrl := TUrl():New( ::cReferrer_Check )
hUrl := uhttpd_SplitUrl( ::cReferrer_Check )
//hb_ToOutDebug( "hUrl = %s\n\r", hb_ValToExp( hUrl ) )
//IF !( oUrl:cServer == _SERVER[ "SERVER_NAME" ] )
IF !( hUrl[ "HOST" ] == _SERVER[ "SERVER_NAME" ] )
::cSID := NIL // invalidate current SID, i'll generate a new one
lSendCookie := TRUE
lDefine_SID := TRUE
ENDIF
// // Check whether the current request was referred to by
// // an external site which invalidates the previously found ID
// $url = parse_url($GLOBALS['HTTP_REFERER']);
// if (trim($url['host']) != $GLOBALS['SERVER_NAME']) {
// unset($session->id);
// $send_cookie = true;
// $define_sid = true;
// }
ENDIF
// Do we have an existing session ID?
IF Empty( ::cSID )
// Create new session ID
::cSID := ::GenerateSID()
ENDIF
// Is use_cookies set to false?
IF !::lUse_Cookies .AND. lSendCookie
lDefine_SID := TRUE
lSendCookie := FALSE
ENDIF
// Should we send a cookie?
IF lSendCookie
::oCookie:SetCookie( ::cName, ::cSID, ::cCookie_Domain, ::cCookie_Path, uhttpd_DateToGMT(,,,::nCookie_LifeTime), ::lCookie_Secure )
ENDIF
// Should we define the SID?
IF lDefine_SID
cSID := ::cName + '=' + ::cSID
_REQUEST[ ::cName ] := ::cSID
ENDIF
::nActiveSessions++
// Send caching headers
// Start session
IF !::Open(::cSavePath, ::cName )
uhttpd_Die( 'ERROR: Failed to open session file' )
ENDIF
// Read session data
IF !( ( xVal := ::Read( ::cSID ) ) == NIL )
//TraceLog( "Read session data - xVal", xVal )
//::oCGI:ToLogFile( "xval = " + hb_cStr( xVal ), "/pointtoit/tmp/log.txt" )
// Decode session data
::Decode( xVal )
//::oCGI:ToLogFile( "decoded", "/pointtoit/tmp/log.txt" )
ENDIF
// Send HTTP cache headers
::SendCacheLimiter()
// Check if we should clean up (call the garbage collection routines)
//TraceLog( "::nGc_probability = " + hb_cStr( ::nGc_probability ) )
IF ::nGc_probability > 0
nRand := HB_RandomInt( 1, 100 )
//TraceLog( "::nGc_probability - nRand = " + hb_cStr( nRand ) )
IF nRand <= ::nGc_Probability
::GC( ::nGc_MaxLifeTime )
ENDIF
ENDIF
RETURN TRUE
METHOD Destroy() CLASS uhttpd_Session
IF ::nActiveSessions == 0
RETURN FALSE
ENDIF
// Destroy session
IF !Eval( ::bDestroy, ::cSID )
RETURN FALSE
ENDIF
RETURN TRUE
METHOD Close() CLASS uhttpd_Session
LOCAL cVal
//TraceLog( "Session Close() - oCGI:h_Session", DumpValue( oCGI:h_Session ) )
IF ::nActiveSessions == 0
RETURN FALSE
ENDIF
// Encode session
cVal := ::Encode()
// Save session
IF !::Write( ::cSID, cVal )
uhttpd_Die( 'Session could not be saved.' )
ENDIF
// Close session
IF !Eval( ::bClose )
uhttpd_Die('Session could not be closed.')
ENDIF
::nActiveSessions--
RETURN TRUE
METHOD Open( cPath, cName ) CLASS uhttpd_Session
RETURN Eval( ::bOpen, cPath, cName )
METHOD Read( cID ) CLASS uhttpd_Session
RETURN Eval( ::bRead, cID )
METHOD Write( cID, cData ) CLASS uhttpd_Session
RETURN Eval( ::bWrite, cID, cData )
METHOD GC( nMaxLifeTime ) CLASS uhttpd_Session
RETURN Eval( ::bGC, nMaxLifeTime )
METHOD IsRegistered() CLASS uhttpd_Session
LOCAL lRegistered := FALSE
RETURN lRegistered
METHOD CacheLimiter( cNewLimiter ) CLASS uhttpd_Session
LOCAL cOldLimiter := ::cCache_Limiter
IF cNewLimiter <> NIL
IF cNewLimiter $ "none/nocache/private/private_no_expire/public"
::cCache_Limiter := cNewLimiter
ELSE
uhttpd_Die( "ERROR: uhttpd_Session:CacheLimiter() - New Limiter is incorrect" )
ENDIF
ENDIF
RETURN cOldLimiter
METHOD SetCookieParams( nLifeTime, cPath, cDomain, lSecure ) CLASS uhttpd_Session
IF nLifeTime <> NIL THEN ::nCookie_LifeTime := nLifeTime
IF cPath <> NIL THEN ::cCookie_Path := cPath
IF cDomain <> NIL THEN ::cCookie_Domain := cDomain
IF lSecure <> NIL THEN ::lCookie_Secure := lSecure
RETURN NIL
METHOD RegenerateID() CLASS uhttpd_Session
::cSID := ::GenerateSID()
IF ::lUse_Cookies
::oCookie:SetCookie( ::cName, ::cSID, ::cCookie_Domain, ::cCookie_Path, uhttpd_DateToGMT(,,,::nCookie_LifeTime), ::lCookie_Secure )
ENDIF
RETURN ::cSID
METHOD SaveCookie() CLASS uhttpd_Session
LOCAL cExpires := uhttpd_DateToGMT( Date(), Time(),, ::nCookie_LifeTime )
LOCAL cKey
//oCGI:SetCookie( ::cName, ::cSID, ::cCookie_Domain, ::cCookie_Path, cExpires, ::lCookie_Secure )
FOR EACH cKey IN _SESSION:Keys
::oCookie:SetCookie( ::cName + "_" + cKey, _SESSION[ cKey ], ::cCookie_Domain, ::cCookie_Path, cExpires, ::lCookie_Secure )
NEXT
RETURN NIL
//METHOD ReadCookie()
// oCGI:SetCookie( ::cName, ::cSID, ::cCookie_Domain, ::cCookie_Path, cExpires, ::lCookie_Secure )
//RETURN NIL
METHOD GetSessionVars( aHashVars, cFields, cSeparator ) CLASS uhttpd_Session
LOCAL aNotSessionFlds := {}
LOCAL aField, cField, aFields
LOCAL cName, xValue
LOCAL cSessPrefix := ::cName + "_"
LOCAL cFieldsNotInSession := ""
LOCAL cSessVarName
DEFAULT cSeparator TO "&"
aFields := HB_RegExSplit( cSeparator, cFields )
FOR EACH cField in aFields
aField := HB_RegexSplit( "=", cField, 2 )
IF Len( aField ) != 2
LOOP
ENDIF
cSessVarName := LTrim( aField[1] )
//cName := "_" + LTrim( aField[1] ) // ERROR ON VAR NAME WITH LEN 1. X
//cName := LTrim( aField[1] ) // ERROR ON VAR NAME WITH LEN 1. X
//TraceLog( "SESSION: cSessVarName, cSessPrefix, Left( cSessVarName, Len( cSessPrefix ) )", ;
// cSessVarName, cSessPrefix, Left( cSessVarName, Len( cSessPrefix ) ) )
IF Left( cSessVarName, Len( cSessPrefix ) ) == cSessPrefix // IF Left part of var is equal to session prefixname i.e. "SESSION"
cName := Substr( cSessVarName, Len( cSessPrefix ) + 1 )
xValue := uhttpd_UrlDecode( aField[2] )
//TraceLog( "SESSION: cName, xValue", cName, xValue )
//Tracelog( "cName, xValue", cName, xValue )
// is it an array entry?
IF Substr( cName, Len( cName ) - 1 ) == "[]"
cName := Substr( cName, 1, Len( cName ) - 2 )
//aHashVars[ cName ] := { xValue }
aHashVars[ cName ] := { xValue }
//aHashVars:Keys( cName )
//__ObjSendMsg( aHashVars, "_" + cName, { xValue } ) // variant from Ron to handle 1 lenght name
ELSE
//aHashVars[ cName ] := xValue
aHashVars[ cName ] := xValue
//aHashVars:Keys( cName )
//__ObjSendMsg( aHashVars, "_" + cName, xValue ) // variant from Ron to handle 1 lenght name
ENDIF
//Tracelog( "aHashVars, cName, xValue", DumpValue( aHashVars ), cName, xValue )
ELSE
aAdd( aNotSessionFlds, aField )
ENDIF
NEXT
IF !Empty( aNotSessionFlds )
FOR EACH aField IN aNotSessionFlds
cFieldsNotInSession += aField[1] + "=" + aField[2] + "&"
NEXT
// Delete last & char
cFieldsNotInSession := Left( cFieldsNotInSession, Len( cFieldsNotInSession ) - 1 )
ENDIF
//TraceLog( "SESSION: cFieldsNotInSession", cFieldsNotInSession )
RETURN cFieldsNotInSession
/*
* SID = 25 random chars + 5 CRC chars
*/
METHOD GenerateSID( cCRCKey ) CLASS uhttpd_Session
LOCAL cSID, nSIDCRC, cSIDCRC, n, cTemp
LOCAL nLenSID := 25
LOCAL cBaseKeys := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
LOCAL nLenKeys := Len( cBaseKeys )
LOCAL cRet
LOCAL nRand, nKey := 0
LOCAL nLenTemp
//LOCAL a := 0
//DEFAULT cCRCKey TO "3InFoW4lL5" // Max Lenght must to be 10
DEFAULT cCRCKey TO MY_CRCKEY // Max Lenght must to be 10
/* Let's generate the sequence */
//cSID := Space( nLenSID )
cSID := ""
FOR n := 1 TO nLenSID - 5 // 5 = CRC Length
nRand := HB_RandomInt( 1, nLenKeys )
//cSID[ n ] := cBaseKeys[ nRand ]
cSID += SubStr( cBaseKeys, nRand, 1 )
nKey += nRand
NEXT
nSIDCRC := nKey * 51 // Max Value is 99603. a 5 chars number
cTemp := StrZero( nSIDCRC, 5 )
cSIDCRC := ""
nLenTemp := Len( cTemp )
FOR n := 1 TO nLenTemp
//cSIDCRC += cCRCKey[ Val( cTemp[ n ] ) + 1 ]
cSIDCRC += SubStr( cCRCKey, Val( SubStr( cTemp, n, 1 ) ) + 1, 1 )
//::oCGI:ToLogFile( "cCRCKey = " + hb_cStr( SubStr( cCRCKey, Val( SubStr( cTemp, n, 1 ) ) + 1, 1 ) ), "/pointtoit/tmp/log.txt" )
NEXT
cRet := cSID + cSIDCRC
//::oCGI:ToLogFile( "::GenerateSID() = " + hb_cStr( cSID ) + " " + hb_cStr( cSIDCRC ), "/pointtoit/tmp/log.txt" )
//TraceLog( "Generate SID: cRet, cSID, nSIDCRC, cTemp, cSIDCRC, nKey, a", cRet, cSID, nSIDCRC, cTemp, cSIDCRC, nKey, a )
RETURN cRet
METHOD CheckSID( cSID, cCRCKey ) CLASS uhttpd_Session
LOCAL nSIDCRC, cSIDCRC, n, cTemp
LOCAL nLenSID := 25
LOCAL cBaseKeys := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
LOCAL nRand, nKey := 0
LOCAL nLenTemp
//LOCAL a := 0
DEFAULT cSID TO ::cSID
DEFAULT cCRCKey TO MY_CRCKEY // Max Lenght must to be 10
/* Calculate the key */
FOR n := 1 TO nLenSID - 5 // 5 = CRC Length
//nRand := At( cSID[ n ], cBaseKeys )
nRand := At( SubStr( cSID, n, 1 ), cBaseKeys )
nKey += nRand
NEXT
// Recalculate the CRC
nSIDCRC := nKey * 51 // Max Value is 99603. a 5 chars number
cTemp := StrZero( nSIDCRC, 5 )
cSIDCRC := ""
nLenTemp := Len( cTemp )
FOR n := 1 TO nLenTemp
//cSIDCRC += cCRCKey[ Val( cTemp[ n ] ) + 1 ]
cSIDCRC += SubStr( cCRCKey, Val( SubStr( cTemp, n, 1 ) ) + 1, 1 )
NEXT
//TraceLog( "Check SID: cRet, cSID, nSIDCRC, cTemp, cSIDCRC, nKey, a", cRet, cSID, nSIDCRC, cTemp, cSIDCRC, nKey, a )
//::oCGI:ToLogFile( "::CheckSID() = " + hb_cStr( cSID ) + " " + hb_cStr( cSIDCRC ), "/pointtoit/tmp/log.txt" )
RETURN ( Right( cSID, 5 ) == cSIDCRC )
// -------------------------------*************************-----------------------------------------
METHOD SetSaveHandler( bOpen, bClose, bRead, bWrite, bDestroy, bGC ) CLASS uhttpd_Session
IF bOpen <> NIL THEN ::bOpen := bOpen
IF bClose <> NIL THEN ::bClose := bClose
IF bRead <> NIL THEN ::bRead := bRead
IF bWrite <> NIL THEN ::bWrite := bWrite
IF bDestroy <> NIL THEN ::bDestroy := bDestroy
IF bGC <> NIL THEN ::bGC := bGC
RETURN NIL
METHOD SessionOpen( cPath, cName ) CLASS uhttpd_Session
//TraceLog( "SessionOpen() - cName", cName )
IF cPath <> NIL THEN ::cSavePath := cPath
IF cName <> NIL THEN ::cName := cName
RETURN TRUE
METHOD SessionClose() CLASS uhttpd_Session
//TraceLog( "SessionClose()" )
// Nothing to do
RETURN TRUE
METHOD SessionRead( cID ) CLASS uhttpd_Session
LOCAL nH
LOCAL cFile
LOCAL nFileSize
LOCAL cBuffer
DEFAULT cID TO ::cSID
cFile := ::cSavePath + "/" + ::cName + "_" + cID
//TraceLog( "SessionRead: cFile", cFile )
IF File( cFile )
IF ( nH := FOpen( cFile, FO_READ ) ) <> -1
nFileSize := FSeek( nH, 0, FS_END )
FSeek( nH, 0, FS_SET )
cBuffer := Space( nFileSize )
IF ( FRead( nH, @cBuffer, nFileSize ) ) <> nFileSize
uhttpd_Die( "ERROR: On reading session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
ELSE
FClose( nH )
ENDIF
ELSE
uhttpd_Die( "ERROR: On opening session file : " + cFile + ", file not exist." )
ENDIF
ENDIF
//TraceLog( "SessionRead() - cID, cFile, nFileSize, cBuffer", cID, cFile, nFileSize, cBuffer )
RETURN cBuffer
METHOD SessionWrite( cID, cData ) CLASS uhttpd_Session
LOCAL nH
LOCAL cFile
LOCAL nFileSize
LOCAL lOk := FALSE
//TraceLog( "SessionWrite() - cID, cData", cID, cData )
DEFAULT cID TO ::cSID
DEFAULT cData TO ""
nFileSize := Len( cData )
cFile := ::cSavePath + "/" + ::cName + "_" + cID
//TraceLog( "SessionWrite() - cFile", cFile )
IF nFileSize > 0
IF ( nH := FCreate( cFile, FC_NORMAL ) ) <> -1
IF ( FWrite( nH, @cData, nFileSize ) ) <> nFileSize
uhttpd_Die( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
ELSE
lOk := TRUE
FClose( nH )
ENDIF
ELSE
uhttpd_Die( "ERROR: On WRITING session file. I can not create session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
ENDIF
ELSE
// If session data is empty, I will delete the file if exist
IF File( cFile )
FErase( cFile )
ENDIF
// Return that all is ok
lOk := TRUE
ENDIF
RETURN lOk
METHOD SessionDestroy( cID ) CLASS uhttpd_Session
LOCAL cFile
LOCAL lOk
//TraceLog( "SessionDestroy() - cID", cID )
DEFAULT cID TO ::cSID
_SESSION := Hash()
::oCookie:DeleteCookie( ::cName )
//TraceLog( "SessionDestroy() - cID, oCGI:h_Session", cID, DumpValue( oCGI:h_Session ) )
cFile := ::cSavePath + "/" + ::cName + "_" + cID
IF !( lOk := ( FErase( cFile ) == 0 ) )
uhttpd_Die( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
ELSE
//TraceLog( "SessionDestroy() - Sessione Eliminata - File " + cFile )
// Genero un nuovo SID
::RegenerateID()
ENDIF
RETURN lOk
METHOD SessionGC( nMaxLifeTime ) CLASS uhttpd_Session
//TraceLog( "SessionGC() - nMaxLifeTime", nMaxLifeTime )
//STATIC nStartTime
LOCAL nSecs
LOCAL aDir, aFile
DEFAULT nMaxLifeTime TO ::nGc_MaxLifeTime
aDir := Directory( ::cSavePath + "/" + ::cName + "_*.*" )
FOR EACH aFile IN aDir
nSecs := TimeDiffAsSeconds( aFile[ F_DATE ], Date(), aFile[ F_TIME ], Time() )
//TraceLog( "GC: aFile[ F_NAME ], aFile[ F_DATE ], Date(), aFile[ F_TIME ], Time(), nSecs, nMaxLifeTime", ;
// aFile[ F_NAME ], aFile[ F_DATE ], Date(), aFile[ F_TIME ], Time(), nSecs, nMaxLifeTime )
IF nSecs > nMaxLifeTime
FErase( ::cSavePath + "/" + aFile[ F_NAME ] )
ENDIF
NEXT
RETURN TRUE
STATIC FUNCTION TimeDiffAsSeconds( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
LOCAL aRetVal
DEFAULT dDateEnd TO DATE()
DEFAULT cTimeEnd TO TIME()
aRetVal := FT_ELAPSED( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
RETURN aRetVal[ 4, 2 ]
// Nanforum ELAPSED
STATIC FUNCTION FT_ELAPSED(dStart, dEnd, cTimeStart, cTimeEnd)
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[4,2]
IF ! ( VALTYPE(dStart) $ 'DC' )
dStart := DATE()
ELSEIF VALTYPE(dStart) == 'C'
cTimeStart := dStart
dStart := DATE()
ENDIF
IF ! ( VALTYPE(dEnd) $ 'DC' )
dEnd := DATE()
ELSEIF VALTYPE(dEnd) == 'C'
cTimeEnd := dEnd
dEnd := DATE()
ENDIF
IF( VALTYPE(cTimeStart) != 'C', cTimeStart := '00:00:00', )
IF( VALTYPE(cTimeEnd) != 'C', cTimeEnd := '00:00:00', )
nTotalSec := (dEnd - dStart) * 86400 + ;
VAL(cTimeEnd) * 3600 + ;
VAL(SUBSTR(cTimeEnd,AT(':', cTimeEnd)+1,2)) * 60 + ;
IF(RAT(':', cTimeEnd) == AT(':', cTimeEnd), 0, ;
VAL(SUBSTR(cTimeEnd,RAT(':', cTimeEnd)+1))) - ;
VAL(cTimeStart) * 3600 - ;
VAL(SUBSTR(cTimeStart,AT(':', cTimeStart)+1,2)) * 60 - ;
IF(RAT(':', cTimeStart) == AT(':', cTimeStart), 0, ;
VAL(SUBSTR(cTimeStart,RAT(':', cTimeStart)+1)))
nTemp := nTotalSec
FOR nCtr = 1 to 4
nConstant := IF(nCtr == 1, 86400, IF(nCtr == 2, 3600, IF( nCtr == 3, 60, 1)))
aRetVal[nCtr,1] := INT(nTemp/nConstant)
aRetval[nCtr,2] := nTotalSec / nConstant
nTemp -= aRetVal[nCtr,1] * nConstant
NEXT
RETURN aRetVal
// -------------------------------*************************-----------------------------------------
METHOD Encode() CLASS uhttpd_Session
LOCAL aSerial := {}
LOCAL cKey, xVal
IF Type( "_SESSION" ) == "H"
FOR EACH cKey IN _SESSION:Keys
xVal := _SESSION[ cKey ]
IF xVal <> NIL THEN aAdd( aSerial, { cKey, xVal } )
NEXT
ENDIF
RETURN IIF( !Empty( aSerial ), HB_Serialize( aSerial ), NIL )
METHOD Decode( cData ) CLASS uhttpd_Session
LOCAL lOk := TRUE
LOCAL cSerial := HB_DeserialBegin( cData )
LOCAL xVal, aElem
//LOCAL cKey
//TraceLog( "Decode - cSerial", cSerial )
//::oCGI:ToLogFile( "Decode - cSerial = " + hb_cStr( cSerial ), "/pointtoit/tmp/log.txt" )
DO WHILE ( xVal := HB_DeserialNext( @cSerial ) ) <> NIL
//TraceLog( "Decode - xVal", DumpValue( xVal ) )
//::oCGI:ToLogFile( "Decode - xVal = " + hb_cStr( xVal ) + ", ValType( xVal ) = " + ValType( xVal ), "/pointtoit/tmp/log.txt" )
SWITCH ValType( xVal )
//CASE 'O'
// //TraceLog( "Decode - xVal - Object", xVal )
// IF xVal:classname == "TASSOCIATIVEARRAY"
// //TraceLog( "Decode - xVal - Object - TAssociativeArray - Keys", xVal:Keys )
// FOR EACH cKey IN xVal:Keys
// //TraceLog( "Decode TassociativeArray - cKey, xVal:SendKey( cKey )", cKey, xVal:SendKey( cKey ) )
// _SESSION:SendKey( cKey, xVal:SendKey( cKey ) )
// NEXT
// ENDIF
// EXIT
CASE 'A' // Le variabili sono conservate come array { VarName, Value }
//TraceLog( "Decode - xVal - Array", xVal )
//::oCGI:ToLogFile( "Decode - xVal - Array = " + hb_cStr( xVal ) + ", Len = " + hb_cStr( Len( xVal ) ), "/pointtoit/tmp/log.txt" )
FOR EACH aElem IN xVal
//::oCGI:ToLogFile( "Decode - aElem = " + hb_cStr( hb_valtoexp( aElem ) ), "/pointtoit/tmp/log.txt" )
_SESSION[ aElem[1] ] := aElem[2]
NEXT
EXIT
OTHERWISE
uhttpd_Die( "ERROR: On deserializing session data" )
lOk := FALSE
EXIT
END
ENDDO
RETURN lOk
METHOD SendCacheLimiter() CLASS uhttpd_Session
DO CASE
CASE ::cCache_Limiter == 'nocache'
//uhttpd_AddHeader( 'Expires', 'Thu, 19 Nov 1981 08:52:00 GMT' )
uhttpd_AddHeader( 'Expires', uhttpd_DateToGMT( ,,-1, ) )
uhttpd_AddHeader( 'Cache-Control', 'no-cache' )
//uhttpd_AddHeader("Cache-Control", "no-store, no-cache, must-revalidate") // HTTP/1.1
//uhttpd_AddHeader("Cache-Control", "post-check=0, pre-check=0", FALSE )
uhttpd_AddHeader( 'Pragma', 'no-cache' )
CASE ::cCache_Limiter == 'private'
uhttpd_AddHeader( 'Expires', 'Thu, 19 Nov 1981 08:52:00 GMT' )
uhttpd_AddHeader( 'Cache-Control', 'private, max-age=' + LTrim( Str( ::nCache_Expire * 60 ) ) )
uhttpd_AddHeader( 'Last-Modified', uhttpd_DateToGMT( FileDate( hb_argv(0) ) ) )
CASE ::cCache_Limiter == 'public'
uhttpd_AddHeader( 'Expires', uhttpd_DateToGMT( ,,, ::nCache_Expire * 60 ) )
uhttpd_AddHeader( 'Cache-Control', 'public, max-age=' + LTrim( Str( ::nCache_Expire * 60 ) ) )
uhttpd_AddHeader( 'Last-Modified', uhttpd_DateToGMT( FileDate( hb_argv(0) ) ) )
OTHERWISE
uhttpd_Die( "ERROR: Caching method " + ::cCache_Limiter + " not implemented." )
ENDCASE
//__OutDebug( "Header cache '" + ::cCache_Limiter + "' inviato" )
RETURN NIL
PROCEDURE DestroyObject() CLASS uhttpd_Session
::Close()
//::oCGI:ToLogFile( "Session destroyed" )
//::oCGI := NIL
RETURN

View File

@@ -161,13 +161,14 @@ STATIC s_hmtxQueue, s_hmtxServiceThreads, s_hmtxRunningThreads, s_hmtxLog, s_hmt
STATIC s_hmtxHRB, s_hmtxCGIKill
STATIC s_hfileLogAccess, s_hfileLogError, s_cDocumentRoot, s_lIndexes, s_lConsole, s_nPort
STATIC s_cSessionPath
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 := {}
STATIC s_hHRBModules := {=>}
STATIC s_hHRBModules := {=>}
#ifdef USE_HB_INET
STATIC s_cLocalAddress, s_nLocalPort
@@ -177,10 +178,10 @@ STATIC s_cLocalAddress, s_nLocalPort
//STATIC s_hScriptAliases := { "/info" => "/cgi-bin/info.hrb" }
STATIC s_hScriptAliases := { => }
THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_cErrorMsg
THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_cErrorMsg, t_oSession
THREAD STATIC t_hProc
MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST, m_cPost
MEMVAR _SERVER, _GET, _POST, _COOKIE, _SESSION, _REQUEST, _HTTP_REQUEST, m_cPost
ANNOUNCE ERRORSYS
@@ -189,9 +190,9 @@ FUNCTION MAIN( ... )
LOCAL aThreads, nStartThreads, nMaxThreads, nStartServiceThreads
LOCAL i, cPar, lStop
LOCAL cGT, cDocumentRoot, lIndexes, cConfig
LOCAL lConsole
LOCAL lConsole, lScriptAliasMixedCase
LOCAL nProgress := 0
LOCAL hDefault, cLogAccess, cLogError
LOCAL hDefault, cLogAccess, cLogError, cSessionPath
LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads
IF !HB_MTVM()
@@ -274,25 +275,30 @@ FUNCTION MAIN( ... )
// ----------------- Parse ini file ----------------------------------------
//hb_toOutDebug( "cConfig = %s\n\r", cConfig )
//hb_ToOutDebug( "cConfig = %s\n\r", cConfig )
hDefault := ParseIni( cConfig )
// ------------------- Parameters changeable from ini file ----------------
nPort := hDefault[ "MAIN" ][ "Port" ]
cDocumentRoot := hDefault[ "MAIN" ][ "Document_root" ]
lIndexes := hDefault[ "MAIN" ][ "Show_indexes" ]
// All key values MUST be in uppercase
nPort := hDefault[ "MAIN" ][ "PORT" ]
cDocumentRoot := hDefault[ "MAIN" ][ "DOCUMENT_ROOT" ]
lIndexes := hDefault[ "MAIN" ][ "SHOW_INDEXES" ]
lScriptAliasMixedCase := hDefault[ "MAIN" ][ "SCRIPTALIASMIXEDCASE" ]
cSessionPath := hDefault[ "MAIN" ][ "SESSIONPATH" ]
cLogAccess := hDefault[ "LOGFILES" ][ "access" ]
cLogError := hDefault[ "LOGFILES" ][ "error" ]
cLogAccess := hDefault[ "LOGFILES" ][ "ACCESS" ]
cLogError := hDefault[ "LOGFILES" ][ "ERROR" ]
nStartThreads := hDefault[ "THREADS" ][ "start_num" ]
nMaxThreads := hDefault[ "THREADS" ][ "max_num" ]
nStartThreads := hDefault[ "THREADS" ][ "START_NUM" ]
nMaxThreads := hDefault[ "THREADS" ][ "MAX_NUM" ]
// ATTENTION: aliases can be in mixed case
// i.e. we can have /info or /Info that will be different unless lScriptAliasMixedCase will be FALSE
FOR EACH xVal IN hDefault[ "ALIASES" ]
IF HB_ISSTRING( xVal )
hb_HSet( s_hScriptAliases, xVal:__enumKey(), xVal )
hb_HSet( s_hScriptAliases, IIF( lScriptAliasMixedCase, xVal:__enumKey(), Upper( xVal:__enumKey() ) ), xVal )
ENDIF
NEXT
@@ -350,6 +356,8 @@ FUNCTION MAIN( ... )
RETURN 3
ENDIF
//hb_ToOutDebug( "s_cDocumentRoot = %s, cDocumentRoot = %s\n\r", s_cDocumentRoot, cDocumentRoot )
IF nMaxThreads <= 0
nMaxThreads := MAX_RUNNING_THREADS
ENDIF
@@ -377,6 +385,7 @@ FUNCTION MAIN( ... )
s_nServiceConnections := 0
s_nMaxServiceConnections := 0
s_nTotServiceConnections := 0
s_cSessionPath := cSessionPath
// --------------------- Open log files -------------------------------------
@@ -721,7 +730,8 @@ STATIC FUNCTION ProcessConnection( /*@*/ nThreadId )
//hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest )
PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _COOKIE := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost
PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _COOKIE := HB_IHASH(), _SESSION := HB_IHASH()
PRIVATE _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost
t_cResult := ""
t_aHeader := {}
t_nStatusCode := 200
@@ -846,7 +856,8 @@ STATIC FUNCTION ServiceConnection( /*@*/ nThreadId )
//hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest )
PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _COOKIE := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost
PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _COOKIE := HB_IHASH(), _SESSION := HB_IHASH()
PRIVATE _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost
t_cResult := ""
t_aHeader := {}
t_nStatusCode := 200
@@ -1000,7 +1011,7 @@ STATIC FUNCTION ParseRequest( cRequest )
hb_HMerge( _POST, hVars )
hb_HMerge( _REQUEST, hVars )
ENDIF
m_cPost := cFields
m_cPost := cFields // TOFIX: Who needs this ?
ENDIF
//hb_toOutDebug( "POST: cFields = %s, hVars = %s, _POST = %s, _REQUEST = %s\n\r", cFields, hb_ValToExp( hVars ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ) )
@@ -1015,35 +1026,6 @@ STATIC FUNCTION ParseRequest( cRequest )
//hb_toOutDebug( "COOKIE: cFields = %s, hVars = %s, _COOKIE = %s, _REQUEST = %s\n\r", cFields, hb_ValToExp( hVars ), hb_ValToExp( _COOKIE ), hb_ValToExp( _REQUEST ) )
/*
// GET vars
FOR EACH cI IN uhttpd_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
// POST vars
IF "POST" $ Upper( _SERVER[ 'REQUEST_METHOD' ] )
//hb_ToOutDebug( "POST: %s\n\r", aTail( aRequest ) )
cPost := aTail( aRequest )
FOR EACH cI IN uhttpd_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" ] := uhttpd_split( ":", _HTTP_REQUEST[ "HOST" ], 1 )[ 1 ]
_SERVER[ "SERVER_SOFTWARE" ] := APP_NAME + " " + APP_VERSION + " (" + OS() + ")"
@@ -1061,6 +1043,12 @@ STATIC FUNCTION ParseRequest( cRequest )
//hb_ToOutDebug( "_COOKIE = %s\n\r", hb_ValToExp( _COOKIE ) )
//hb_ToOutDebug( "_HTTP_REQUEST = %s\n\r", hb_ValToExp( _HTTP_REQUEST ) )
// After defined all SERVER vars we can define a session
// SESSION - sessions ID is stored as a cookie value, normally as SESSIONID var name (this can be user defined)
t_oSession := uhttpd_SessionNew( "SESSION", s_cSessionPath )
t_oSession:Start()
RETURN .T.
@@ -1106,6 +1094,12 @@ STATIC FUNCTION MakeResponse()
t_cResult := "<html><body><h1>" + cReturnCode + "</h1></body></html>"
ENDSWITCH
//hb_ToOutDebug( "_SESSION = %s\n\r", hb_ValToExp( _SESSION ) )
// Close session - Autodestructor will NOT close it, because t_oSession is destroyed only at end of Thread
t_oSession:Close()
// t_oSession := NIL
WriteToConsole( cReturnCode )
cRet += cReturnCode + CR_LF
AEVAL( t_aHeader, {|x| cRet += x[1] + ": " + x[2] + CR_LF } )
@@ -1916,79 +1910,109 @@ STATIC PROCEDURE WriteToConsole( ... )
RETURN
STATIC FUNCTION ParseIni( cConfig )
LOCAL hIni := HB_ReadIni( cConfig )
LOCAL cSection, hSect, cKey, xVal, cVal
LOCAL hIni := hb_IniRead( cConfig, TRUE ) // TRUE = load all keys in MixedCase, redundant as it is default, but to remember
LOCAL cSection, hSect, cKey, xVal, cVal, nPos
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" => { => } ;
}
//hb_ToOutDebug( "cConfig = %s,\n\rhIni = %s\n\r", cConfig, hb_ValToExp( hIni ) )
// Define here what attributes we can have in ini config file and their defaults
// Please add all keys in uppercase. hDefaults is Case Insensitive
hDefault := hb_HSetCaseMatch( ;
{ ;
"MAIN" => { ;
"PORT" => LISTEN_PORT ,;
"DOCUMENT_ROOT" => EXE_Path() + "\home" ,;
"SHOW_INDEXES" => FALSE ,;
"SCRIPTALIASMIXEDCASE" => TRUE ,;
"SESSIONPATH" => EXE_Path() + "\sessions" ;
},;
"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" => { => } ;
}, FALSE )
//hb_ToOutDebug( "hDefault = %s\n\r", hb_ValToExp( hDefault ) )
// Now read changes from ini file and modify only admited keys
IF !Empty( hIni )
FOR EACH cSection IN hIni:Keys
cSection := Upper( cSection )
//hb_ToOutDebug( "cSection = %s\n\r", cSection )
IF cSection $ hDefault
hSect := hIni[ cSection ]
//hb_ToOutDebug( "hSect = %s\n\r", hb_ValToExp( hSect ) )
IF HB_IsHash( hSect )
FOR EACH cKey IN hSect:Keys
// Please, below check values MUST be uppercase
//hb_ToOutDebug( "cKey = %s\n\r", cKey )
IF cSection == "ALIASES"
xVal := hSect[ cKey ]
IF xVal <> NIL
hDefault[ cSection ][ cKey ] := xVal
ENDIF
ELSEIF cKey $ hDefault[ cSection ]
cVal := hSect[ cKey ]
ELSEIF ( cKey := Upper( cKey ) ) $ hDefault[ cSection ] // force cKey to be uppercase
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
IF ( nPos := hb_HScan( hSect, {|k| Upper( k ) == cKey } ) ) > 0
cVal := hb_HValueAt( hSect, nPos )
//hb_ToOutDebug( "cVal = %s\n\r", cVal )
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
CASE cKey == "SCRIPTALIASMIXEDCASE"
xVal := cVal
CASE cKey == "SESSIONPATH"
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
ENDIF
@@ -2067,6 +2091,10 @@ STATIC FUNCTION uhttpd_DefError( oError )
// Show alert box
#ifdef DEBUG_ACTIVE
hb_ToOutDebug( "ERROR: %s\n\r", cMessage + " " + cCallstack )
#endif
nChoice := 0
DO WHILE nChoice == 0