fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2012-11-05 03:23 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/gtwvg/*.prg
  * contrib/gtwvg/tests/*.prg
  * contrib/hbct/fcopy.prg
  * contrib/hbgd/gdimage.prg
  * contrib/hbhttpd/core.prg
  * contrib/hbhttpd/tests/eshop.prg
  * contrib/hbmysql/tests/test.prg
  * contrib/hbmysql/tmysql.prg
  * contrib/hbmzip/tests/*.prg
  * contrib/hbnetio/netiomt.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbsqlit3/hdbcsqlt.prg
  * contrib/hbwin/tests/*.prg
  * contrib/hbwin/win_tprn.prg
  * contrib/hbxpp/tthreadx.prg
  * contrib/hbziparc/ziparc.prg
  * contrib/xhb/*.prg
  * extras/gfspell/spell.prg
  * extras/gtwvw/tests/*.prg
  * extras/guestbk/testcgi.prg
  * extras/hbvpdf/hbvpdf.prg
  * extras/hbxlsxml/*.prg
  * extras/httpsrv/*.prg
  * extras/httpsrv/modules/showcounter.prg
  * src/debug/*.prg
  * src/rdd/*.prg
  * src/rdd/hbsix/*.prg
  * src/rdd/usrrdd/rdds/*.prg
  * src/rtl/*.prg
  * tests/*.prg
  * utils/hbtest/*.prg
  * website/samples/testcgi.prg.html
    * minor
This commit is contained in:
Viktor Szakats
2012-11-05 02:30:07 +00:00
parent 5e28e8a82a
commit 3a51126541
96 changed files with 555 additions and 526 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/extras/httpsrv/cgifunc.prg
View File

@@ -91,7 +91,7 @@ FUNCTION uhttpd_GetVars( cFields, cSeparator )
// now check if variable already exists. If yes and I have already another element
// with same name, then I will change it to an array
IF ( hb_HPos( hHashVars, cName ) ) > 0
IF !HB_ISARRAY( hHashVars[ cName ] )
IF ! HB_ISARRAY( hHashVars[ cName ] )
// Transform it to array
hHashVars[ cName ] := { hHashVars[ cName ] }
ENDIF
@@ -156,7 +156,7 @@ FUNCTION uhttpd_SplitUrl( cUrl )
cProto := ""
ENDIF
cUri += cProto + iif( !Empty( cProto ), "://", "" )
cUri += cProto + iif( ! Empty( cProto ), "://", "" )
// Now we have:
// [username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]]
@@ -347,7 +347,7 @@ FUNCTION uhttpd_URLEncode( cString, lComplete )
cChar == '/' .OR. cChar == ';' .OR. cChar == '_'
cRet += cChar
CASE iif( !lComplete, cChar == ':' .OR. cChar == '?' .OR. cChar == '=', .F. )
CASE iif( ! lComplete, cChar == ':' .OR. cChar == '?' .OR. cChar == '=', .F. )
cRet += cChar
OTHERWISE
@@ -663,7 +663,7 @@ PROCEDURE uhttpd_Die( cError )
IF cError != NIL // THEN OutStd( cError )
// __OutDebug( "cError: ", cError )
// IF !oCGI:HeaderSent()
// IF ! oCGI:HeaderSent()
// oCGI:WriteLN( CRLF2BR( cError ), CRLF2BR( CRLF() ) )
// //oCGI:WriteLN( CRLF2BR( hb_dumpVar(TConfigure():hConfig) ) )
// ENDIF
@@ -679,7 +679,7 @@ PROCEDURE uhttpd_Die( cError )
oErr:fileName := ""
oErr:osCode := 0
lError := Eval( ErrorBlock(), oErr )
IF !HB_ISLOGICAL( lError ) .OR. lError
IF ! HB_ISLOGICAL( lError ) .OR. lError
__errInHandler()
ENDIF
Break( oErr )
@@ -749,7 +749,7 @@ PROCEDURE uhttpd_WriteToLogFile( cString, cLog, lCreate )
IF cLog != NIL
IF !lCreate .AND. hb_FileExists( cLog )
IF ! lCreate .AND. hb_FileExists( cLog )
nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED )
ELSE
nHandle := hb_FCreate( cLog, FC_NORMAL, FO_READWRITE + FO_SHARED )
@@ -789,7 +789,7 @@ FUNCTION uhttpd_SplitFileName( cFile )
cSep := hb_ps()
hFile:FULLPATH := iif( !Empty( hFile:PATH ), iif( !( Right( hFile:PATH, Len( cSep ) ) == cSep ), hFile:PATH + cSep, hFile:PATH ), "" )
hFile:FULLPATH := iif( ! Empty( hFile:PATH ), iif( !( Right( hFile:PATH, Len( cSep ) ) == cSep ), hFile:PATH + cSep, hFile:PATH ), "" )
hFile:UNC := hFile:FULLPATH + hFile:FULLNAME
RETURN hFile

2
harbour/extras/httpsrv/modules/showcounter.prg
View File

@@ -69,7 +69,7 @@ FUNCTION HRBMAIN()
IF hb_HHasKey( _REQUEST, "w" )
cHtml := CreateCounter( hb_ntos( Val( _REQUEST[ "w" ] ) ) )
IF !Empty( cHtml )
IF ! Empty( cHtml )
uhttpd_SetHeader( "Content-Type", "image/gif" )
uhttpd_SetHeader( "Pragma", "no-cache" )
uhttpd_SetHeader( "Content-Disposition", "inline; filename=counter" + hb_ntos( hb_RandomInt( 100 ) ) + ".gif" )

20
harbour/extras/httpsrv/session.prg
View File

@@ -221,7 +221,7 @@ METHOD Start( cSID ) CLASS uhttpd_Session
// ::oCGI:ToLogFile( "::cSID = " + hb_cStr( ::cSID ), "/pointtoit/tmp/log.txt" )
ENDIF
IF !Empty( ::cSID ) .AND. !::CheckSID()
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
@@ -229,7 +229,7 @@ METHOD Start( cSID ) CLASS uhttpd_Session
lDefine_SID := .T.
ENDIF
IF !Empty( ::cSID ) .AND. !Empty( ::cReferrer_Check )
IF ! Empty( ::cSID ) .AND. ! Empty( ::cReferrer_Check )
// TODO: fix
// oUrl := TUrl():New( ::cReferrer_Check )
@@ -260,7 +260,7 @@ METHOD Start( cSID ) CLASS uhttpd_Session
ENDIF
// Is use_cookies set to false?
IF !::lUse_Cookies .AND. lSendCookie
IF ! ::lUse_Cookies .AND. lSendCookie
lDefine_SID := .T.
lSendCookie := .F.
ENDIF
@@ -281,7 +281,7 @@ METHOD Start( cSID ) CLASS uhttpd_Session
// Send caching headers
// Start session
IF !::Open( ::cSavePath, ::cName )
IF ! ::Open( ::cSavePath, ::cName )
uhttpd_Die( 'ERROR: Failed to open session file' )
ENDIF
@@ -316,7 +316,7 @@ METHOD Destroy() CLASS uhttpd_Session
ENDIF
// Destroy session
IF !Eval( ::bDestroy, ::cSID )
IF ! Eval( ::bDestroy, ::cSID )
RETURN .F.
ENDIF
@@ -336,11 +336,11 @@ METHOD Close() CLASS uhttpd_Session
cVal := ::Encode()
// Save session
IF !::Write( ::cSID, cVal )
IF ! ::Write( ::cSID, cVal )
uhttpd_Die( 'Session could not be saved.' )
ENDIF
// Close session
IF !Eval( ::bClose )
IF ! Eval( ::bClose )
uhttpd_Die( 'Session could not be closed.' )
ENDIF
::nActiveSessions--
@@ -479,7 +479,7 @@ METHOD GetSessionVars( aHashVars, cFields, cSeparator ) CLASS uhttpd_Session
AAdd( aNotSessionFlds, aField )
ENDIF
NEXT
IF !Empty( aNotSessionFlds )
IF ! Empty( aNotSessionFlds )
FOR EACH aField IN aNotSessionFlds
cFieldsNotInSession += aField[ 1 ] + "=" + aField[ 2 ] + "&"
NEXT
@@ -558,7 +558,7 @@ METHOD CheckSID( cSID, cCRCKey ) CLASS uhttpd_Session
// hb_toOutDebug( "cSID = %s, ::cSID = %s\n\r", hb_valtoexp( cSID ), hb_valtoexp( ::cSID ) )
IF !Empty( cSID )
IF ! Empty( cSID )
/* Calculate the key */
FOR n := 1 TO nLenSID - 5 // 5 = CRC Length
@@ -846,7 +846,7 @@ METHOD Encode() CLASS uhttpd_Session
ENDIF
RETURN iif( !Empty( aSerial ), hb_Serialize( aSerial ), NIL )
RETURN iif( ! Empty( aSerial ), hb_Serialize( aSerial ), NIL )
METHOD Decode( cData ) CLASS uhttpd_Session

