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

2012-10-31 13:25 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* include/harbour.hbx
    * fixes/changes to some function names

  * config/hb_c.cfg
    + updated to do better vertical aligment in
      structs, var declarations and assignments
    ; TODO: move this to /bin folder and add to 'install'-ed
            file list, rename to 'harbour.ucf'

  * src/debug/*.prg
  * src/rdd/*.prg
  * src/rdd/hbsix/*.prg
  * src/rdd/usrrdd/rdds/*.prg
  * src/rtl/*.prg
  * src/vm/*.prg
  * utils/hbi18n/hbi18n.prg
  * utils/hbmk2/hbmk2.prg
  * utils/hbmk2/examples/*.hb
  * contrib/hbblat/blatcls.prg
  * contrib/gtwvg/*.prg
  * contrib/gtwvg/tests/*.prg
  * contrib/hbblink/*.prg
  * contrib/hbcairo/tests/*.prg
  * contrib/hbcomm/*.prg
  * contrib/hbcomm/tests/*.prg
  * contrib/hbcups/tests/*.prg
  * contrib/hbcurl/tests/*.prg
  * contrib/hbexpat/*.prg
  * contrib/hbexpat/tests/*.prg
  * contrib/hbfbird/*.prg
  * contrib/hbfbird/tests/*.prg
  * contrib/hbfoxpro/*.prg
  * contrib/hbfship/*.prg
  * contrib/hbgd/*.prg
  * contrib/hbgd/tests/*.prg
  * contrib/hbgs/tests/*.prg
  * contrib/hbhpdf/*.prg
  * contrib/hbhpdf/tests/*.prg
  * contrib/hbhttpd/*.prg
  * contrib/hbhttpd/tests/*.prg
  * contrib/hblzf/tests/*.prg
  * contrib/hbmagic/tests/*.prg
  * contrib/hbmisc/*.prg
  * contrib/hbmisc/tests/*.prg
  * contrib/hbct/*.prg
  * contrib/hbct/tests/*.prg
  * contrib/hbmlzo/tests/*.prg
  * contrib/hbmxml/*.prg
  * contrib/hbmxml/tests/*.prg
  * contrib/hbmysql/*.prg
  * contrib/hbmysql/tests/*.prg
  * contrib/hboslib/*.prg
  * contrib/hbsms/*.prg
  * contrib/hbtinymt/tests/*.prg
  * contrib/hbtpathy/*.prg
  * contrib/hbtpathy/tests/*.prg
  * contrib/hbunix/tests/*.prg
  * contrib/hbxdiff/tests/*.prg
  * contrib/hbzebra/tests/*.prg
  * contrib/hbziparc/*.prg
  * contrib/hbziparc/tests/*.prg
  * contrib/rddads/*.prg
  * contrib/rddads/tests/*.prg
  * contrib/hbodbc/*.prg
  * contrib/hbodbc/tests/*.prg
  * contrib/hbpgsql/*.prg
  * contrib/hbpgsql/tests/*.prg
  * contrib/hbsqlit3/*.prg
  * contrib/hbsqlit3/tests/*.prg
  * contrib/hbwin/*.prg
  * contrib/hbwin/tests/*.prg
  * contrib/hbxpp/*.prg
  * contrib/hbxpp/tests/*.prg
  * contrib/hbxhb/*.prg
  * contrib/hbxhb/tests/*.prg
  * contrib/hbnetio/*.prg
  * contrib/hbnetio/utils/hbnetio/*.hb
  * contrib/hbnetio/utils/hbnetio/*.prg
  * contrib/hbtip/*.prg
  * contrib/hbtip/tests/*.prg
  * tests/usrrdd/*.prg
  * tests/funcarr.prg
  * extras/gfspell/spell.prg
  * extras/gtwvw/tests/*.prg
  * extras/guestbk/*.prg
  * extras/hbdoc/*.prg
  * extras/rddado/*.prg
  * extras/rddado/tests/*.prg
  * extras/hbxlsxml/*.prg
  * extras/httpsrv/*.prg
  * extras/httpsrv/modules/*.prg
  * extras/hbsuper/*.prg
  * extras/hbvpdf/*.prg
  * extras/hbvpdf/tests/*.prg
  * tests/*.prg (except some which are well formatted but in different/fast-typing style)
  * tests/*.hb
  * bin/*.hb
  * contrib/*.hb
  * config/*.hb
    * some manual formatting to better be able to verify
      changes made by hbformat and be friendlier with hbformat.
    * most files reformatted with hbformat using Maurizio's
      patch, with mostly minor manual corrections and verification.
      All hbformat changes for revised one-by-one.
    ! __DIR(): fixed to be unicode compatible
    ! __hbdoc_ToSource(): make sure to not generate line ending
      spaces in output.
    + hbmk2/hbrun: HBMK_WITH_GTXWC built-time option to include
      GTXWC. Useful for hbrun.
    * hbct tests: change to not use [] as string delimiter
    + added full prototypes to Array class declaration

  ; NOTE: Only these were not or not fully formatted:
          contrib/hbnetio/tests/*.prg
          tests/hbpptest/*.prg
          tests/mt/*.prg
          tests/multifnc/*.prg
          tests/rddtest/*.prg
          utils/hbmk2/hbmk2.prg (for the most part)
          src/rtl/tbrowse.prg (for the most part)
          utils/hbtest/*.prg
          *.ch, *.c, *.h

  * src/rtl/cdpapihb.c
  * src/rtl/hbadler.c
  * src/rtl/hbsocket.c
  * src/rtl/sha1.c
  * src/vm/classes.c
  * src/vm/dynsym.c
  * src/vm/garbage.c
  * src/debug/dbgentry.c
    * do not end macros with ';' to avoid uncrustify warning
      and wrong formatting as a consequence

  * src/compiler/cmdcheck.c
    * minor changes for uncrustify-friendliness

  * contrib/hbformat/utils/hbfmtcls.prg
  * contrib/hbformat/utils/hbformat.prg
    % optimizations in hbformat.prg
    ! fixed mask/filename handling to be
      multiplatform in hbformat.prg
    + added 'HBXList=' hbformat.ini parameter allowing
      to add any .hbx file for proper function name
      casing.
    ! fixed progress bar to display correctly

  * tests/speedstr.prg
    ! fixed to run as intended in unicode code
    * hbformatted

  - contrib/hbwin/tests/dlg.xml
  * contrib/hbwin/tests/dlg.rc
  - extras/gtwvw/tests/wvwtest9.xml
  + extras/gtwvw/tests/wvwtest9.mft
  * extras/gtwvw/tests/wvwtest9.rc
    * renamed manifest to have .mft extension
    % deleted unnecessary manifest
    * "Win32 API" -> "Windows API"
    ! deleted CPU arch from manifest

  * package/harb_win.mft
    * formatting

  * src/common/hbver.c
    + added version detection for win 8 and win server 2012
    * minor formatting/code cleanup

  * tests/gfx.prg
    * updated to run in script mode.
    ; TOFIX: it doesn't draw anything with GTWVT

  * tests/gfx.prg
  * tests/gtwin.prg
  * tests/gtxfnt.prg
  * tests/wvt_fs.prg
  * tests/wvtext.prg
    + support for GTXWC when run as script

  * doc/en/*.txt
  * contrib/hbct/doc/en/*.txt
  * contrib/hbgd/doc/en/*.txt
  * contrib/hbgt/doc/en/*.txt
  * contrib/hbmisc/doc/en/*.txt
  * contrib/hbnf/doc/en/*.txt
  * contrib/hbziparc/doc/en/*.txt
  * contrib/rddads/doc/en/*.txt
    ! fixed few broken tags reported by Carlos
    % deleted line ending spaces
    * some minor formatting

  * contrib/hbnf/*.c
  * contrib/hbnf/*.h
  * extras/gfspell/spellc.c
    * uncrustified with updated hb_c.cfg

  * contrib/hbnf/*.prg
  * contrib/hbnf/tests/*.prg
    * hbformatted with Mauriozo's patch.
    * a few manual corrections (avoiding #translates, using hb_ColorIndex())
      in general and to make hbformat happy.

  + contrib/hbnf/tests/menuto.prg
    + added sample code for MENU TO (adatped from docs)

  - src/rdd/dbfntx/dbfntx0.prg
    - deleted unused file with no enabled code in it

  * contrib/hbtip/tests/dbtohtml.prg
  * contrib/hbtip/tests/loadhtml.prg
  * contrib/hbtip/tests/tipmmail.prg
    * minor cleanups

  * contrib/hbtip/thtml.prg
    ! fixed typo due to s&r
    % use hb_memowrit()

  * src/rtl/tbrowse.prg
    * conditional code sorted to be hbformat friendly
    * some formatting

  * INSTALL
  * package/harbour.rb
  * package/mpkg_src_nightly.sh
  * package/mpkg_win_nightly.bat
  * package/updt_web_nightly.sh
  * website/changelog.html
  * website/faq/harbour17.html
  * website/faq/harbour27.html
  * website/index.html
  * website/menu/harbour-menu.js
    * updated repository URL to new sf.net one

  * tests/function.cfm
  * contrib/hbhttpd/tests/tpl/_main.tpl
  * contrib/hbtip/tests/tipmmail.prg
  * website/faq/*.html
  * website/samples/*.html
    * use utf-8 in html and email

  * contrib/hbrun/hbrun.hbp
    + support for HBMK_WITH_GTXWC

  * tests/rto_get.prg
  * tests/onidle.prg
  * tests/mousetst.prg
  * tests/wcecon.prg
  * tests/vmasort.prg
  - contrib/hbnf/tests/metaph.prg
    * minor cleanups

  * contrib/hbmysql/tests/test.prg
  * contrib/hbmysql/tests/dbf2mysq.prg
    % minor optimization, deleted outdated comment/line

  * src/compiler/harbour.yyc
  * src/compiler/harbour.y
    * minor formatting
This commit is contained in:
Viktor Szakats
2012-10-31 13:04:01 +00:00
parent 5e196aadf2
commit df2b7a9ebd
858 changed files with 19680 additions and 17448 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -53,7 +53,7 @@
#include "error.ch"
#include "fileio.ch"
//#define HB_USE_HBTIP // Use functions from HBTIP - TOIMPLEMENT
// #define HB_USE_HBTIP // Use functions from HBTIP - TOIMPLEMENT
#define CRLF ( Chr( 13 ) + Chr( 10 ) )
#xtranslate THROW( <oErr> ) => ( Eval( ErrorBlock(), <oErr> ), Break( <oErr> ) )
@@ -62,9 +62,11 @@
MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST
FUNCTION uhttpd_GetVars( cFields, cSeparator )
LOCAL hHashVars := { => }
LOCAL aField, cField, aFields
LOCAL cName, xValue
__defaultNIL( @cSeparator, "&" )
aFields := uhttpd_Split( cSeparator, cFields )
@@ -82,8 +84,8 @@ FUNCTION uhttpd_GetVars( cFields, cSeparator )
xValue := uhttpd_UrlDecode( aField[ 2 ] )
// Is it an array entry?
IF Substr( cName, Len( cName ) - 1 ) == "[]"
cName := Substr( cName, 1, Len( cName ) - 2 )
IF SubStr( cName, Len( cName ) - 1 ) == "[]"
cName := SubStr( cName, 1, Len( cName ) - 2 )
hHashVars[ cName ] := { xValue }
ELSE
// now check if variable already exists. If yes and I have already another element
@@ -93,7 +95,7 @@ FUNCTION uhttpd_GetVars( cFields, cSeparator )
// Transform it to array
hHashVars[ cName ] := { hHashVars[ cName ] }
ENDIF
aAdd( hHashVars[ cName ], xValue )
AAdd( hHashVars[ cName ], xValue )
ELSE
hHashVars[ cName ] := xValue
ENDIF
@@ -129,6 +131,7 @@ FUNCTION uhttpd_GetVars( cFields, cSeparator )
*/
FUNCTION uhttpd_SplitUrl( cUrl )
LOCAL hUrl := { => }
LOCAL nPos, cTemp, cUserNamePassword, cHostnamePort
LOCAL cProto, cHost, cPort, nPort, cUser, cPass, cPath, cQuery, cFragment
@@ -245,19 +248,20 @@ FUNCTION uhttpd_SplitUrl( cUrl )
ENDIF
// Assemble hash
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 )
hb_hSet( hUrl, "URI" , cURI )
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 )
hb_HSet( hUrl, "URI" , cURI )
// Prevents externals to add something else to this Hash
hb_HSetAutoAdd( hUrl, .F. )
RETURN hUrl
RETURN hUrl
/*
@@ -279,27 +283,28 @@ RETURN hUrl
*/
FUNCTION uhttpd_SplitString( cString, cDelim, lRemDelim, nCount )
LOCAL nEOLPos
LOCAL cBuffer := cString
LOCAL aLines := {}, cLine
LOCAL nHowMany := 0
__defaultNIL( @cDelim, ( CHR( 13 ) + CHR( 10 ) ) )
__defaultNIL( @cDelim, ( Chr( 13 ) + Chr( 10 ) ) )
__defaultNIL( @lRemDelim, .T. )
__defaultNIL( @nCount, -1 )
//WriteToLogFile( "Splitstring: " + cStr( cString ) )
// WriteToLogFile( "Splitstring: " + cStr( cString ) )
DO WHILE ( nEOLPos := AT( cDelim, cBuffer ) ) > 0
DO WHILE ( nEOLPos := At( cDelim, cBuffer ) ) > 0
nHowMany++
IF lRemDelim
cLine := LEFT( cBuffer, nEOLPos - 1 )
cLine := Left( cBuffer, nEOLPos - 1 )
ELSE
cLine := LEFT( cBuffer, ( nEOLPos + LEN( cDelim ) ) - 1 )
cLine := Left( cBuffer, ( nEOLPos + Len( cDelim ) ) - 1 )
ENDIF
//WriteToLogFile( "cBuffer, cDelim, nEOLPos, cLine: " + cStr( cBuffer ) + "," + cStr( cDelim ) + "," + cStr( nEOLPos ) + "," + cStr( cLine ) )
aAdd( aLines, cLine )
cBuffer := SubStr( cBuffer, nEOLPos + LEN( cDelim ) )
// WriteToLogFile( "cBuffer, cDelim, nEOLPos, cLine: " + cStr( cBuffer ) + "," + cStr( cDelim ) + "," + cStr( nEOLPos ) + "," + cStr( cLine ) )
AAdd( aLines, cLine )
cBuffer := SubStr( cBuffer, nEOLPos + Len( cDelim ) )
IF nCount > -1
IF nHowMany >= nCount
EXIT
@@ -309,17 +314,20 @@ FUNCTION uhttpd_SplitString( cString, cDelim, lRemDelim, nCount )
// Check last line
IF Len( cBuffer ) > 0
aAdd( aLines, cBuffer )
AAdd( aLines, cBuffer )
ENDIF
RETURN aLines
RETURN aLines
/************************************************************
* Encoding URL
*/
FUNCTION uhttpd_URLEncode( cString, lComplete )
#ifdef HB_USE_HBTIP
__defaultNIL( @lComplete, .T. )
RETURN TIPENCODERURL_ENCODE( cString, lComplete )
#else
LOCAL cRet := "", i, nVal, cChar
@@ -327,32 +335,34 @@ FUNCTION uhttpd_URLEncode( cString, lComplete )
__defaultNIL( @lComplete, .T. )
FOR i := 1 TO Len( cString )
cChar := SubStr( cString, i, 1)
cChar := SubStr( cString, i, 1 )
DO CASE
CASE cChar == " "
cRet += "+"
CASE cChar == " "
cRet += "+"
CASE ( cChar >= "A" .AND. cChar <= "Z" ) .OR. ;
( cChar >= "a" .AND. cChar <= "z" ) .OR. ;
( cChar >= "0" .AND. cChar <= "9" ) .OR. ;
cChar == '.' .OR. cChar == ',' .OR. cChar == '&' .OR. ;
cChar == '/' .OR. cChar == ';' .OR. cChar == '_'
cRet += cChar
CASE ( cChar >= "A" .AND. cChar <= "Z" ) .OR. ;
( cChar >= "a" .AND. cChar <= "z" ) .OR. ;
( cChar >= "0" .AND. cChar <= "9" ) .OR. ;
cChar == '.' .OR. cChar == ',' .OR. cChar == '&' .OR. ;
cChar == '/' .OR. cChar == ';' .OR. cChar == '_'
cRet += cChar
CASE iif( !lComplete, cChar == ':' .OR. cChar == '?' .OR. cChar == '=', .F. )
cRet += cChar
CASE iif( !lComplete, cChar == ':' .OR. cChar == '?' .OR. cChar == '=', .F. )
cRet += cChar
OTHERWISE
nVal := Asc( cChar )
cRet += "%" + hb_NumToHex( nVal )
OTHERWISE
nVal := Asc( cChar )
cRet += "%" + hb_NumToHex( nVal )
ENDCASE
NEXT
RETURN cRet
/************************************************************
* Decoding URL
*/
FUNCTION uhttpd_URLDecode( cString )
#ifdef HB_USE_HBTIP
RETURN TIPENCODERURL_DECODE( cString )
#else
@@ -361,20 +371,21 @@ FUNCTION uhttpd_URLDecode( cString )
FOR i := 1 TO Len( cString )
cChar := SubStr( cString, i, 1 )
DO CASE
CASE cChar == "+"
cRet += " "
CASE cChar == "+"
cRet += " "
CASE cChar == "%"
i ++
cRet += Chr( hb_HexToNum( SubStr( cString, i, 2 ) ) )
i ++
CASE cChar == "%"
i++
cRet += Chr( hb_HexToNum( SubStr( cString, i, 2 ) ) )
i++
OTHERWISE
cRet += cChar
OTHERWISE
cRet += cChar
ENDCASE
NEXT
RETURN cRet
#endif
@@ -389,35 +400,36 @@ FUNCTION uhttpd_URLDecode( cString )
*/
FUNCTION uhttpd_DateToGMT( dDate, cTime, nDayToAdd, nSecsToAdd )
LOCAL cStr
LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "dd-mm-yy" )
LOCAL nDay, nMonth, nYear, nDoW
LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }
LOCAL aMonths := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
__defaultNIL( @dDate, DATE() )
__defaultNIL( @cTime, TIME() )
__defaultNIL( @nDayToAdd, 0 )
__defaultNIL( @nSecsToAdd, 0 )
LOCAL cStr
LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "dd-mm-yy" )
LOCAL nDay, nMonth, nYear, nDoW
LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }
LOCAL aMonths := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
//Tracelog( "DateToGMT - StartingValue", dDate, cTime, nDayToAdd, nSecsToAdd )
__defaultNIL( @dDate, Date() )
__defaultNIL( @cTime, Time() )
__defaultNIL( @nDayToAdd, 0 )
__defaultNIL( @nSecsToAdd, 0 )
cTime := uhttpd_AddSecondsToTime( cTime, nSecsToAdd, @nDayToAdd )
dDate += nDayToAdd
// Tracelog( "DateToGMT - StartingValue", dDate, cTime, nDayToAdd, nSecsToAdd )
nDay := Day( dDate )
nMonth := Month( dDate )
nYear := Year( dDate)
nDoW := Dow( dDate )
cTime := uhttpd_AddSecondsToTime( cTime, nSecsToAdd, @nDayToAdd )
dDate += nDayToAdd
cStr := aDays[ nDow ] + ", " + StrZero( nDay, 2 ) + "-" + aMonths[ nMonth ] + "-" + ;
Right( StrZero( nYear, 4 ), 2 ) + " " + cTime + " GMT"
nDay := Day( dDate )
nMonth := Month( dDate )
nYear := Year( dDate )
nDoW := DoW( dDate )
//Tracelog( "DateToGMT", cStr )
cStr := aDays[ nDow ] + ", " + StrZero( nDay, 2 ) + "-" + aMonths[ nMonth ] + "-" + ;
Right( StrZero( nYear, 4 ), 2 ) + " " + cTime + " GMT"
Set( _SET_DATEFORMAT, cOldDateFormat )
// Tracelog( "DateToGMT", cStr )
RETURN cStr
Set( _SET_DATEFORMAT, cOldDateFormat )
RETURN cStr
/*
* AddSecondsToTime( cTime, nSecsToAdd, @nDaysAdded ) --> cNewTime
@@ -434,92 +446,107 @@ RETURN cStr
*/
FUNCTION uhttpd_AddSecondsToTime( cTime, nSecsToAdd, nDaysAdded )
LOCAL nOneDaySeconds := 86400 // 24 * 60 * 60
LOCAL cNewTime, nSecs
__defaultNIL( @cTime, TIME() )
__defaultNIL( @nSecsToAdd, 0 )
// nDaysAdded can be already valued, so below i add to this value
__defaultNIL( @nDaysAdded, 0 )
LOCAL nOneDaySeconds := 86400 // 24 * 60 * 60
LOCAL cNewTime, nSecs
IF nSecsToAdd != 0
nSecs := Secs( cTime ) + nSecsToAdd
nDaysAdded += Int( nSecs / nOneDaySeconds ) // Attention! nDaysAdded can be already filled
nSecs := nSecs - nDaysAdded
cNewTime := TSTRING( nSecs )
ELSE
cNewTime := cTime
ENDIF
__defaultNIL( @cTime, Time() )
__defaultNIL( @nSecsToAdd, 0 )
// nDaysAdded can be already valued, so below i add to this value
__defaultNIL( @nDaysAdded, 0 )
RETURN cNewTime
IF nSecsToAdd != 0
nSecs := Secs( cTime ) + nSecsToAdd
nDaysAdded += Int( nSecs / nOneDaySeconds ) // Attention! nDaysAdded can be already filled
nSecs := nSecs - nDaysAdded
cNewTime := TString( nSecs )
ELSE
cNewTime := cTime
ENDIF
RETURN cNewTime
FUNCTION uhttpd_TimeDiffAsSeconds( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
LOCAL aRetVal
__defaultNIL( @dDateEnd, DATE() )
__defaultNIL( @cTimeEnd, TIME() )
LOCAL aRetVal
aRetVal := FT_ELAPSED( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
__defaultNIL( @dDateEnd, Date() )
__defaultNIL( @cTimeEnd, Time() )
RETURN aRetVal[ 4, 2 ]
aRetVal := FT_ELAPSED( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
RETURN aRetVal[ 4, 2 ]
FUNCTION uhttpd_OutputString( cString, aTranslate, lProtected )
LOCAL cHtml
__defaultNIL( @lProtected, .F. )
__defaultNIL( @aTranslate, { { '"', '&quot;' }, { ' ', '&nbsp;' } } )
//TraceLog( "OutputString( cString, aTranslate, lProtected )", cString, aTranslate, lProtected )
IF lProtected
cHtml := uhttpd_HtmlSpecialChars( cString )
ELSE
cHtml := uhttpd_TranslateStrings( cString, aTranslate )
ENDIF
//TraceLog( "OutputString() = cHtml", cHtml )
LOCAL cHtml
RETURN cHtml
__defaultNIL( @lProtected, .F. )
__defaultNIL( @aTranslate, { { '"', '&quot;' }, { ' ', '&nbsp;' } } )
// TraceLog( "OutputString( cString, aTranslate, lProtected )", cString, aTranslate, lProtected )
IF lProtected
cHtml := uhttpd_HtmlSpecialChars( cString )
ELSE
cHtml := uhttpd_TranslateStrings( cString, aTranslate )
ENDIF
// TraceLog( "OutputString() = cHtml", cHtml )
RETURN cHtml
FUNCTION uhttpd_HtmlSpecialChars( cString, cQuote_style )
LOCAL aTranslations := { ;
{ '&', '&amp;' } ,;
{ '<', '&lt;' } ,;
{ '>', '&gt;' } ;
}
RETURN uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
LOCAL aTranslations := { ;
{ '&', '&amp;' },;
{ '<', '&lt;' },;
{ '>', '&gt;' } ;
}
RETURN uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
FUNCTION uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
__defaultNIL( @cQuote_style, "ENT_COMPAT" )
DO CASE
CASE cQuote_style == "ENT_COMPAT"
aAdd( aTranslations, { '"', '&quot;' } )
CASE cQuote_style == "ENT_QUOTES"
aAdd( aTranslations, { '"', '&quot;' } )
aAdd( aTranslations, { "'", '&#039;' } )
CASE cQuote_style == "ENT_NOQUOTES"
ENDCASE
RETURN uhttpd_TranslateStrings( cString, aTranslations )
__defaultNIL( @cQuote_style, "ENT_COMPAT" )
DO CASE
CASE cQuote_style == "ENT_COMPAT"
AAdd( aTranslations, { '"', '&quot;' } )
CASE cQuote_style == "ENT_QUOTES"
AAdd( aTranslations, { '"', '&quot;' } )
AAdd( aTranslations, { "'", '&#039;' } )
CASE cQuote_style == "ENT_NOQUOTES"
ENDCASE
RETURN uhttpd_TranslateStrings( cString, aTranslations )
FUNCTION uhttpd_CRLF2BR( cString )
LOCAL aTranslations := { ;
{ CRLF, '<br />' } ;
}
RETURN uhttpd_TranslateStrings( cString, aTranslations )
LOCAL aTranslations := { ;
{ CRLF, '<br />' } ;
}
RETURN uhttpd_TranslateStrings( cString, aTranslations )
FUNCTION uhttpd_TranslateStrings( cString, aTranslate )
LOCAL aTran
FOR EACH aTran IN aTranslate
IF aTran[1] $ cString
cString := StrTran( cString, aTran[1], aTran[2] )
LOCAL aTran
FOR EACH aTran IN aTranslate
IF aTran[ 1 ] $ cString
cString := StrTran( cString, aTran[ 1 ], aTran[ 2 ] )
ENDIF
NEXT
RETURN cString
NEXT
RETURN cString
FUNCTION uhttpd_StrStr( cString, cSearch )
LOCAL nPos := AT( cSearch, cString )
LOCAL cVal := iif( nPos > 0, SubStr( cString, nPos ), NIL )
RETURN cVal
LOCAL nPos := At( cSearch, cString )
LOCAL cVal := iif( nPos > 0, SubStr( cString, nPos ), NIL )
RETURN cVal
FUNCTION uhttpd_StrIStr( cString, cSearch )
RETURN uhttpd_StrStr( Upper( cSearch ), Upper( cString ) )
RETURN uhttpd_StrStr( Upper( cSearch ), Upper( cString ) )
FUNCTION uhttpd_HtmlEntities( cString, cQuote_style )
// LOCAL aTranslations := { ; // ATTENTION, this chars are visible only with OEM font
@@ -623,6 +650,7 @@ FUNCTION uhttpd_HtmlEntities( cString, cQuote_style )
LOCAL aTranslations := {}
LOCAL i
FOR i := 160 TO 255
aAdd( aTranslations, { hb_BChar( i ), "&#" + Str( i, 3 ) + ";" } )
NEXT
@@ -630,136 +658,145 @@ FUNCTION uhttpd_HtmlEntities( cString, cQuote_style )
RETURN uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
PROCEDURE uhttpd_Die( cError )
LOCAL oErr, lError
IF cError != NIL //THEN OutStd( cError )
//__OutDebug( "cError: ", cError )
//IF !oCGI:HeaderSent()
// oCGI:WriteLN( CRLF2BR( cError ), CRLF2BR( CRLF() ) )
// //oCGI:WriteLN( CRLF2BR( hb_dumpVar(TConfigure():hConfig) ) )
//ENDIF
// Generate Error
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_LIMIT
oErr:subSystem := "uhttpd_CGI"
oErr:subCode := 0
oErr:description := cError
oErr:canRetry := .F.
oErr:canDefault := .F.
oErr:fileName := ""
oErr:osCode := 0
lError := Eval( ErrorBlock(), oErr )
IF !HB_ISLOGICAL( lError ) .OR. lError
__ErrInHandler()
ENDIF
Break( oErr )
//QUIT
ELSE
QUIT
ENDIF
RETURN
LOCAL oErr, lError
IF cError != NIL // THEN OutStd( cError )
// __OutDebug( "cError: ", cError )
// IF !oCGI:HeaderSent()
// oCGI:WriteLN( CRLF2BR( cError ), CRLF2BR( CRLF() ) )
// //oCGI:WriteLN( CRLF2BR( hb_dumpVar(TConfigure():hConfig) ) )
// ENDIF
// Generate Error
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_LIMIT
oErr:subSystem := "uhttpd_CGI"
oErr:subCode := 0
oErr:description := cError
oErr:canRetry := .F.
oErr:canDefault := .F.
oErr:fileName := ""
oErr:osCode := 0
lError := Eval( ErrorBlock(), oErr )
IF !HB_ISLOGICAL( lError ) .OR. lError
__errInHandler()
ENDIF
Break( oErr )
// QUIT
ELSE
QUIT
ENDIF
RETURN
FUNCTION uhttpd_HTMLSpace( n )
RETURN replicate( "&nbsp;", n ) //"&#32;"
RETURN Replicate( "&nbsp;", n ) // "&#32;"
/* FROM FT LIB */
STATIC FUNCTION FT_ELAPSED(dStart, dEnd, cTimeStart, cTimeEnd)
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[4,2]
STATIC FUNCTION FT_ELAPSED( dStart, dEnd, cTimeStart, cTimeEnd )
IF HB_ISSTRING( dStart )
cTimeStart := dStart
dStart := DATE()
ELSEIF ! HB_ISDATE( dStart )
dStart := DATE()
ENDIF
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[ 4, 2 ]
IF HB_ISSTRING( dEnd )
cTimeEnd := dEnd
dEnd := DATE()
ELSEIF ! HB_ISDATE( dEnd )
dEnd := DATE()
ENDIF
IF HB_ISSTRING( dStart )
cTimeStart := dStart
dStart := Date()
ELSEIF ! HB_ISDATE( dStart )
dStart := Date()
ENDIF
iif( ! HB_ISSTRING( cTimeStart ), cTimeStart := '00:00:00', )
iif( ! HB_ISSTRING( cTimeEnd ) , cTimeEnd := '00:00:00', )
IF HB_ISSTRING( dEnd )
cTimeEnd := dEnd
dEnd := Date()
ELSEIF ! HB_ISDATE( dEnd )
dEnd := Date()
ENDIF
nTotalSec := (dEnd - dStart) * 86400 + ;
VAL(cTimeEnd) * 3600 + ;
VAL(SUBSTR(cTimeEnd,AT(':', cTimeEnd)+1,2)) * 60 + ;
iif(RAT(':', cTimeEnd) == AT(':', cTimeEnd), 0, ;
VAL(SUBSTR(cTimeEnd,RAT(':', cTimeEnd)+1))) - ;
VAL(cTimeStart) * 3600 - ;
VAL(SUBSTR(cTimeStart,AT(':', cTimeStart)+1,2)) * 60 - ;
iif(RAT(':', cTimeStart) == AT(':', cTimeStart), 0, ;
VAL(SUBSTR(cTimeStart,RAT(':', cTimeStart)+1)))
iif( ! HB_ISSTRING( cTimeStart ), cTimeStart := '00:00:00', )
iif( ! HB_ISSTRING( cTimeEnd ), cTimeEnd := '00:00:00', )
nTemp := nTotalSec
nTotalSec := ;
( dEnd - dStart ) * 86400 + ;
Val( cTimeEnd ) * 3600 + ;
Val( SubStr( cTimeEnd, At( ':', cTimeEnd ) + 1, 2 ) ) * 60 + ;
iif( RAt( ':', cTimeEnd ) == At( ':', cTimeEnd ), 0, ;
Val( SubStr( cTimeEnd, RAt( ':', cTimeEnd ) + 1 ) ) ) - ;
Val( cTimeStart ) * 3600 - ;
Val( SubStr( cTimeStart, At( ':', cTimeStart ) + 1, 2 ) ) * 60 - ;
iif( RAt( ':', cTimeStart ) == At( ':', cTimeStart ), 0, ;
Val( SubStr( cTimeStart, RAt( ':', cTimeStart ) + 1 ) ) )
FOR nCtr := 1 to 4
nConstant := iif(nCtr == 1, 86400, iif(nCtr == 2, 3600, iif( nCtr == 3, 60, 1)))
aRetVal[nCtr,1] := INT(nTemp/nConstant)
aRetval[nCtr,2] := nTotalSec / nConstant
nTemp -= aRetVal[nCtr,1] * nConstant
NEXT
nTemp := nTotalSec
RETURN aRetVal
FOR nCtr := 1 TO 4
nConstant := iif( nCtr == 1, 86400, iif( nCtr == 2, 3600, iif( nCtr == 3, 60, 1 ) ) )
aRetVal[ nCtr, 1 ] := Int( nTemp / nConstant )
aRetval[ nCtr, 2 ] := nTotalSec / nConstant
nTemp -= aRetVal[ nCtr, 1 ] * nConstant
NEXT
RETURN aRetVal
PROCEDURE uhttpd_WriteToLogFile( cString, cLog, lCreate )
LOCAL nHandle, cSep
cSep := hb_ps()
LOCAL nHandle, cSep
// __defaultNIL( @cLog, AppFullPath() + cSep + "logfile.log" )
__defaultNIL( @cLog, cSep + "tmp" + cSep + "logfile.log" )
__defaultNIL( @lCreate, .F. )
cSep := hb_ps()
IF cLog != NIL
// __defaultNIL( @cLog, AppFullPath() + cSep + "logfile.log" )
__defaultNIL( @cLog, cSep + "tmp" + cSep + "logfile.log" )
__defaultNIL( @lCreate, .F. )
IF !lCreate .AND. hb_FileExists( cLog )
nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED )
ELSE
nHandle := hb_FCreate( cLog, FC_NORMAL, FO_READWRITE + FO_SHARED )
//__OutDebug( "Create ", nHandle )
ENDIF
IF cLog != NIL
//cString := "PROCEDURE: " + ProcName( -2 ) + " " + cString
IF !lCreate .AND. hb_FileExists( cLog )
nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED )
ELSE
nHandle := hb_FCreate( cLog, FC_NORMAL, FO_READWRITE + FO_SHARED )
// __OutDebug( "Create ", nHandle )
ENDIF
IF nHandle > 0
FSeek( nHandle, 0, FS_END )
FWrite( nHandle, cString )
FWrite( nHandle, CRLF )
FClose( nHandle )
ENDIF
ENDIF
RETURN
// cString := "PROCEDURE: " + ProcName( -2 ) + " " + cString
IF nHandle > 0
FSeek( nHandle, 0, FS_END )
FWrite( nHandle, cString )
FWrite( nHandle, CRLF )
FClose( nHandle )
ENDIF
ENDIF
RETURN
/*********************************************************************************/
FUNCTION uhttpd_SplitFileName( cFile )
LOCAL hFile
LOCAL cPath, cName, cExt, cDrive, cSep
HB_FnameSplit( cFile, @cPath, @cName, @cExt, @cDrive )
hFile := { ;
"FILE" => cFile ,;
"DRIVE" => cDrive ,;
"PATH" => cPath ,;
"NAME" => cName ,;
"EXT" => cExt ,;
"FULLPATH" => NIL ,;
"FULLNAME" => cName + cExt ,;
"UNC" => NIL ;
}
hb_FNameSplit( cFile, @cPath, @cName, @cExt, @cDrive )
hFile := { ;
"FILE" => cFile,;
"DRIVE" => cDrive,;
"PATH" => cPath,;
"NAME" => cName,;
"EXT" => cExt,;
"FULLPATH" => NIL,;
"FULLNAME" => cName + cExt,;
"UNC" => NIL ;
}
cSep := hb_ps()
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
RETURN hFile
FUNCTION uhttpd_AppFullPath()
LOCAL hExeFile := uhttpd_SplitFileName( HB_ARGV(0) )
LOCAL hExeFile := uhttpd_SplitFileName( hb_argv( 0 ) )
LOCAL cPrgFullPath := hExeFile:FULLPATH
LOCAL cPath, cSep
@@ -770,11 +807,14 @@ FUNCTION uhttpd_AppFullPath()
ELSE
cPath := cPrgFullPath
ENDIF
RETURN cPath
RETURN cPath
FUNCTION uhttpd_AppFullName()
LOCAL hExeFile := uhttpd_SplitFileName( HB_ARGV(0) )
RETURN hExeFile:FULLNAME
LOCAL hExeFile := uhttpd_SplitFileName( hb_argv( 0 ) )
RETURN hExeFile:FULLNAME
FUNCTION uhttpd_CStrToVal( cExp, cType )
@@ -784,30 +824,30 @@ FUNCTION uhttpd_CStrToVal( cExp, cType )
ENDIF
SWITCH cType
CASE 'C'
RETURN cExp
CASE 'C'
RETURN cExp
CASE 'P'
RETURN hb_HexToNum( cExp )
CASE 'P'
RETURN hb_HexToNum( cExp )
CASE 'D'
IF cExp[3] >= '0' .AND. cExp[3] <= '9' .AND. cExp[5] >= '0' .AND. cExp[5] <= '9'
RETURN sToD( cExp )
ELSE
RETURN cToD( cExp )
ENDIF
CASE 'D'
IF cExp[ 3 ] >= '0' .AND. cExp[ 3 ] <= '9' .AND. cExp[ 5 ] >= '0' .AND. cExp[ 5 ] <= '9'
RETURN SToD( cExp )
ELSE
RETURN CToD( cExp )
ENDIF
CASE 'L'
RETURN iif( cExp[1] == 'T' .OR. cExp[1] == 'Y' .OR. cExp[2] == 'T' .OR. cExp[2] == 'Y', .T., .F. )
CASE 'L'
RETURN iif( cExp[ 1 ] == 'T' .OR. cExp[ 1 ] == 'Y' .OR. cExp[ 2 ] == 'T' .OR. cExp[ 2 ] == 'Y', .T., .F. )
CASE 'N'
RETURN Val( cExp )
CASE 'N'
RETURN Val( cExp )
CASE 'M'
RETURN cExp
CASE 'M'
RETURN cExp
CASE 'U'
RETURN NIL
CASE 'U'
RETURN NIL
/*
CASE 'A'
@@ -820,18 +860,19 @@ FUNCTION uhttpd_CStrToVal( cExp, cType )
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
*/
OTHERWISE
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
OTHERWISE
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
ENDSWITCH
RETURN NIL
RETURN NIL
FUNCTION uhttpd_GetField( cVar, cType )
LOCAL xVal
LOCAL nPos := hb_HPos( _Request, cVar )
IF nPos > 0 //cVar IN ::h_Request:Keys
xVal := hb_HValueAt( _Request, nPos ) //::h_Request[ cVar ]
IF nPos > 0 // cVar IN ::h_Request:Keys
xVal := hb_HValueAt( _Request, nPos ) // ::h_Request[ cVar ]
IF Empty( xVal )
xVal := NIL
ENDIF
@@ -840,18 +881,24 @@ FUNCTION uhttpd_GetField( cVar, cType )
ENDIF
ENDIF
RETURN xVal
RETURN xVal
FUNCTION uhttpd_SetField( cVar, cVal )
LOCAL xVal := uhttpd_HGetValue( _Request, cVar )
_Request[ cVar ] := cVal
RETURN xVal
RETURN xVal
FUNCTION uhttpd_HGetValue( hHash, cKey )
LOCAL nPos
LOCAL xVal
IF hHash != NIL
xVal := iif( ( nPos := hb_HPos( hHash, cKey )) == 0, NIL, hb_HValueAt( hHash, nPos) )
xVal := iif( ( nPos := hb_HPos( hHash, cKey ) ) == 0, NIL, hb_HValueAt( hHash, nPos ) )
ENDIF
//RETURN iif( cKey IN hHash:Keys, hHash[ cKey ], NIL )
// RETURN iif( cKey IN hHash:Keys, hHash[ cKey ], NIL )
RETURN xVal

56
harbour/extras/httpsrv/cookie.prg
View File

@@ -55,7 +55,7 @@
MEMVAR _COOKIE
FUNCTION uhttpd_CookieNew( cDomain, cPath, nExpireDays, nExpireSecs )
RETURN uhttpd_Cookie():New( cDomain, cPath, nExpireDays, nExpireSecs )
RETURN uhttpd_Cookie():New( cDomain, cPath, nExpireDays, nExpireSecs )
CLASS uhttpd_Cookie
@@ -83,6 +83,7 @@ ENDCLASS
// ------------------------------
METHOD SetCookieDefaults( cDomain, cPath, nExpireDays, nExpireSecs ) CLASS uhttpd_Cookie
IF cDomain != NIL
::cDomain := cDomain
ENDIF
@@ -95,9 +96,11 @@ METHOD SetCookieDefaults( cDomain, cPath, nExpireDays, nExpireSecs ) CLASS uhttp
IF nExpireSecs != NIL
::nExpireSecs := nExpireSecs
ENDIF
RETURN NIL
METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure, lHttpOnly ) CLASS uhttpd_Cookie
LOCAL cStr, nPos, nCookies
__defaultNIL( @cDomain, ::cDomain )
@@ -112,24 +115,24 @@ METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure, lHttpO
IF xValue != NIL
// Search if a cookie already exists
// case sensitive
IF ( nPos := aScan( ::aCookies, {| e | e[ 1 ] == cCookieName } ) ) > 0
::aCookies[ nPos ][ 2 ] := uhttpd_UrlEncode( hb_cStr( xValue ) )
// case sensitive
IF ( nPos := AScan( ::aCookies, {| e | e[ 1 ] == cCookieName } ) ) > 0
::aCookies[ nPos ][ 2 ] := uhttpd_UrlEncode( hb_CStr( xValue ) )
ELSE
aAdd( ::aCookies, { cCookieName, uhttpd_UrlEncode( hb_cStr( xValue ) ) } )
AAdd( ::aCookies, { cCookieName, uhttpd_UrlEncode( hb_CStr( xValue ) ) } )
ENDIF
ELSE
IF ( nPos := aScan( ::aCookies, {| e | e[ 1 ] == cCookieName } ) ) > 0
hb_aDel( ::aCookies, nPos, .T. )
IF ( nPos := AScan( ::aCookies, {| e | e[ 1 ] == cCookieName } ) ) > 0
hb_ADel( ::aCookies, nPos, .T. )
ENDIF
ENDIF
// Rebuild cookie string as per RFC2616 (comma separated list)
cStr := ""
nCookies := Len( ::aCookies )
aEval( ::aCookies, {| e, i | cStr += e[ 1 ] + "=" + e[ 2 ] + iif( i < nCookies, ",", "" ) } )
AEval( ::aCookies, {| e, i | cStr += e[ 1 ] + "=" + e[ 2 ] + iif( i < nCookies, ",", "" ) } )
//cStr := cCookieName + "=" + uhttpd_UrlEncode( hb_cStr( xValue ) )
// cStr := cCookieName + "=" + uhttpd_UrlEncode( hb_cStr( xValue ) )
IF cDomain != NIL
cStr += "; domain=" + cDomain
@@ -141,45 +144,50 @@ METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure, lHttpO
cStr += "; expires=" + cExpires
ENDIF
IF HB_ISLOGICAL( lSecure ) .AND. lSecure
cStr += "; secure"
cStr += "; secure"
ENDIF
// Send the header
//uhttpd_SetHeader( "Set-Cookie", cStr, .F. )
// uhttpd_SetHeader( "Set-Cookie", cStr, .F. )
uhttpd_SetHeader( "Set-Cookie", cStr )
RETURN NIL
METHOD DeleteCookie( cCookieName, cDomain, cPath, lSecure ) CLASS uhttpd_Cookie
LOCAL cExpires := uhttpd_DateToGMT( DATE() - 1 ) // Setting date in the past delete cookie
LOCAL cExpires := uhttpd_DateToGMT( Date() - 1 ) // Setting date in the past delete cookie
::SetCookie( cCookieName, "", cDomain, cPath, cExpires, lSecure )
RETURN NIL
METHOD DeleteAllCookies( cDomain, cPath, lSecure ) CLASS uhttpd_Cookie
LOCAL cCookieName
FOR EACH cCookieName IN _COOKIE:Keys
//::DeleteCookie( Substr( cCookieName, 2 ), cDomain, cPath, lSecure )
::DeleteCookie( cCookieName, cDomain, cPath, lSecure )
// ::DeleteCookie( Substr( cCookieName, 2 ), cDomain, cPath, lSecure )
::DeleteCookie( cCookieName, cDomain, cPath, lSecure )
NEXT
RETURN NIL
METHOD GetCookie( cCookieName ) CLASS uhttpd_Cookie
LOCAL cHeader, cRet
LOCAL nPos := 1
DO WHILE .T.
IF ( cHeader := uhttpd_GetHeader( "Set-Cookie", @nPos ) ) != NIL
IF cHeader == cCookieName
cRet := cHeader
EXIT
ELSE
nPos++
ENDIF
ELSE
EXIT
ENDIF
IF ( cHeader := uhttpd_GetHeader( "Set-Cookie", @nPos ) ) != NIL
IF cHeader == cCookieName
cRet := cHeader
EXIT
ELSE
nPos++
ENDIF
ELSE
EXIT
ENDIF
ENDDO
RETURN cRet