58
harbour/extras/httpsrv/uhttpd.prg
View File

@@ -219,7 +219,7 @@ PROCEDURE Main( ... )
LOCAL nConsoleRows, nConsoleCols
LOCAL nCmdConsoleRows, nCmdConsoleCols
IF !hb_mtvm()
IF ! hb_mtvm()
? "I need multhread support. Please, recompile me!"
WAIT
ErrorLevel( 2 )
@@ -708,7 +708,7 @@ STATIC FUNCTION AcceptConnections()
ENDIF
// Waiting a connection from main application loop
IF !lQuitRequest
IF ! lQuitRequest
hb_mutexSubscribe( s_hmtxQueue,, @hSocket )
ENDIF
@@ -972,7 +972,7 @@ STATIC FUNCTION ProcessConnection()
// Here I remove this thread from thread queue as it is unnecessary, but only if there is not
// an external quit request. In this case application is quitting and I cannot resize array
// here to avoid race condition
IF !lQuitRequest .AND. hb_mutexLock( s_hmtxBusy )
IF ! lQuitRequest .AND. hb_mutexLock( s_hmtxBusy )
// hb_ToOutDebug( "Len( s_aRunningThreads ) = %i\n\r", Len( s_aRunningThreads ) )
IF ( nPos := AScan( s_aRunningThreads, hb_threadSelf() ) > 0 )
hb_ADel( s_aRunningThreads, nPos, .T. )
@@ -1117,7 +1117,7 @@ STATIC FUNCTION ServiceConnection()
// Here I remove this thread from thread queue as it is unnecessary, but only if there is not
// an external quit request. In this case application is quitting and I cannot resize array
// here to avoid race condition
IF !lQuitRequest .AND. hb_mutexLock( s_hmtxBusy )
IF ! lQuitRequest .AND. hb_mutexLock( s_hmtxBusy )
IF ( nPos := AScan( s_aServiceThreads, hb_threadSelf() ) > 0 )
hb_ADel( s_aServiceThreads, nPos, .T. )
s_nServiceThreads := Len( s_aServiceThreads )
@@ -1217,7 +1217,7 @@ STATIC FUNCTION ParseRequest( cRequest )
IF hb_HPos( _HTTP_REQUEST, "Host" ) == 0
// Try to determine Host name
IF !Empty( hUrl[ "HOST" ] )
IF ! Empty( hUrl[ "HOST" ] )
_HTTP_REQUEST[ "Host" ] := hUrl[ "HOST" ]
ELSE
_HTTP_REQUEST[ "Host" ] := ""
@@ -1232,7 +1232,7 @@ STATIC FUNCTION ParseRequest( cRequest )
// GET
cFields := _SERVER[ "QUERY_STRING" ]
IF !Empty( cFields )
IF ! Empty( cFields )
hVars := uhttpd_GetVars( cFields )
hb_HMerge( _GET, hVars )
hb_HMerge( _REQUEST, hVars )
@@ -1243,7 +1243,7 @@ STATIC FUNCTION ParseRequest( cRequest )
// POST
IF "POST" $ Upper( _SERVER[ 'REQUEST_METHOD' ] )
cFields := ATail( aRequest )
IF !Empty( cFields )
IF ! Empty( cFields )
hVars := uhttpd_GetVars( cFields )
hb_HMerge( _POST, hVars )
hb_HMerge( _REQUEST, hVars )
@@ -1255,7 +1255,7 @@ STATIC FUNCTION ParseRequest( cRequest )
// COOKIES
cFields := _SERVER[ 'HTTP_COOKIE' ]
IF !Empty( cFields )
IF ! Empty( cFields )
hVars := uhttpd_GetVars( cFields, ";" )
hb_HMerge( _COOKIE, hVars )
hb_HMerge( _REQUEST, hVars )
@@ -1862,7 +1862,7 @@ FUNCTION uhttpd_join( cSeparator, aData )
CASE "C"
CASE "M"; cRet += aData[ nI ]; EXIT
CASE "N"; cRet += LTrim( Str( aData[ nI ] ) ); EXIT
CASE "D"; cRet += iif( !Empty( aData[ nI ] ), DToC( aData[ nI ] ), "" ); EXIT
CASE "D"; cRet += iif( ! Empty( aData[ nI ] ), DToC( aData[ nI ] ), "" ); EXIT
ENDSWITCH
NEXT
@@ -1959,7 +1959,7 @@ STATIC FUNCTION uproc_default()
// Check for PATH_INFO: I will search if there is a physical file removing parts from right
cBaseFile := cScript
lFound := .F.
DO WHILE !Empty( cBaseFile )
DO WHILE ! Empty( cBaseFile )
// hb_toOutDebug( "cBaseFile = %s, cPathInfo = %s\n\r", cBaseFile, cPathInfo )
@@ -1987,7 +1987,7 @@ STATIC FUNCTION uproc_default()
// hb_toOutDebug( "Uscita: cBaseFile = %s, cPathInfo = %s\n\r", cBaseFile, cPathInfo )
// Found a script file name
IF lFound .AND. !Empty( cPathInfo )
IF lFound .AND. ! Empty( cPathInfo )
// Store PATH_INFO
_SERVER[ "PATH_INFO" ] := cPathInfo
_SERVER[ "PATH_TRANSLATED" ] := cFileName
@@ -2065,7 +2065,7 @@ STATIC PROCEDURE ShowServerStatus()
uhttpd_Write( '<br>Total Connections: ' + Str( s_nTotConnections ) )
cThreads := ""
AEval( s_aRunningThreads, {| e | cThreads += hb_ntos( hb_threadID( e ) ) + "," } )
cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
cThreads := "{ " + iif( ! Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
uhttpd_Write( '<br>Running Threads: ' + cThreads )
#ifndef FIXED_THREADS
@@ -2075,7 +2075,7 @@ STATIC PROCEDURE ShowServerStatus()
uhttpd_Write( '<br>Total Service Connections: ' + Str( s_nTotServiceConnections ) )
cThreads := ""
AEval( s_aServiceThreads, {| e | cThreads += hb_ntos( hb_threadID( e ) ) + "," } )
cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
cThreads := "{ " + iif( ! Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
uhttpd_Write( '<br>Service Threads: ' + cThreads )
#endif // FIXED_THREADS
@@ -2124,7 +2124,7 @@ STATIC PROCEDURE ShowFolder( cDir )
// hb_ToOutDebug( "cDir = %s, nPos = %i, cParentDir = %s\n\r", cDir, nPos, cParentDir )
IF !Empty( cParentDir )
IF ! Empty( cParentDir )
// Add parent directory
hb_AIns( aDir, 1, { "<parent>", 0, "", "", "D" }, .T. )
ENDIF
@@ -2163,7 +2163,7 @@ STATIC FUNCTION HRB_LoadFromFileEncrypted( cFile, cKey )
// Reverse function to save is:
PROCEDURE HRB_SaveToFileEncrypted( cHrbBody, cKey, cEncFileName )
LOCAL cFile
IF !Empty( cHrbBody )
IF ! Empty( cHrbBody )
cHrbBody := hb_zcompress( cHrbBody )
cHrbBody := sx_encrypt( cHrbBody, cKey )
hb_memowrit( cEncFileName, cHrbBody )
@@ -2340,7 +2340,7 @@ STATIC FUNCTION ParseIni( cConfig )
// hb_ToOutDebug( "hDefault = %s\n\r", hb_ValToExp( hDefault ) )
// Now read changes from ini file and modify only admited keys
IF !Empty( hIni )
IF ! Empty( hIni )
FOR EACH cSection IN hIni:Keys
cSection := Upper( cSection )
@@ -2390,12 +2390,12 @@ STATIC FUNCTION ParseIni( cConfig )
CASE cKey == "CONSOLE-COLS"
xVal := Val( cVal )
CASE cKey == "APPLICATION_ROOT"
IF !Empty( cVal )
IF ! Empty( cVal )
// Change APP_DIR macro with current exe path
xVal := cVal
ENDIF
CASE cKey == "DOCUMENT_ROOT"
IF !Empty( cVal )
IF ! Empty( cVal )
// After will change APP_DIR macro with application dir
// xVal := StrTran( cVal, "$(APP_DIR)", Exe_Path() )
xVal := cVal
@@ -2403,13 +2403,13 @@ STATIC FUNCTION ParseIni( cConfig )
CASE cKey == "SCRIPTALIASMIXEDCASE"
xVal := cVal
CASE cKey == "SESSIONPATH"
IF !Empty( cVal )
IF ! Empty( cVal )
// Change APP_DIR macro with current exe path
// xVal := StrTran( cVal, "$(APP_DIR)", Exe_Path() )
xVal := cVal
ENDIF
CASE cKey == "DIRECTORYINDEX"
IF !Empty( cVal )
IF ! Empty( cVal )
xVal := uhttpd_split( " ", AllTrim( cVal ) )
ENDIF
ENDCASE
@@ -2632,9 +2632,9 @@ STATIC FUNCTION ErrorMessage( oError )
// add either filename or operation
DO CASE
CASE !Empty( oError:filename )
CASE ! Empty( oError:filename )
cMessage += ": " + oError:filename
CASE !Empty( oError:operation )
CASE ! Empty( oError:operation )
cMessage += ": " + oError:operation
ENDCASE
@@ -2669,7 +2669,7 @@ STATIC FUNCTION Handler_Default( cFileName )
ELSEIF hb_DirExists( uhttpd_OSFileName( cFileName ) )
// 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
IF ! s_lIndexes
uhttpd_SetStatusCode( 403 )
t_cErrorMsg := "Display file list not allowed"
ELSE
@@ -2708,7 +2708,7 @@ STATIC FUNCTION Handler_ServerStatus()
uhttpd_Write( '<br>Total Connections: ' + Str( s_nTotConnections ) )
cThreads := ""
AEval( s_aRunningThreads, {| e | cThreads += hb_ntos( hb_threadID( e ) ) + "," } )
cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
cThreads := "{ " + iif( ! Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
uhttpd_Write( '<br>Running Threads: ' + cThreads )
#ifndef FIXED_THREADS
@@ -2718,7 +2718,7 @@ STATIC FUNCTION Handler_ServerStatus()
uhttpd_Write( '<br>Total Service Connections: ' + Str( s_nTotServiceConnections ) )
cThreads := ""
AEval( s_aServiceThreads, {| e | cThreads += hb_ntos( hb_threadID( e ) ) + "," } )
cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
cThreads := "{ " + iif( ! Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "<empty>" ) + " }"
uhttpd_Write( '<br>Service Threads: ' + cThreads )
#endif // FIXED_THREADS
@@ -2739,20 +2739,20 @@ STATIC FUNCTION Handler_HrbScript( cFileName )
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
// Lock HRB to avoid MT race conditions
IF !HRB_ACTIVATE_CACHE
IF ! HRB_ACTIVATE_CACHE
cHRBBody := HRB_LoadFromFile( uhttpd_OSFileName( cFileName ) )
ENDIF
IF hb_mutexLock( s_hmtxHRB )
BEGIN SEQUENCE
IF HRB_ACTIVATE_CACHE
// caching modules
IF !hb_HHasKey( s_hHRBModules, cFileName )
IF ! hb_HHasKey( s_hHRBModules, cFileName )
hb_HSet( s_hHRBModules, cFileName, HRB_LoadFromFile( uhttpd_OSFileName( cFileName ) ) )
ENDIF
cHRBBody := s_hHRBModules[ cFileName ]
ENDIF
WriteToConsole( "Executing: " + cFileName )
IF !Empty( pHRB := hb_hrbLoad( cHRBBody ) )
IF ! Empty( pHRB := hb_hrbLoad( cHRBBody ) )
// save current directory
cCurPath := hb_CurDrive() + hb_osDriveSeparator() + hb_ps() + CurDir()
@@ -2823,7 +2823,7 @@ STATIC FUNCTION Handler_CgiScript( cFileName )
ELSE
uhttpd_SetHeader( "Content-Type", "text/html" )
IF !Empty( xResult )
IF ! Empty( xResult )
uhttpd_Write( xResult )
ELSE
uhttpd_Write( "CGI Error" )