7
harbour/extras/httpsrv/modules/cookie.prg
View File

@@ -55,15 +55,16 @@
MEMVAR _REQUEST
#xcommand TEXT INTO <v> => #pragma __cstream|<v>+=%s
//#pragma escapedstrings = on
// #pragma escapedstrings = on
FUNCTION HRBMAIN()
LOCAL cHtml := ""
LOCAL cCookie := uhttpd_GetField( "mycookie" )
LOCAL cAction := uhttpd_GetField( "action" )
LOCAL oCookie
//hb_ToOutDebug( "cCookie = %s, cAction = %s\n\r", hb_ValToExp( cCookie ), cAction )
// hb_ToOutDebug( "cCookie = %s, cAction = %s\n\r", hb_ValToExp( cCookie ), cAction )
hb_default( @cCookie, "" )
hb_default( @cAction, "" )
@@ -108,7 +109,7 @@ Pressing button you will redirect to /info page. Look at COOKIE values.
oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
oCookie:SetCookie( "mycookie", cCookie )
uhttpd_SetHeader( "Location", "/info" )
//uhttpd_Write( "cookie set <a href='/info'>Go to info page</a>" )
// uhttpd_Write( "cookie set <a href='/info'>Go to info page</a>" )
RETURN NIL
ENDIF

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

@@ -104,10 +104,10 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
hb_default( @cBaseImage, "57chevy.gif" )
IF ! hb_FileExists( IMAGES_IN + cBaseImage )
//hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
//THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
// hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
// THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
RETURN NIL
//ELSE
// ELSE
// hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' FOUND" )
ENDIF
@@ -156,7 +156,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
/* 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" )
// 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() )
@@ -184,7 +184,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
// 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" )
// 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

18
harbour/extras/httpsrv/modules/tableservletdb.prg
View File

@@ -154,15 +154,15 @@ METHOD Open() CLASS TableManager
LOCAL cDBF := ::cTable
//hb_ToOutDebug( "CurPath = %s", hb_CurDrive() + hb_osDriveSeparator() + hb_ps() + CurDir() )
// hb_ToOutDebug( "CurPath = %s", hb_CurDrive() + hb_osDriveSeparator() + hb_ps() + CurDir() )
//hb_ToOutDebug( "before: cDBF = %s, Used() = %s\n", cDBF, Used() )
// hb_ToOutDebug( "before: cDBF = %s, Used() = %s\n", cDBF, Used() )
IF ! ::lOpened
CLOSE ALL
USE ( cDBF ) ALIAS table SHARED NEW
//hb_ToOutDebug( "after: cDBF = %s, Used() = %s\n", cDBF, Used() )
// hb_ToOutDebug( "after: cDBF = %s, Used() = %s\n", cDBF, Used() )
::lOpened := Used()
ENDIF
@@ -182,8 +182,8 @@ METHOD READ() CLASS TableManager
IF ::lOpened
table->( dbGoTop() )
//n := 0
DO WHILE table->( !EOF() ) //.AND. ++n < 50
// n := 0
DO WHILE table->( !Eof() ) // .AND. ++n < 50
hMap := { => }
hMap[ "recno" ] := StrZero( table->( RecNo() ), 4 )
@@ -252,7 +252,7 @@ METHOD getXmlData( page ) CLASS TableManager
// Check the validity of the page index.
IF startIndex < 0 .OR. startIndex >= stopIndex
//throw new IllegalArgumentException("Page index is out of bounds.");
// throw new IllegalArgumentException("Page index is out of bounds.");
ENDIF
xml := BasicXML():New()
@@ -371,9 +371,9 @@ METHOD xmlEncode( input ) CLASS TableManager
// CASE ' '
// out += "&nbsp;"
// EXIT
CASE Chr( 9 ) //E'\t'
CASE Chr( 13 ) //E'\r'
CASE Chr( 10 ) //E'\n'
CASE Chr( 9 ) // E'\t'
CASE Chr( 13 ) // E'\r'
CASE Chr( 10 ) // E'\n'
out += c
EXIT
OTHERWISE

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

@@ -63,7 +63,7 @@ MEMVAR _COOKIE, _SESSION, _REQUEST, _SERVER
#define MY_CRCKEY "UhTTpK3y76"
FUNCTION uhttpd_SessionNew( cSessionName, cSessionPath )
RETURN uhttpd_Session():New( cSessionName, cSessionPath )
RETURN uhttpd_Session():New( cSessionName, cSessionPath )
CLASS uhttpd_Session
@@ -102,7 +102,7 @@ CLASS uhttpd_Session
METHOD Encode() // INLINE HB_Serialize( _SESSION )
METHOD Decode()
HIDDEN:
HIDDEN:
VAR oCookie
VAR cSID
@@ -112,7 +112,7 @@ CLASS uhttpd_Session
VAR nGc_Probability INIT 33 // Every 1/3 of checks i'll lunch Session GC
VAR nGc_MaxLifeTime INIT 1440 // seconds - Number of seconds after gc can delete a session
// VAR cSerialize_Handler INIT "HBHTMLLIB"
VAR nCookie_LifeTime INIT 3600 //0 // Number of seconds to keep cookie, 0 = until browser is closed
VAR nCookie_LifeTime INIT 3600 // 0 // Number of seconds to keep cookie, 0 = until browser is closed
VAR cCookie_Path INIT "/"
VAR cCookie_Domain
VAR lCookie_Secure INIT .F.
@@ -126,12 +126,12 @@ CLASS uhttpd_Session
VAR lUse_Trans_SID INIT .F. // .F. = no SID appended to URL
// Session Storage code blocks
VAR bOpen //INIT {| cPath, cName | ::SessionOpen( cPath, cName ) }
VAR bClose //INIT {|| ::SessionClose() }
VAR bRead //INIT {| cID | ::SessionRead( cID ) }
VAR bWrite //INIT {| cID, cData | ::SessionWrite( cID, cData ) }
VAR bDestroy //INIT {| cID | ::SessionDestroy( cID ) }
VAR bGC //INIT {| nMaxLifeTime | ::SessionGC( nMaxLifeTime ) }
VAR bOpen // INIT {| cPath, cName | ::SessionOpen( cPath, cName ) }
VAR bClose // INIT {|| ::SessionClose() }
VAR bRead // INIT {| cID | ::SessionRead( cID ) }
VAR bWrite // INIT {| cID, cData | ::SessionWrite( cID, cData ) }
VAR bDestroy // INIT {| cID | ::SessionDestroy( cID ) }
VAR bGC // INIT {| nMaxLifeTime | ::SessionGC( nMaxLifeTime ) }
VAR nFileRetry INIT 10 // How many time try to open / write / delete file in case of error
VAR nFileWait INIT 500 // How many milliseconds have to wait before retry
@@ -156,12 +156,12 @@ ENDCLASS
METHOD New( cSessionName, cSessionPath ) CLASS uhttpd_Session
//hb_ToOutDebug( "cSessionName = %s, cSessionPath = %s\n\r", cSessionName, cSessionPath )
// hb_ToOutDebug( "cSessionName = %s, cSessionPath = %s\n\r", cSessionName, cSessionPath )
__defaultNIL( @cSessionName, "SESSION" )
__defaultNIL( @cSessionPath, ::cSavePath )
//::cSID := ::GenerateSID()
// ::cSID := ::GenerateSID()
// As default we will use FILES - this is FILE version
::bOpen := {| cPath, cName | ::SessionOpen( cPath, cName ) }
@@ -191,6 +191,7 @@ METHOD New( cSessionName, cSessionPath ) CLASS uhttpd_Session
RETURN Self
METHOD Start( cSID ) CLASS uhttpd_Session
LOCAL lSendCookie := .T.
LOCAL lDefine_SID := .T.
LOCAL xVal, nRand, nPos
@@ -200,9 +201,9 @@ METHOD Start( cSID ) CLASS uhttpd_Session
::cSID := cSID
ENDIF
//hb_toOutDebug( "cSID = %s, ::cSID = %s\n\r", cSID, ::cSID )
// hb_toOutDebug( "cSID = %s, ::cSID = %s\n\r", cSID, ::cSID )
//TraceLog( "Active Sessions : " + hb_cStr( ::nActiveSessions ) )
// TraceLog( "Active Sessions : " + hb_cStr( ::nActiveSessions ) )
IF ::nActiveSessions != 0
RETURN .F.
@@ -210,19 +211,19 @@ METHOD Start( cSID ) CLASS uhttpd_Session
// Start checking ID from global vars
IF ( nPos := hb_HPos( _REQUEST, ::cName ) ) > 0
//::cSID := ::oCGI:h_Request[ ::cName ]
// ::cSID := ::oCGI:h_Request[ ::cName ]
::cSID := hb_HValueAt( _REQUEST, nPos )
IF HB_ISARRAY( ::cSID )
::cSID := ::cSID[ 1 ] // Get Only 1-st
ENDIF
lSendCookie := .F.
lDefine_SID := .F.
//::oCGI:ToLogFile( "::cSID = " + hb_cStr( ::cSID ), "/pointtoit/tmp/log.txt" )
// ::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" )
// ::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 := .T.
lDefine_SID := .T.
@@ -231,12 +232,12 @@ METHOD Start( cSID ) CLASS uhttpd_Session
IF !Empty( ::cSID ) .AND. !Empty( ::cReferrer_Check )
// TODO: fix
//oUrl := TUrl():New( ::cReferrer_Check )
// oUrl := TUrl():New( ::cReferrer_Check )
hUrl := uhttpd_SplitUrl( ::cReferrer_Check )
//hb_ToOutDebug( "hUrl = %s\n\r", hb_ValToExp( hUrl ) )
// hb_ToOutDebug( "hUrl = %s\n\r", hb_ValToExp( hUrl ) )
//IF !( oUrl:cServer == _SERVER[ "SERVER_NAME" ] )
// IF !( oUrl:cServer == _SERVER[ "SERVER_NAME" ] )
IF !( hUrl[ "HOST" ] == _SERVER[ "SERVER_NAME" ] )
::cSID := NIL // invalidate current SID, i'll generate a new one
lSendCookie := .T.
@@ -266,7 +267,7 @@ METHOD Start( cSID ) CLASS uhttpd_Session
// Should we send a cookie?
IF lSendCookie
::oCookie:SetCookie( ::cName, ::cSID, ::cCookie_Domain, ::cCookie_Path, uhttpd_DateToGMT(,,,::nCookie_LifeTime), ::lCookie_Secure )
::oCookie:SetCookie( ::cName, ::cSID, ::cCookie_Domain, ::cCookie_Path, uhttpd_DateToGMT(,,, ::nCookie_LifeTime ), ::lCookie_Secure )
ENDIF
// Should we define the SID?
@@ -280,27 +281,27 @@ 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
// Read session data
IF !( ( xVal := ::Read( ::cSID ) ) == NIL )
//TraceLog( "Read session data - xVal", xVal )
//::oCGI:ToLogFile( "xval = " + hb_cStr( xVal ), "/pointtoit/tmp/log.txt" )
// 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" )
// ::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 ) )
// TraceLog( "::nGc_probability = " + hb_cStr( ::nGc_probability ) )
IF ::nGc_probability > 0
nRand := HB_RandomInt( 1, 100 )
//TraceLog( "::nGc_probability - nRand = " + hb_cStr( nRand ) )
nRand := hb_RandomInt( 1, 100 )
// TraceLog( "::nGc_probability - nRand = " + hb_cStr( nRand ) )
IF nRand <= ::nGc_Probability
::GC( ::nGc_MaxLifeTime )
ENDIF
@@ -322,9 +323,10 @@ METHOD Destroy() CLASS uhttpd_Session
RETURN .T.
METHOD Close() CLASS uhttpd_Session
LOCAL cVal
//TraceLog( "Session Close() - oCGI:h_Session", DumpValue( oCGI:h_Session ) )
// TraceLog( "Session Close() - oCGI:h_Session", DumpValue( oCGI:h_Session ) )
IF ::nActiveSessions == 0
RETURN .F.
@@ -339,7 +341,7 @@ METHOD Close() CLASS uhttpd_Session
ENDIF
// Close session
IF !Eval( ::bClose )
uhttpd_Die('Session could not be closed.')
uhttpd_Die( 'Session could not be closed.' )
ENDIF
::nActiveSessions--
@@ -359,11 +361,15 @@ METHOD GC( nMaxLifeTime ) CLASS uhttpd_Session
METHOD IsRegistered() CLASS uhttpd_Session
LOCAL lRegistered := .F.
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
@@ -371,9 +377,11 @@ METHOD CacheLimiter( cNewLimiter ) CLASS uhttpd_Session
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
::nCookie_LifeTime := nLifeTime
ENDIF
@@ -386,35 +394,43 @@ METHOD SetCookieParams( nLifeTime, cPath, cDomain, lSecure ) CLASS uhttpd_Sessi
IF lSecure != NIL
::lCookie_Secure := lSecure
ENDIF
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 )
::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 )
// 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()
// 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
__defaultNIL( @cSeparator, "&" )
aFields := hb_regexSplit( cSeparator, cFields )
@@ -425,53 +441,53 @@ METHOD GetSessionVars( aHashVars, cFields, cSeparator ) CLASS uhttpd_Session
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
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 ) )", ;
// 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 )
cName := SubStr( cSessVarName, Len( cSessPrefix ) + 1 )
xValue := uhttpd_UrlDecode( aField[ 2 ] )
// TraceLog( "SESSION: cName, xValue", cName, xValue )
//Tracelog( "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 }
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
// aHashVars:Keys( cName )
// __ObjSendMsg( aHashVars, "_" + cName, { xValue } ) // variant from Ron to handle 1 lenght name
ELSE
//aHashVars[ cName ] := xValue
// aHashVars[ cName ] := xValue
aHashVars[ cName ] := xValue
//aHashVars:Keys( cName )
//__ObjSendMsg( aHashVars, "_" + cName, xValue ) // variant from Ron to handle 1 lenght name
// aHashVars:Keys( cName )
// __ObjSendMsg( aHashVars, "_" + cName, xValue ) // variant from Ron to handle 1 lenght name
ENDIF
//Tracelog( "aHashVars, cName, xValue", DumpValue( aHashVars ), cName, xValue )
// Tracelog( "aHashVars, cName, xValue", DumpValue( aHashVars ), cName, xValue )
ELSE
aAdd( aNotSessionFlds, aField )
AAdd( aNotSessionFlds, aField )
ENDIF
NEXT
IF !Empty( aNotSessionFlds )
FOR EACH aField IN aNotSessionFlds
cFieldsNotInSession += aField[1] + "=" + aField[2] + "&"
cFieldsNotInSession += aField[ 1 ] + "=" + aField[ 2 ] + "&"
NEXT
// Delete last & char
cFieldsNotInSession := Left( cFieldsNotInSession, Len( cFieldsNotInSession ) - 1 )
ENDIF
//TraceLog( "SESSION: cFieldsNotInSession", cFieldsNotInSession )
// TraceLog( "SESSION: cFieldsNotInSession", cFieldsNotInSession )
RETURN cFieldsNotInSession
@@ -482,6 +498,7 @@ METHOD GetSessionVars( aHashVars, cFields, cSeparator ) CLASS uhttpd_Session
*/
METHOD GenerateSID( cCRCKey ) CLASS uhttpd_Session
LOCAL cSID, nSIDCRC, cSIDCRC, n, cTemp
LOCAL nLenSID := 25
LOCAL cBaseKeys := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
@@ -489,18 +506,19 @@ METHOD GenerateSID( cCRCKey ) CLASS uhttpd_Session
LOCAL cRet
LOCAL nRand, nKey := 0
LOCAL nLenTemp
//LOCAL a := 0
// LOCAL a := 0
// Max Lenght must to be 10
// __defaultNIL( @cCRCKey, "3InFoW4lL5" )
// __defaultNIL( @cCRCKey, "3InFoW4lL5" )
__defaultNIL( @cCRCKey, MY_CRCKEY )
/* Let's generate the sequence */
//cSID := Space( nLenSID )
// cSID := Space( nLenSID )
cSID := ""
FOR n := 1 TO nLenSID - 5 // 5 = CRC Length
nRand := HB_RandomInt( 1, nLenKeys )
//cSID[ n ] := cBaseKeys[ nRand ]
nRand := hb_RandomInt( 1, nLenKeys )
// cSID[ n ] := cBaseKeys[ nRand ]
cSID += SubStr( cBaseKeys, nRand, 1 )
nKey += nRand
NEXT
@@ -510,39 +528,41 @@ METHOD GenerateSID( cCRCKey ) CLASS uhttpd_Session
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" )
// 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" )
// ::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 )
// 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 lOk
//LOCAL a := 0
// LOCAL a := 0
__defaultNIL( @::cSID, ::RegenerateID() )
__defaultNIL( @cSID, ::cSID )
// Max Lenght must to be 10
__defaultNIL( @cCRCKey, MY_CRCKEY )
//hb_toOutDebug( "cSID = %s, ::cSID = %s\n\r", hb_valtoexp( cSID ), hb_valtoexp( ::cSID ) )
// hb_toOutDebug( "cSID = %s, ::cSID = %s\n\r", hb_valtoexp( cSID ), hb_valtoexp( ::cSID ) )
IF !Empty( cSID )
/* Calculate the key */
FOR n := 1 TO nLenSID - 5 // 5 = CRC Length
//nRand := At( cSID[ n ], cBaseKeys )
// nRand := At( cSID[ n ], cBaseKeys )
nRand := At( SubStr( cSID, n, 1 ), cBaseKeys )
nKey += nRand
NEXT
@@ -553,14 +573,14 @@ METHOD CheckSID( cSID, cCRCKey ) CLASS uhttpd_Session
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 )
// cSIDCRC += cCRCKey[ Val( cTemp[ n ] ) + 1 ]
cSIDCRC += SubStr( cCRCKey, Val( SubStr( cTemp, n, 1 ) ) + 1, 1 )
NEXT
lOk := ( Right( cSID, 5 ) == cSIDCRC )
//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" )
// 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" )
ENDIF
RETURN lOk
@@ -568,6 +588,7 @@ METHOD CheckSID( cSID, cCRCKey ) CLASS uhttpd_Session
// ------------------------------
METHOD SetSaveHandler( bOpen, bClose, bRead, bWrite, bDestroy, bGC ) CLASS uhttpd_Session
IF bOpen != NIL
::bOpen := bOpen
ENDIF
@@ -586,10 +607,12 @@ METHOD SetSaveHandler( bOpen, bClose, bRead, bWrite, bDestroy, bGC ) CLASS uhttp
IF bGC != NIL
::bGC := bGC
ENDIF
RETURN NIL
METHOD SessionOpen( cPath, cName ) CLASS uhttpd_Session
//TraceLog( "SessionOpen() - cName", cName )
// TraceLog( "SessionOpen() - cName", cName )
IF cPath != NIL
::cSavePath := cPath
ENDIF
@@ -600,11 +623,14 @@ METHOD SessionOpen( cPath, cName ) CLASS uhttpd_Session
RETURN .T.
METHOD SessionClose() CLASS uhttpd_Session
//TraceLog( "SessionClose()" )
// TraceLog( "SessionClose()" )
// Nothing to do
RETURN .T.
METHOD SessionRead( cID ) CLASS uhttpd_Session
LOCAL nH
LOCAL cFile
LOCAL nFileSize
@@ -613,7 +639,7 @@ METHOD SessionRead( cID ) CLASS uhttpd_Session
__defaultNIL( @cID, ::cSID )
cFile := ::cSavePath + hb_ps() + ::cName + "_" + cID
//TraceLog( "SessionRead: cFile", cFile )
// TraceLog( "SessionRead: cFile", cFile )
IF hb_FileExists( cFile )
DO WHILE nRetry++ <= ::nFileRetry
IF ( nH := FOpen( cFile, FO_READ + FO_DENYWRITE ) ) != F_ERROR
@@ -624,7 +650,7 @@ METHOD SessionRead( cID ) CLASS uhttpd_Session
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() ) )
// uhttpd_Die( "ERROR: On reading session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
hb_idleSleep( ::nFileWait / 1000 )
LOOP
ENDIF
@@ -633,42 +659,44 @@ METHOD SessionRead( cID ) CLASS uhttpd_Session
ENDDO
ELSE
//uhttpd_Die( "ERROR: On opening session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
// uhttpd_Die( "ERROR: On opening session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
hb_idleSleep( ::nFileWait / 1000 )
LOOP
ENDIF
EXIT
ENDDO
ENDIF
//TraceLog( "SessionRead() - cID, cFile, nFileSize, cBuffer", cID, cFile, nFileSize, cBuffer )
// 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 := .F.
LOCAL nRetry := 0
//TraceLog( "SessionWrite() - cID, cData", cID, cData )
// TraceLog( "SessionWrite() - cID, cData", cID, cData )
__defaultNIL( @cID, ::cSID )
__defaultNIL( @cData, "" )
nFileSize := Len( cData )
cFile := ::cSavePath + hb_ps() + ::cName + "_" + cID
//TraceLog( "SessionWrite() - cFile", cFile )
// TraceLog( "SessionWrite() - cFile", cFile )
IF nFileSize > 0
DO WHILE nRetry++ <= ::nFileRetry
IF ( nH := hb_FCreate( cFile, FC_NORMAL, FO_READWRITE + FO_DENYWRITE ) ) != F_ERROR
IF ( FWrite( nH, @cData, nFileSize ) ) != nFileSize
uhttpd_Die( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
uhttpd_Die( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) )
ELSE
lOk := .T.
ENDIF
FClose( nH )
ELSE
//uhttpd_Die( "ERROR: On WRITING session file. I can not create session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
// uhttpd_Die( "ERROR: On WRITING session file. I can not create session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
hb_idleSleep( ::nFileWait / 1000 )
LOOP
ENDIF
@@ -676,26 +704,28 @@ METHOD SessionWrite( cID, cData ) CLASS uhttpd_Session
ENDDO
ELSE
// If session data is empty, I will delete the file if exist
//IF hb_FileExists( cFile )
// IF hb_FileExists( cFile )
// FErase( cFile )
//ENDIF
// ENDIF
// Return that all is ok
lOk := .T.
ENDIF
RETURN lOk
METHOD SessionDestroy( cID ) CLASS uhttpd_Session
LOCAL cFile
LOCAL lOk
LOCAL nRetry := 0
//TraceLog( "SessionDestroy() - cID", cID )
// TraceLog( "SessionDestroy() - cID", cID )
__defaultNIL( @cID, ::cSID )
_SESSION := { => }
::oCookie:DeleteCookie( ::cName )
//TraceLog( "SessionDestroy() - cID, oCGI:h_Session", cID, DumpValue( oCGI:h_Session ) )
// TraceLog( "SessionDestroy() - cID, oCGI:h_Session", cID, DumpValue( oCGI:h_Session ) )
cFile := ::cSavePath + hb_ps() + ::cName + "_" + cID
lOk := .F.
@@ -708,20 +738,22 @@ METHOD SessionDestroy( cID ) CLASS uhttpd_Session
ENDIF
ENDDO
//IF !( lOk := ( FErase( cFile ) == 0 ) )
// IF !( lOk := ( FErase( cFile ) == 0 ) )
// uhttpd_Die( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
//ELSE
// ELSE
IF lOk
//TraceLog( "SessionDestroy() - Sessione Eliminata - File " + cFile )
// 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 s_nStartTime
// TraceLog( "SessionGC() - nMaxLifeTime", nMaxLifeTime )
// STATIC s_nStartTime
LOCAL nSecs
LOCAL aDir, aFile
@@ -729,22 +761,23 @@ METHOD SessionGC( nMaxLifeTime ) CLASS uhttpd_Session
aDir := Directory( ::cSavePath + hb_ps() + ::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
// No error checking here, because if I cannot delete file now I will find it again on next loop
FErase( ::cSavePath + hb_ps() + aFile[ F_NAME ] )
ENDIF
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
// No error checking here, because if I cannot delete file now I will find it again on next loop
FErase( ::cSavePath + hb_ps() + aFile[ F_NAME ] )
ENDIF
NEXT
RETURN .T.
STATIC FUNCTION TimeDiffAsSeconds( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
LOCAL aRetVal
__defaultNIL( @dDateEnd, DATE() )
__defaultNIL( @cTimeEnd, TIME() )
__defaultNIL( @dDateEnd, Date() )
__defaultNIL( @cTimeEnd, Time() )
aRetVal := FT_ELAPSED( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
@@ -752,43 +785,45 @@ STATIC FUNCTION TimeDiffAsSeconds( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
// Nanforum ELAPSED
STATIC FUNCTION FT_ELAPSED(dStart, dEnd, cTimeStart, cTimeEnd)
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[4,2]
STATIC FUNCTION FT_ELAPSED( dStart, dEnd, cTimeStart, cTimeEnd )
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[ 4, 2 ]
IF HB_ISSTRING( dStart )
cTimeStart := dStart
dStart := DATE()
dStart := Date()
ELSEIF ! HB_ISDATE( dStart )
dStart := DATE()
dStart := Date()
ENDIF
IF HB_ISSTRING( dEnd )
cTimeEnd := dEnd
dEnd := DATE()
dEnd := Date()
ELSEIF ! HB_ISDATE( dEnd )
dEnd := DATE()
dEnd := Date()
ENDIF
iif( ! HB_ISSTRING(cTimeStart), cTimeStart := '00:00:00', )
iif( ! HB_ISSTRING(cTimeEnd) , cTimeEnd := '00:00:00', )
iif( ! HB_ISSTRING( cTimeStart ), cTimeStart := '00:00:00', )
iif( ! HB_ISSTRING( cTimeEnd ), cTimeEnd := '00:00:00', )
nTotalSec := (dEnd - dStart) * 86400 + ;
VAL(cTimeEnd) * 3600 + ;
VAL(SUBSTR(cTimeEnd,AT(':', cTimeEnd)+1,2)) * 60 + ;
iif(RAT(':', cTimeEnd) == AT(':', cTimeEnd), 0, ;
VAL(SUBSTR(cTimeEnd,RAT(':', cTimeEnd)+1))) - ;
VAL(cTimeStart) * 3600 - ;
VAL(SUBSTR(cTimeStart,AT(':', cTimeStart)+1,2)) * 60 - ;
iif(RAT(':', cTimeStart) == AT(':', cTimeStart), 0, ;
VAL(SUBSTR(cTimeStart,RAT(':', cTimeStart)+1)))
nTotalSec := ;
( dEnd - dStart ) * 86400 + ;
Val( cTimeEnd ) * 3600 + ;
Val( SubStr( cTimeEnd, At( ':', cTimeEnd ) + 1, 2 ) ) * 60 + ;
iif( RAt( ':', cTimeEnd ) == At( ':', cTimeEnd ), 0, ;
Val( SubStr( cTimeEnd, RAt( ':', cTimeEnd ) + 1 ) ) ) - ;
Val( cTimeStart ) * 3600 - ;
Val( SubStr( cTimeStart, At( ':', cTimeStart ) + 1, 2 ) ) * 60 - ;
iif( RAt( ':', cTimeStart ) == At( ':', cTimeStart ), 0, ;
Val( SubStr( cTimeStart, RAt( ':', cTimeStart ) + 1 ) ) )
nTemp := nTotalSec
FOR nCtr := 1 to 4
nConstant := iif(nCtr == 1, 86400, iif(nCtr == 2, 3600, iif( nCtr == 3, 60, 1)))
aRetVal[nCtr,1] := INT(nTemp/nConstant)
aRetval[nCtr,2] := nTotalSec / nConstant
nTemp -= aRetVal[nCtr,1] * nConstant
FOR nCtr := 1 TO 4
nConstant := iif( nCtr == 1, 86400, iif( nCtr == 2, 3600, iif( nCtr == 3, 60, 1 ) ) )
aRetVal[ nCtr, 1 ] := Int( nTemp / nConstant )
aRetval[ nCtr, 2 ] := nTotalSec / nConstant
nTemp -= aRetVal[ nCtr, 1 ] * nConstant
NEXT
RETURN aRetVal
@@ -796,37 +831,40 @@ STATIC FUNCTION FT_ELAPSED(dStart, dEnd, cTimeStart, cTimeEnd)
// ------------------------------
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
AAdd( aSerial, { cKey, xVal } )
ENDIF
xVal := _SESSION[ cKey ]
IF xVal != NIL
AAdd( aSerial, { cKey, xVal } )
ENDIF
NEXT
ENDIF
RETURN iif( !Empty( aSerial ), HB_Serialize( aSerial ), NIL )
RETURN iif( !Empty( aSerial ), hb_Serialize( aSerial ), NIL )
METHOD Decode( cData ) CLASS uhttpd_Session
LOCAL lOk := .T.
LOCAL cSerial := cData
LOCAL xVal, aElem
//LOCAL cKey
//TraceLog( "Decode - cSerial", cSerial )
//::oCGI:ToLogFile( "Decode - cSerial = " + hb_cStr( cSerial ), "/pointtoit/tmp/log.txt" )
// LOCAL cKey
DO WHILE ( xVal := HB_Deserialize( @cSerial ) ) != NIL
//TraceLog( "Decode - xVal", DumpValue( xVal ) )
//::oCGI:ToLogFile( "Decode - xVal = " + hb_cStr( xVal ) + ", ValType( xVal ) = " + ValType( xVal ), "/pointtoit/tmp/log.txt" )
// TraceLog( "Decode - cSerial", cSerial )
// ::oCGI:ToLogFile( "Decode - cSerial = " + hb_cStr( cSerial ), "/pointtoit/tmp/log.txt" )
DO WHILE ( xVal := hb_Deserialize( @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'
// CASE 'O'
// //TraceLog( "Decode - xVal - Object", xVal )
// IF xVal:classname == "TASSOCIATIVEARRAY"
// //TraceLog( "Decode - xVal - Object - TAssociativeArray - Keys", xVal:Keys )
@@ -837,54 +875,59 @@ METHOD Decode( cData ) CLASS uhttpd_Session
// 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
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 := .F.
EXIT
OTHERWISE
uhttpd_Die( "ERROR: On deserializing session data" )
lOk := .F.
EXIT
ENDSWITCH
ENDDO
RETURN lOk
METHOD SendCacheLimiter() CLASS uhttpd_Session
LOCAL dDate
DO CASE
CASE ::cCache_Limiter == 'nocache'
//uhttpd_SetHeader( 'Expires', 'Thu, 19 Nov 1981 08:52:00 GMT' )
uhttpd_SetHeader( 'Expires', uhttpd_DateToGMT( ,,-1, ) )
// uhttpd_SetHeader( 'Expires', 'Thu, 19 Nov 1981 08:52:00 GMT' )
uhttpd_SetHeader( 'Expires', uhttpd_DateToGMT( ,, -1, ) )
uhttpd_SetHeader( 'Cache-Control', 'no-cache' )
//uhttpd_SetHeader("Cache-Control", "no-store, no-cache, must-revalidate") // HTTP/1.1
//uhttpd_SetHeader("Cache-Control", "post-check=0, pre-check=0", .F. )
// uhttpd_SetHeader("Cache-Control", "no-store, no-cache, must-revalidate") // HTTP/1.1
// uhttpd_SetHeader("Cache-Control", "post-check=0, pre-check=0", .F. )
uhttpd_SetHeader( 'Pragma', 'no-cache' )
CASE ::cCache_Limiter == 'private'
uhttpd_SetHeader( 'Expires', 'Thu, 19 Nov 1981 08:52:00 GMT' )
uhttpd_SetHeader( 'Cache-Control', 'private, max-age=' + hb_ntos( ::nCache_Expire * 60 ) )
IF hb_FGetDateTime( hb_argv(0), @dDate )
IF hb_FGetDateTime( hb_argv( 0 ), @dDate )
uhttpd_SetHeader( 'Last-Modified', uhttpd_DateToGMT( dDate ) )
ENDIF
CASE ::cCache_Limiter == 'public'
uhttpd_SetHeader( 'Expires', uhttpd_DateToGMT( ,,, ::nCache_Expire * 60 ) )
uhttpd_SetHeader( 'Cache-Control', 'public, max-age=' + hb_ntos( ::nCache_Expire * 60 ) )
IF hb_FGetDateTime( hb_argv(0), @dDate )
IF hb_FGetDateTime( hb_argv( 0 ), @dDate )
uhttpd_SetHeader( 'Last-Modified', uhttpd_DateToGMT( dDate ) )
ENDIF
OTHERWISE
uhttpd_Die( "ERROR: Caching method " + ::cCache_Limiter + " not implemented." )
ENDCASE
//__OutDebug( "Header cache '" + ::cCache_Limiter + "' inviato" )
// __OutDebug( "Header cache '" + ::cCache_Limiter + "' inviato" )
RETURN NIL
PROCEDURE DestroyObject() CLASS uhttpd_Session
::Close()
//::oCGI:ToLogFile( "Session destroyed" )
//::oCGI := NIL
// ::oCGI:ToLogFile( "Session destroyed" )
// ::oCGI := NIL
RETURN

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

File diff suppressed because it is too large Load Diff