From a1cb9aa400c43d05f80ee432b9a2ef993b2bff7c Mon Sep 17 00:00:00 2001 From: Francesco Saverio Giudice Date: Fri, 30 Jan 2009 02:26:55 +0000 Subject: [PATCH] 2009-01-30 03:24 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com) * harbour/contrib/examples/uhttpd/uhttpd.prg * Updated uHTTPD (Work in progress) + Added HRB caching (set #define HRB_ACTIVATE_CACHE .T. to enable) + Added support for Cookies * Formatted ! Renamed all public functions with uhttpd_ prefix (TOCHECK) + Added support for array content in POST variables * Optimized some code + harbour/contrib/examples/uhttpd/cgifunc.prg + Some helper function moved here from uhttpd prg and added some functions of mine + harbour/contrib/examples/uhttpd/cookie.prg + Cookie class + harbour/contrib/examples/uhttpd/modules/cookie.prg + cookie sample module + harbour/contrib/examples/uhttpd/home/postsample.html + POST example * harbour/contrib/examples/uhttpd/uhttpd.ini + Added new script alias for cookie sample * harbour/contrib/examples/uhttpd/hbmk_b32.bat * harbour/contrib/examples/uhttpd/home/index.html * harbour/contrib/examples/uhttpd/home/testxmldb.html * harbour/contrib/examples/uhttpd/modules/bldhrb.bat * harbour/contrib/examples/uhttpd/modules/info.prg * harbour/contrib/examples/uhttpd/modules/showcounter.prg * harbour/contrib/examples/uhttpd/modules/tableservletdb.prg * Updated for new function prefix and some formatting --- harbour/ChangeLog | 30 + harbour/contrib/examples/uhttpd/cgifunc.prg | 859 ++++++++ harbour/contrib/examples/uhttpd/cookie.prg | 104 + harbour/contrib/examples/uhttpd/hbmk_b32.bat | 8 +- .../contrib/examples/uhttpd/home/index.html | 42 +- .../examples/uhttpd/home/postsample.html | 23 + .../examples/uhttpd/home/testxmldb.html | 9 +- .../examples/uhttpd/modules/bldhrb.bat | 2 +- .../examples/uhttpd/modules/cookie.prg | 116 ++ .../contrib/examples/uhttpd/modules/info.prg | 39 +- .../examples/uhttpd/modules/showcounter.prg | 28 +- .../uhttpd/modules/tableservletdb.prg | 14 +- harbour/contrib/examples/uhttpd/uhttpd.ini | 1 + harbour/contrib/examples/uhttpd/uhttpd.prg | 1818 +++++++++-------- 14 files changed, 2162 insertions(+), 931 deletions(-) create mode 100644 harbour/contrib/examples/uhttpd/cgifunc.prg create mode 100644 harbour/contrib/examples/uhttpd/cookie.prg create mode 100644 harbour/contrib/examples/uhttpd/home/postsample.html create mode 100644 harbour/contrib/examples/uhttpd/modules/cookie.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ba893b5496..7c084d5056 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,36 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2009-01-30 03:24 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com) + * harbour/contrib/examples/uhttpd/uhttpd.prg + * Updated uHTTPD (Work in progress) + + Added HRB caching (set #define HRB_ACTIVATE_CACHE .T. to enable) + + Added support for Cookies + * Formatted + ! Renamed all public functions with uhttpd_ prefix (TOCHECK) + + Added support for array content in POST variables + * Optimized some code + + harbour/contrib/examples/uhttpd/cgifunc.prg + + Some helper function moved here from uhttpd prg and added + some functions of mine + + harbour/contrib/examples/uhttpd/cookie.prg + + Cookie class + + harbour/contrib/examples/uhttpd/modules/cookie.prg + + cookie sample module + + harbour/contrib/examples/uhttpd/home/postsample.html + + POST example + * harbour/contrib/examples/uhttpd/uhttpd.ini + + Added new script alias for cookie sample + + * harbour/contrib/examples/uhttpd/hbmk_b32.bat + * harbour/contrib/examples/uhttpd/home/index.html + * harbour/contrib/examples/uhttpd/home/testxmldb.html + * harbour/contrib/examples/uhttpd/modules/bldhrb.bat + * harbour/contrib/examples/uhttpd/modules/info.prg + * harbour/contrib/examples/uhttpd/modules/showcounter.prg + * harbour/contrib/examples/uhttpd/modules/tableservletdb.prg + * Updated for new function prefix and some formatting + 2009-01-29 22:50 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/config/rules.cf * harbour/config/dos/bcc16.cf diff --git a/harbour/contrib/examples/uhttpd/cgifunc.prg b/harbour/contrib/examples/uhttpd/cgifunc.prg new file mode 100644 index 0000000000..a9a5d2036e --- /dev/null +++ b/harbour/contrib/examples/uhttpd/cgifunc.prg @@ -0,0 +1,859 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * uHTTPD (Micro HTTP server) cgi functions + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +//#include "xhb.ch" +#include "common.ch" +#include "error.ch" +#include "fileio.ch" + +//#define HB_USE_HBTIP // Use functions from HBTIP - TOIMPLEMENT + +#define CRLF (Chr(13)+Chr(10)) +#xtranslate THROW( ) => ( Eval( ErrorBlock(), ), Break( ) ) + +MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST + +FUNCTION uhttpd_GetVars( cFields, cSeparator ) + LOCAL hHashVars := Hash() + LOCAL aField, cField, aFields + LOCAL cName, xValue + DEFAULT cSeparator TO "&" + + aFields := uhttpd_Split( cSeparator, cFields ) + + FOR EACH cField in aFields + aField := uhttpd_Split( "=", cField, 1 ) + IF Len( aField ) == 1 + hHashVars[ aField[ 1 ] ] := NIL + LOOP + ELSEIF Len( aField ) != 2 + LOOP + ENDIF + + cName := LTrim( aField[ 1 ] ) + xValue := uhttpd_UrlDecode( aField[ 2 ] ) + + // Is it an array entry? + 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 + // with same name, then I will change it to an array + IF ( hb_HPos( hHashVars, cName ) ) > 0 + IF !HB_ISARRAY( hHashVars[ cName ] ) + // Transoform it to array + hHashVars[ cName ] := { hHashVars[ cName ] } + ENDIF + aAdd( hHashVars[ cName ], xValue ) + ELSE + hHashVars[ cName ] := xValue + ENDIF + + ENDIF + NEXT + + RETURN hHashVars + +/* + uhttpd_SplitUrl( cUrl ) --> hUrl + (C) 2006 Francesco Saverio Giudice + + Splits a valid URL into simple components and return them in a hash + it works like parse_url() PHP function + + a URL string is something like this: + http://[username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]] + + Parameters: + cUrl - Valid URL string + + Returns: + hUrl - Hash containing these keys: + SCHEME - protocol name + HOST - hostname + PORT - protocol port number + USER - username + PASS - password + PATH - path to directory and/or file + QUERY - part after question mark ? + FRAGMENT - part after hashmark # + +*/ +FUNCTION uhttpd_SplitUrl( cUrl ) + LOCAL hUrl := Hash() + LOCAL nPos, cTemp, cUserNamePassword, cHostnamePort + LOCAL cProto, cHost, cPort, nPort, cUser, cPass, cPath, cQuery, cFragment + + // Prevents case matching + HSetCaseMatch( hUrl, FALSE ) + + cTemp := cUrl + + // Starting with + // http://[username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]] + + // Read protocol + nPos := At( "://", cTemp ) + IF nPos > 0 + cProto := Left( cTemp, nPos - 1 ) + // delete protocol from temp string + cTemp := SubStr( cTemp, nPos + 3 ) + ELSE + cProto := "" + ENDIF + + // Now we have: + // [username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]] + + // Read username and password + nPos := At( "@", cTemp ) + IF nPos > 0 + cUserNamePassword := Left( cTemp, nPos - 1 ) + // delete Username and Password from temp string + cTemp := SubStr( cTemp, nPos + 1 ) + // Split username and password + nPos := At( ":", cUserNamePassword ) + IF nPos > 0 + cUser := Left( cUserNamePassword, nPos - 1 ) + cPass := SubStr( cUserNamePassword, nPos + 1 ) + ELSE + cUser := cUserNamePassword + cPass := "" + ENDIF + ELSE + cUser := "" + cPass := "" + ENDIF + + // Now we have: + // hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]] + + // Search for anchor using # char from right + nPos := RAt( "#", cTemp ) + IF nPos > 0 + cFragment := SubStr( cTemp, nPos + 1 ) + + // delete anchor from temp string + cTemp := SubStr( cTemp, 1, nPos - 1 ) + + ELSE + cFragment := "" + ENDIF + + // Now we have: + // hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]]] + + // Search for Query part using ? char from right + nPos := RAt( "?", cTemp ) + IF nPos > 0 + cQuery := SubStr( cTemp, nPos + 1 ) + + // delete query from temp string + cTemp := SubStr( cTemp, 1, nPos - 1 ) + + ELSE + cQuery := "" + ENDIF + + // Now we have: + // hostname[:port][/path[/file[.ext]] + + // Search for Path part using / char from right + nPos := RAt( "/", cTemp ) + IF nPos > 0 + cPath := SubStr( cTemp, nPos ) + + // delete path from temp string + cTemp := SubStr( cTemp, 1, nPos - 1 ) + + ELSE + cPath := "/" + ENDIF + + // Now we have: + // hostname[:port][/path[/file[.ext]] + + cHostnamePort := cTemp + + // Searching port number + nPos := At( ":", cHostnamePort ) + IF nPos > 0 + cHost := Left( cHostnamePort, nPos - 1 ) + cPort := SubStr( cHostnamePort, nPos + 1 ) + nPort := Val( cPort ) + IF nPort <= 0 + nPort := -1 + ENDIF + ELSE + cHost := cHostnamePort + nPort := -1 + ENDIF + + // Assemble hash + WITH OBJECT hUrl + :SCHEME := cProto + :HOST := cHost + :PORT := nPort + :USER := cUser + :PASS := cPass + :PATH := cPath + :QUERY := cQuery + :FRAGMENT := cFragment + END + + // Prevents externals to add something else to this Hash + HSetAutoAdd( hUrl, FALSE ) +RETURN hUrl + + +/* + uhttpd_SplitString( cString ) --> aLines + (C) 2006 Francesco Saverio Giudice + + Splits a string into simple components and return them in an array + + Parameters: + cString - Initial string + cDelim - Delimiter - default CRLF + lRemDelim - Remove delimiter from return values - default TRUE + + Returns: + aLines - Array with lines / fields for each element + + Sample: + SplitString( "this=is=a=line=with=equals", "=" ) -> { "this", "is", "a", "line", "with", "equals" } + +*/ +FUNCTION uhttpd_SplitString( cString, cDelim, lRemDelim, nCount ) + LOCAL nEOLPos + LOCAL cBuffer := cString + LOCAL aLines := {}, cLine + LOCAL nHowMany := 0 + + DEFAULT cDelim TO ( CHR(13) + CHR(10) ) + DEFAULT lRemDelim TO TRUE + DEFAULT nCount TO -1 + + //WriteToLogFile( "Splitstring: " + cStr( cString ) ) + + DO WHILE ( nEOLPos := AT( cDelim, cBuffer ) ) > 0 + nHowMany++ + IF lRemDelim + cLine := LEFT( cBuffer, nEOLPos - 1 ) + ELSE + 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 ) ) + IF nCount > -1 + IF nHowMany >= nCount + EXIT + ENDIF + ENDIF + ENDDO + + // Check last line + IF Len( cBuffer ) > 0 + aAdd( aLines, cBuffer ) + ENDIF + +RETURN aLines + +/************************************************************ +* Encoding URL +*/ +FUNCTION uhttpd_URLEncode( cString, lComplete ) +#ifdef HB_USE_HBTIP + DEFAULT lComplete TO TRUE + RETURN TIPENCODERURL_ENCODE( cString, lComplete ) +#else + LOCAL cRet := "", i, nVal, cChar + + FOR i := 1 TO Len( cString ) + cChar := SubStr( cString, i, 1) + DO CASE + 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 IIF( !lComplete, cChar == ':' .OR. cChar == '?' .OR. cChar == '=', FALSE ) + cRet += cChar + + OTHERWISE + nVal := Asc( cChar ) + cRet += "%" + hb_NumToHex( nVal ) + ENDCASE + NEXT + RETURN cRet +#endif + +/************************************************************ +* Decoding URL +*/ +FUNCTION uhttpd_URLDecode( cString ) +#ifdef HB_USE_HBTIP + RETURN TIPENCODERURL_DECODE( cString ) +#else + LOCAL cRet := "", i, cChar + + FOR i := 1 TO Len( cString ) + cChar := SubStr( cString, i, 1 ) + DO CASE + CASE cChar == "+" + cRet += " " + + CASE cChar == "%" + i ++ + cRet += Chr( hb_HexToNum( SubStr( cString, i, 2 ) ) ) + i ++ + + OTHERWISE + cRet += cChar + + ENDCASE + + NEXT + RETURN cRet +#endif + +/* + * DateToGMT( dDate, cTime, nDayToAdd ) --> cGMTDate + * + * dDate : default DATE() + * cTime : default "00:00:00" + * nDayToAdd : default 0 - may be a negative number + * + * cGMTDate : The string return in form of "Saturday, 31-Oct-03 00:00:00 GMT" + */ + +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" } + + DEFAULT dDate TO DATE() + DEFAULT cTime TO TIME() + DEFAULT nDayToAdd TO 0 + DEFAULT nSecsToAdd TO 0 + + //Tracelog( "DateToGMT - StartingValue", dDate, cTime, nDayToAdd, nSecsToAdd ) + + cTime := uhttpd_AddSecondsToTime( cTime, nSecsToAdd, @nDayToAdd ) + dDate += nDayToAdd + + nDay := Day( dDate ) + nMonth := Month( dDate ) + nYear := Year( dDate) + nDoW := Dow( dDate ) + + cStr := aDays[ nDow ] + ", " + StrZero( nDay, 2 ) + "-" + aMonths[ nMonth ] + "-" + ; + Right( StrZero( nYear, 4 ), 2 ) + " " + cTime + " GMT" + + //Tracelog( "DateToGMT", cStr ) + + Set( _SET_DATEFORMAT, cOldDateFormat ) + +RETURN cStr + +/* + * AddSecondsToTime( cTime, nSecsToAdd, @nDaysAdded ) --> cNewTime + * + * cTime : default "00:00:00" + * nSecsToAdd : default 0 - may be a negative number + * nDaysAdded : (out) return how many days add (or subtract) to actual date if numbers seconds is + * more than 86400 seconds (1 day) + * + * cNewTime : The new time string + * + * Rules: time is converted to seconds from midnight, then added of nSecsToAdd. Divided of 1 day and + * then reverted to Time string + */ + +FUNCTION uhttpd_AddSecondsToTime( cTime, nSecsToAdd, nDaysAdded ) + LOCAL nOneDaySeconds := 86400 // 24 * 60 * 60 + LOCAL cNewTime, nSecs + + DEFAULT cTime TO TIME() + DEFAULT nSecsToAdd TO 0 + DEFAULT nDaysAdded TO 0 // nDaysAdded can be already valued, so below i add to this value + + 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 + + DEFAULT dDateEnd TO DATE() + DEFAULT cTimeEnd TO TIME() + + aRetVal := FT_ELAPSED( dDateStart, dDateEnd, cTimeStart, cTimeEnd ) + +RETURN aRetVal[ 4, 2 ] + +FUNCTION uhttpd_OutputString( cString, aTranslate, lProtected ) + LOCAL cHtml + DEFAULT lProtected TO FALSE + DEFAULT aTranslate TO { { '"', '"' }, { ' ', ' ' } } + + //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 := { ; + { '&', '&' } ,; + { '<', '<' } ,; + { '>', '>' } ; + } +RETURN uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations ) + +FUNCTION uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations ) + DEFAULT cQuote_style TO "ENT_COMPAT" + DO CASE + CASE cQuote_style == "ENT_COMPAT" + aAdd( aTranslations, { '"', '"' } ) + CASE cQuote_style == "ENT_QUOTES" + aAdd( aTranslations, { '"', '"' } ) + aAdd( aTranslations, { "'", ''' } ) + CASE cQuote_style == "ENT_NOQUOTES" + ENDCASE +RETURN uhttpd_TranslateStrings( cString, aTranslations ) + +FUNCTION uhttpd_CRLF2BR( cString ) + LOCAL aTranslations := { ; + { CRLF, '
' } ; + } +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] ) + ENDIF + NEXT +RETURN cString + +FUNCTION uhttpd_StrStr( cString, cSearch ) + 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 ) ) + +FUNCTION uhttpd_HtmlEntities( cString, cQuote_style ) +// LOCAL aTranslations := { ; // ATTENTION, this chars are visible only with OEM font +// { ' ', ' ' } ,; //   Nonbreaking space +// { '', '¡' } ,; // ¡ Inverted exclamation +// { '', '¢' } ,; // ¢ Cent sign +// { '', '£' } ,; // £ Pound sterling +// { '', '¤' } ,; // ¤ General currency sign +// { '', '¥' } ,; // ¥ Yen sign +// { '', '¦' } ,; // ¦ or &brkbar; Broken vertical bar +// { '', '§' } ,; // § Section sign +// { '', '¨' } ,; // ¨ or ¨ Diresis / Umlaut +// { '', '©' } ,; // © Copyright +// { '', 'ª' } ,; // ª Feminine ordinal +// { '', '«' } ,; // « Left angle quote, guillemet left +// { '', '¬' } ,; // ¬ Not sign +// { '', '­' } ,; // ­ Soft hyphen +// { '', '®' } ,; // ® Registered trademark +// { '', '¯' } ,; // ¯ or &hibar; Macron accent +// { '', '°' } ,; // ° Degree sign +// { '', '±' } ,; // ± Plus or minus +// { '', '²' } ,; // ² Superscript two +// { '', '³' } ,; // ³ Superscript three +// { '', '´' } ,; // ´ Acute accent +// { '', 'µ' } ,; // µ Micro sign +// { '', '¶' } ,; // ¶ Paragraph sign +// { '', '·' } ,; // · Middle dot +// { '', '¸' } ,; // ¸ Cedilla +// { '', '¹' } ,; // ¹ Superscript one +// { '', 'º' } ,; // º Masculine ordinal +// { '', '»' } ,; // » Right angle quote, guillemet right +// { '', '¼' } ,; // ¼ Fraction one-fourth +// { '', '½' } ,; // ½ Fraction one-half +// { '', '¾' } ,; // ¾ Fraction three-fourths +// { '', '¿' } ,; // ¿ Inverted question mark +// { '', 'À' } ,; // À Capital A, grave accent +// { '', 'Á' } ,; // Á Capital A, acute accent +// { '', 'Â' } ,; // Â Capital A, circumflex +// { '', 'Ã' } ,; // Ã Capital A, tilde +// { '', 'Ä' } ,; // Ä Capital A, diresis / umlaut +// { '', 'Å' } ,; // Å Capital A, ring +// { '', 'Æ' } ,; // Æ Capital AE ligature +// { '', 'Ç' } ,; // Ç Capital C, cedilla +// { '', 'È' } ,; // È Capital E, grave accent +// { '', 'É' } ,; // É Capital E, acute accent +// { '', 'Ê' } ,; // Ê Capital E, circumflex +// { '', 'Ë' } ,; // Ë Capital E, diresis / umlaut +// { '', 'Ì' } ,; // Ì Capital I, grave accent +// { '', 'Í' } ,; // Í Capital I, acute accent +// { '', 'Î' } ,; // Î Capital I, circumflex +// { '', 'Ï' } ,; // Ï Capital I, diresis / umlaut +// { '', 'Ð' } ,; // Ð Capital Eth, Icelandic +// { '', 'Ñ' } ,; // Ñ Capital N, tilde +// { '', 'Ò' } ,; // Ò Capital O, grave accent +// { '', 'Ó' } ,; // Ó Capital O, acute accent +// { '', 'Ô' } ,; // Ô Capital O, circumflex +// { '', 'Õ' } ,; // Õ Capital O, tilde +// { '', 'Ö' } ,; // Ö Capital O, diresis / umlaut +// { '', '×' } ,; // × Multiply sign +// { '', 'Ø' } ,; // Ø Capital O, slash +// { '', 'Ù' } ,; // Ù Capital U, grave accent +// { '', 'Ú' } ,; // Ú Capital U, acute accent +// { '', 'Û' } ,; // Û Capital U, circumflex +// { '', 'Ü' } ,; // Ü Capital U, diresis / umlaut +// { '', 'Ý' } ,; // Ý Capital Y, acute accent +// { '', 'Þ' } ,; // Þ Capital Thorn, Icelandic +// { '', 'ß' } ,; // ß Small sharp s, German sz +// { '', 'à' } ,; // à Small a, grave accent +// { '', 'á' } ,; // á Small a, acute accent +// { '', 'â' } ,; // â Small a, circumflex +// { '', 'ã' } ,; // ã Small a, tilde +// { '', 'ä' } ,; // ä Small a, diresis / umlaut +// { '', 'å' } ,; // å Small a, ring +// { '', 'æ' } ,; // æ Small ae ligature +// { '', 'ç' } ,; // ç Small c, cedilla +// { '', 'è' } ,; // è Small e, grave accent +// { '', 'é' } ,; // é Small e, acute accent +// { '', 'ê' } ,; // ê Small e, circumflex +// { '', 'ë' } ,; // ë Small e, diresis / umlaut +// { '', 'ì' } ,; // ì Small i, grave accent +// { '', 'í' } ,; // í Small i, acute accent +// { '', 'î' } ,; // î Small i, circumflex +// { '', 'ï' } ,; // ï Small i, diresis / umlaut +// { '', 'ð' } ,; // ð Small eth, Icelandic +// { '', 'ñ' } ,; // ñ Small n, tilde +// { '', 'ò' } ,; // ò Small o, grave accent +// { '', 'ó' } ,; // ó Small o, acute accent +// { '', 'ô' } ,; // ô Small o, circumflex +// { '', 'õ' } ,; // õ Small o, tilde +// { '', 'ö' } ,; // ö Small o, diresis / umlaut +// { '', '÷' } ,; // ÷ Division sign +// { '', 'ø' } ,; // ø Small o, slash +// { '', 'ù' } ,; // ù Small u, grave accent +// { '', 'ú' } ,; // ú Small u, acute accent +// { '', 'û' } ,; // û Small u, circumflex +// { '', 'ü' } ,; // ü Small u, diresis / umlaut +// { '', 'ý' } ,; // ý Small y, acute accent +// { '', 'þ' } ,; // þ Small thorn, Icelandic +// { '', 'ÿ' } ; // ÿ Small y, diresis / umlaut +// } + + LOCAL aTranslations := {} + LOCAL i + FOR i := 160 TO 255 + aAdd( aTranslations, { Chr( i ), "&#" + Str( i, 3 ) + ";" } ) + NEXT + +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 + +FUNCTION uhttpd_HTMLSpace( n ) +RETURN replicate( " ", n ) //" " + +/* FROM FT LIB */ +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 + +PROCEDURE uhttpd_WriteToLogFile( cString, cLog, lCreate ) + LOCAL nHandle, cSep + + cSep := HB_OsPathSeparator() + + //DEFAULT cLog TO AppFullPath() + cSep + "logfile.log" + DEFAULT cLog TO cSep + "tmp" + cSep + "logfile.log" + DEFAULT lCreate TO FALSE + + IF cLog <> NIL + + IF !lCreate .AND. FILE( cLog ) + nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED) + ELSE + nHandle := FCreate( cLog ) + // Dopo che lo creato, lo richiudo immediatamente e lo riapro in modo condiviso + // nel caso arrivasse una nuova scrittura + IF Ferror() == 0 .AND. nHandle > 0 + FClose( nHandle ) + nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED) + ENDIF + //__OutDebug( "Create ", nHandle ) + ENDIF + + //cString := "PROCEDURE: " + ProcName( -2 ) + " " + cString + + IF nHandle > 0 + FSeek( nHandle, 0, 2 ) + 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 ; + } + + cSep := HB_OsPathSeparator() + + WITH OBJECT hFile + :FULLPATH := IIF( !Empty( :PATH ), IIF( !( Right( :PATH, Len( cSep ) ) == cSep ), :PATH + cSep, :PATH ), "" ) + :UNC := :FULLPATH + :FULLNAME + END + +RETURN hFile + +FUNCTION uhttpd_AppFullPath() + LOCAL hExeFile := uhttpd_SplitFileName( HB_ARGV(0) ) + LOCAL cPrgFullPath := hExeFile:FULLPATH + LOCAL cPath, cSep + + cSep := HB_OsPathSeparator() + + IF Right( cPrgFullPath, Len( cSep ) ) == cSep + cPath := SubStr( cPrgFullPath, 1, Len( cPrgFullPath ) - Len( cSep ) ) + ELSE + cPath := cPrgFullPath + ENDIF +RETURN cPath + +FUNCTION uhttpd_AppFullName() + LOCAL hExeFile := uhttpd_SplitFileName( HB_ARGV(0) ) +RETURN hExeFile:FULLNAME + + +FUNCTION uhttpd_CStrToVal( cExp, cType ) + + IF ValType( cExp ) != 'C' + Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + ENDIF + + SWITCH cType + CASE 'C' + RETURN 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 '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 'M' + RETURN cExp + + CASE 'U' + RETURN NIL + + /* + CASE 'A' + Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + + CASE 'B' + Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + + CASE 'O' + Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + */ + + OTHERWISE + Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + END + +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 Empty( xVal ) + xVal := NIL + ENDIF + IF cType <> NIL .AND. cType $ "NLD" + xVal := uhttpd_CStrToVal( xVal, cType ) + ENDIF + ENDIF + +RETURN xVal + +FUNCTION uhttpd_SetField( cVar, cVal ) + LOCAL xVal := uhttpd_HGetValue( _Request, cVar ) + _Request[ cVar ] := cVal +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) ) + ENDIF + //RETURN IIF( cKey IN hHash:Keys, hHash[ cKey ], NIL ) + RETURN xVal diff --git a/harbour/contrib/examples/uhttpd/cookie.prg b/harbour/contrib/examples/uhttpd/cookie.prg new file mode 100644 index 0000000000..86dfa673fe --- /dev/null +++ b/harbour/contrib/examples/uhttpd/cookie.prg @@ -0,0 +1,104 @@ + +#include "common.ch" +#include "hbclass.ch" + +#command IF THEN <*statement*> =>; + IF () ; ; END + +#command IF THEN ELSE =>; + IF () ; ; ELSE ; ; END + +MEMVAR _COOKIE + +FUNCTION uhttpd_CookieNew( cDomain, cPath, nExpireDays, nExpireSecs ) +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 lCookiesSent INIT FALSE + + METHOD SetCookie() + METHOD DeleteCookie() + METHOD DeleteAllCookies() + METHOD GetCookie() + METHOD IsCookie( cCookieName ) INLINE ::GetCookie( cCookieName ) != NIL + METHOD IsCookies() INLINE !Empty( ::aaCookieToSet ) + METHOD SetCookieDefaults() + +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 + +METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure ) CLASS uhttpd_Cookie + LOCAL cStr + + DEFAULT cDomain TO ::cCookieDomain + DEFAULT cPath TO ::cCookiePath + DEFAULT cExpires TO uhttpd_DateToGMT( Date(), Time(), ::nCookieExpireDays, ::nCookieExpireSecs ) + + cStr := cCookieName + "=" + uhttpd_UrlEncode( hb_cStr( xValue ) ) + + IF cDomain <> NIL + cStr += "; domain=" + cDomain + ENDIF + IF cPath <> NIL + cStr += "; path=" + cPath + ENDIF + IF cExpires <> NIL + cStr += "; expires=" + cExpires + ENDIF + IF ValType( lSecure ) == "L" .AND. lSecure + cStr += "; secure" + ENDIF + + // Send the header + uhttpd_AddHeader( "Set-Cookie", cStr, FALSE ) + + RETURN NIL + +METHOD DeleteCookie( cCookieName, cDomain, cPath, lSecure ) CLASS uhttpd_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 ) + NEXT + + RETURN NIL + +METHOD GetCookie( cCookieName ) CLASS uhttpd_Cookie + LOCAL cHeader, cRet + LOCAL nPos := 1 + DO WHILE TRUE + IF ( cHeader := uhttpd_GetHeader( "Set-Cookie", @nPos ) ) != NIL + IF cHeader == cCookieName + cRet := cHeader + EXIT + ELSE + nPos++ + ENDIF + ELSE + EXIT + ENDIF + ENDDO + RETURN cRet diff --git a/harbour/contrib/examples/uhttpd/hbmk_b32.bat b/harbour/contrib/examples/uhttpd/hbmk_b32.bat index dd790abe9e..32cc7de0b5 100644 --- a/harbour/contrib/examples/uhttpd/hbmk_b32.bat +++ b/harbour/contrib/examples/uhttpd/hbmk_b32.bat @@ -48,13 +48,19 @@ if exist uhttpd.exe uhttpd -s ..\..\..\bin\harbour uhttpd /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 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% +..\..\..\bin\harbour cgifunc /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF% +if errorlevel 1 goto DOERROR +..\..\..\bin\harbour cookie /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% if errorlevel 1 goto DOERROR :CLEAN del *.obj del *.tds del uhttpd.c +del cgifunc.c +del cookie.c if not exist uhttpd.exe goto :EXIT if %UHTTP_GD_SUPPORT%.==no. goto BUILD_OK diff --git a/harbour/contrib/examples/uhttpd/home/index.html b/harbour/contrib/examples/uhttpd/home/index.html index ebe21fc1be..51ad591381 100644 --- a/harbour/contrib/examples/uhttpd/home/index.html +++ b/harbour/contrib/examples/uhttpd/home/index.html @@ -6,19 +6,39 @@ -Simple uHTTPD server demo. -
+

Simple uHTTPD server demo


Examples:
-Test Ajax -
-Test Ajax XML Database -
-Test Ajax Counter -
-Server Status -
-Alias to /cgi-bin/info.hrb page with server variables + + +
+(*) Before run these examples, please build files in /uhttpd/modules folder using bldhrb.bat +
+(**) This example requires LIBGD + + diff --git a/harbour/contrib/examples/uhttpd/home/postsample.html b/harbour/contrib/examples/uhttpd/home/postsample.html new file mode 100644 index 0000000000..712a46cbfe --- /dev/null +++ b/harbour/contrib/examples/uhttpd/home/postsample.html @@ -0,0 +1,23 @@ + + + + +Harbour uHTTPD Server post example + + + +

Simple uHTTPD server method POST

+
+
+ +
+ Type something: + +
+Pressing button you will redirect to /info page. Look at POST and REQUEST values. +
You will see a "word" variable name. +
+
Return to Main Page + + + diff --git a/harbour/contrib/examples/uhttpd/home/testxmldb.html b/harbour/contrib/examples/uhttpd/home/testxmldb.html index 5e097849cd..ef301592b8 100644 --- a/harbour/contrib/examples/uhttpd/home/testxmldb.html +++ b/harbour/contrib/examples/uhttpd/home/testxmldb.html @@ -74,9 +74,14 @@ - Sample XML servlet. Tested with IE6+ and Firefox 2+ + Simple XML servlet +
+
Tested with IE6+, Firefox 2+ and Opera 9+. Not working with Google Chrome. +
Please note that tableservletdb.prg simulates a slow reply of 0.5 seconds. + If you want to check real speed please comment #define SIMULATE_SLOW_REPLY in source.
Return to Main Page -
Page  +
+
Select a Page 
 

diff --git a/harbour/contrib/examples/uhttpd/modules/bldhrb.bat b/harbour/contrib/examples/uhttpd/modules/bldhrb.bat index a83b992af6..874d0696ee 100644 --- a/harbour/contrib/examples/uhttpd/modules/bldhrb.bat +++ b/harbour/contrib/examples/uhttpd/modules/bldhrb.bat @@ -19,7 +19,7 @@ SET HB_BIN_INSTALL=%HB_INSTALL%\bin set HB_INC_INSTALL=include;%HB_INSTALL%\include set HB_LIB_INSTALL=%HB_INSTALL%\lib -%HB_BIN_INSTALL%\harbour %1.prg -n -q0 -w -es2 -gh -i%HB_INC_INSTALL% %2 %3 %HARBOURFLAGS% > bldtest.log +%HB_BIN_INSTALL%\harbour %1.prg -n -q0 -w3 -es2 -gh -i%HB_INC_INSTALL% %2 %3 %HARBOURFLAGS% > bldtest.log IF ERRORLEVEL 1 GOTO SHOWERROR diff --git a/harbour/contrib/examples/uhttpd/modules/cookie.prg b/harbour/contrib/examples/uhttpd/modules/cookie.prg new file mode 100644 index 0000000000..6a796a239f --- /dev/null +++ b/harbour/contrib/examples/uhttpd/modules/cookie.prg @@ -0,0 +1,116 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * uHTTPD cookie example + * + * Copyright 2009 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "common.ch" +#include "hbclass.ch" + +MEMVAR _REQUEST + +#xcommand TEXT INTO => #pragma __cstream|+=%s +//#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 ) + + DEFAULT cCookie TO "" + DEFAULT cAction TO "" + + // Sample page embedded + TEXT INTO cHtml + + + + +Harbour uHTTPD Server cookie example + + + +

Simple uHTTPD server cookie example

+
+
+ +
+ Type something: + + +
+Pressing button you will redirect to /info page. Look at COOKIE values. +
You will see a "mycookie" variable name. +
+
Return to Main Page + + + + ENDTEXT + + IF Empty( cAction ) + // Set a simple cookie + oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 ) + // cleaning previous cookie + oCookie:DeleteCookie( "mycookie" ) + + cHtml := StrTran( cHtml, "<%COOKIE_VALUE%>", cCookie ) + ELSEIF cAction == "gotoinfo" + // Set a simple cookie + oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 ) + oCookie:SetCookie( "mycookie", cCookie ) + uhttpd_AddHeader( "Location", "/info" ) + //uhttpd_Write( "cookie set Go to info page" ) + RETURN NIL + ENDIF + +RETURN cHtml diff --git a/harbour/contrib/examples/uhttpd/modules/info.prg b/harbour/contrib/examples/uhttpd/modules/info.prg index 63af5e9fc9..675ef892d8 100644 --- a/harbour/contrib/examples/uhttpd/modules/info.prg +++ b/harbour/contrib/examples/uhttpd/modules/info.prg @@ -59,7 +59,7 @@ #include "common.ch" #include "hbclass.ch" -MEMVAR _SERVER, _REQUEST, _GET, _POST +MEMVAR _SERVER, _REQUEST, _GET, _POST, _COOKIE, _HTTP_REQUEST FUNCTION HRBMAIN() LOCAL cHtml @@ -70,21 +70,34 @@ FUNCTION HRBMAIN() STATIC FUNCTION ShowServerInfo() LOCAL cHtml := "" + //LOCAL oCookie + + cHtml += "Server Info" + //cHtml += "

If it is first time you see this page reload it to see cookies

" + cHtml += '

Return to Main Page

' cHtml += DisplayVars( _Server , "SERVER Vars" ) cHtml += "
" + cHtml += DisplayVars( _HTTP_REQUEST , "HTTP Headers" ) + cHtml += "
" cHtml += DisplayVars( _Get , "GET Vars" ) cHtml += "
" cHtml += DisplayVars( _Post , "POST Vars" ) cHtml += "
" - //cHtml += DisplayVars( _Cookie , "COOKIE Vars" ) - //cHtml += "
" + cHtml += DisplayVars( _Cookie , "COOKIE Vars" ) + cHtml += "
" //cHtml += DisplayVars( _Files , "FILE Vars" ) //cHtml += "
" cHtml += DisplayVars( _Request, "REQUEST Vars" ) cHtml += "
" //cHtml += DisplayVars( _Session, "SESSION Vars" ) //cHtml += "
" + + // Set a simple cookie + //oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 ) + //oCookie:SetCookie( "samplecookie", "test" ) + //oCookie:SetCookie( "samplecookie2", "test2" ) + RETURN cHtml STATIC FUNCTION DisplayVars( hHash, cTitle ) @@ -101,12 +114,26 @@ RETURN cHtml STATIC FUNCTION DisplayHash( hHash ) LOCAL cHtml := "" - LOCAL cKey, cSubKey + LOCAL cKey, cSubKey, xValue FOR EACH cKey IN hHash:Keys cHtml += "" - cHtml += "" + hb_cStr( cKey ) + "" - cHtml += "" + hb_cStr( hHash[ cKey ] ) + "" + IF HB_ISHASH( hHash[ cKey ] ) + cHtml += "" + hb_cStr( cKey ) + "" + cHtml += "-------" + FOR EACH cSubKey IN hHash[ cKey ]:Keys + xValue := hHash[ cKey ][ cSubKey ] + cHtml += "" + cHtml += "" + hb_cStr( cSubKey ) + "" + cHtml += "" + IIF( Empty( xValue ), "no value", hb_cStr( xValue ) ) + "" + cHtml += "" + NEXT + ELSE + xValue := hHash[ cKey ] + cHtml += "" + hb_cStr( cKey ) + "" + cHtml += "" + IIF( Empty( xValue ), "no value", hb_cStr( xValue ) ) + "" + ENDIF cHtml += "" NEXT + RETURN cHtml diff --git a/harbour/contrib/examples/uhttpd/modules/showcounter.prg b/harbour/contrib/examples/uhttpd/modules/showcounter.prg index 48dcbb7f0d..2ef4786c61 100644 --- a/harbour/contrib/examples/uhttpd/modules/showcounter.prg +++ b/harbour/contrib/examples/uhttpd/modules/showcounter.prg @@ -65,27 +65,27 @@ MEMVAR _REQUEST // defined in uHTTPD FUNCTION HRBMAIN() LOCAL cHtml - LOCAL cBaseImage + //LOCAL cBaseImage IF HB_HHasKey( _REQUEST, "w" ) cHtml := CreateCounter( AllTrim( Str( Val( _REQUEST[ "w" ] ) ) ) ) //hb_ToOutDebug( hb_sprintf( "CreateCounter = %s", cHtml ) ) IF !Empty( cHtml ) - uAddHeader( "Content-Type", "image/gif" ) - uAddHeader( "Pragma", "no-cache" ) - uAddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" ) - uWrite( cHtml ) + uhttpd_AddHeader( "Content-Type", "image/gif" ) + uhttpd_AddHeader( "Pragma", "no-cache" ) + uhttpd_AddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" ) + uhttpd_Write( cHtml ) ELSE - uAddHeader( "Content-Type", "text/html" ) - uWrite( "

Error: No image created

" ) + uhttpd_AddHeader( "Content-Type", "text/html" ) + uhttpd_Write( "

Error: No image created

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

Error: no parameters passed

" ) + uhttpd_AddHeader( "Content-Type", "text/html" ) + uhttpd_Write( "

Error: no parameters passed

" ) ENDIF @@ -95,10 +95,10 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage ) LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp //LOCAL black, white, blue, red, green, cyan, gray - LOCAL white + //LOCAL white LOCAL aNumberImages := {} LOCAL n, nValue - LOCAL cFile + //LOCAL cFile // A value if not passed DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM ) @@ -158,7 +158,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage ) CASE nWidth % 13 == 0 // 0..9 : am pm nDigits := 13 OTHERWISE - uWrite( "Error on digits image" ) + uhttpd_Write( "Error on digits image" ) ENDCASE nNumWidth := nWidth / nDigits @@ -178,7 +178,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage ) //? "Image dimensions: ", oI:Width(), oI:Height() /* Allocate background */ - white := oI:SetColor( 255, 255, 255 ) + //white := oI:SetColor( 255, 255, 255 ) /* Allocate drawing color */ //black := oI:SetColor( 0, 0, 0 ) @@ -203,7 +203,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage ) NEXT /* Write Final Counter Image */ - cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif" + //cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif" //oI:SaveGif( IMAGES_OUT + cFile ) /* Destroy images in memory */ diff --git a/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg b/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg index 9cf005abaf..87e9d89ec9 100644 --- a/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg +++ b/harbour/contrib/examples/uhttpd/modules/tableservletdb.prg @@ -107,18 +107,18 @@ FUNCTION HRBMAIN() IF !Empty( cXml ) - uAddHeader("Content-Type", "text/xml") + uhttpd_AddHeader("Content-Type", "text/xml") // cache control - uAddHeader( "Cache-Control", "no-cache, must-revalidate" ) - uAddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" ) + uhttpd_AddHeader( "Cache-Control", "no-cache, must-revalidate" ) + uhttpd_AddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" ) - uWrite( cXml ) + uhttpd_Write( cXml ) ELSE - uAddHeader("Content-Type", "text/xml") - uWrite( '' ) - uWrite( 'No Data' ) + uhttpd_AddHeader("Content-Type", "text/xml") + uhttpd_Write( '' ) + uhttpd_Write( 'No Data' ) ENDIF diff --git a/harbour/contrib/examples/uhttpd/uhttpd.ini b/harbour/contrib/examples/uhttpd/uhttpd.ini index 382c377be3..b5701b8e22 100644 --- a/harbour/contrib/examples/uhttpd/uhttpd.ini +++ b/harbour/contrib/examples/uhttpd/uhttpd.ini @@ -33,3 +33,4 @@ # --- here put aliases to real path # (under document_root path defined above) /info = /cgi-bin/info.hrb +/cookie = /cgi-bin/cookie.hrb diff --git a/harbour/contrib/examples/uhttpd/uhttpd.prg b/harbour/contrib/examples/uhttpd/uhttpd.prg index c898e3ab80..fccf5cac0a 100644 --- a/harbour/contrib/examples/uhttpd/uhttpd.prg +++ b/harbour/contrib/examples/uhttpd/uhttpd.prg @@ -90,7 +90,7 @@ #ifdef GD_SUPPORT // adding GD support - REQUEST GDIMAGE, gdImageChar, GDCHART + REQUEST GDIMAGE, GDIMAGECHAR, GDCHART #define APP_GD_SUPPORT "_GD" #else #define APP_GD_SUPPORT "" @@ -103,7 +103,7 @@ #endif #define APP_NAME "uhttpd" -#define APP_VER_NUM "0.4" +#define APP_VER_NUM "0.4.1" #define APP_VERSION APP_VER_NUM + APP_GD_SUPPORT + APP_INET_SUPPORT #define AF_INET 2 @@ -121,10 +121,13 @@ #define FILE_ACCESS_LOG "logs\access.log" #define FILE_ERROR_LOG "logs\error.log" -#define PAGE_STATUS_REFRESH 1 +#define PAGE_STATUS_REFRESH 5 #define THREAD_MAX_WAIT ( 60 ) // HOW MUCH TIME THREAD HAS TO WAIT BEFORE FINISH - IN SECONDS #define CGI_MAX_EXEC_TIME 30 +// TOCHECK: Caching of HRB modules (Is this faster than loading HRBBody from file where OS will cache ?) +#define HRB_ACTIVATE_CACHE .F. // if .T. caching of HRB modules will be enabled. (NOTE: changes of files will not be loaded until server is active) + #define CR_LF (CHR(13)+CHR(10)) #define HB_IHASH() HB_HSETCASEMATCH( {=>}, FALSE ) @@ -156,6 +159,7 @@ DYNAMIC HRBMAIN STATIC s_hmtxQueue, s_hmtxServiceThreads, s_hmtxRunningThreads, s_hmtxLog, s_hmtxConsole, s_hmtxBusy STATIC s_hmtxHRB, s_hmtxCGIKill + STATIC s_hfileLogAccess, s_hfileLogError, s_cDocumentRoot, s_lIndexes, s_lConsole, s_nPort STATIC s_nThreads, s_nStartThreads, s_nMaxThreads STATIC s_nServiceThreads, s_nStartServiceThreads, s_nMaxServiceThreads @@ -163,31 +167,32 @@ STATIC s_nConnections, s_nMaxConnections, s_nTotConnections STATIC s_nServiceConnections, s_nMaxServiceConnections, s_nTotServiceConnections STATIC s_aRunningThreads := {} STATIC s_aServiceThreads := {} +STATIC s_hHRBModules := {=>} #ifdef USE_HB_INET STATIC s_cLocalAddress, s_nLocalPort #endif // ALIASES: now read from ini file -//STATIC s_hFileAliases := { "/info" => "/cgi-bin/info.hrb" } -STATIC s_hFileAliases := { => } +//STATIC s_hScriptAliases := { "/info" => "/cgi-bin/info.hrb" } +STATIC s_hScriptAliases := { => } THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_cErrorMsg THREAD STATIC t_hProc -MEMVAR _SERVER, _GET, _POST, _REQUEST, _HTTP_REQUEST, m_cPost +MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST, m_cPost ANNOUNCE ERRORSYS FUNCTION MAIN( ... ) -LOCAL nPort, hListen, hSocket, aRemote, cI, xVal -LOCAL aThreads, nStartThreads, nMaxThreads, nStartServiceThreads -LOCAL i, cPar, lStop -LOCAL cGT, cDocumentRoot, lIndexes, cConfig -LOCAL lConsole -LOCAL nProgress := 0 -LOCAL hDefault, cLogAccess, cLogError -LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads + LOCAL nPort, hListen, hSocket, aRemote, cI, xVal + LOCAL aThreads, nStartThreads, nMaxThreads, nStartServiceThreads + LOCAL i, cPar, lStop + LOCAL cGT, cDocumentRoot, lIndexes, cConfig + LOCAL lConsole + LOCAL nProgress := 0 + LOCAL hDefault, cLogAccess, cLogError + LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads IF !HB_MTVM() ? "I need multhread support. Please, recompile me!" @@ -199,7 +204,7 @@ LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads SysSettings() - ErrorBlock( { | oError | httpd_DefError( oError ) } ) + ErrorBlock( { | oError | uhttpd_DefError( oError ) } ) // ----------------------- Parameters defaults ----------------------------- @@ -217,46 +222,46 @@ LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads ENDIF // TOCHECK: now not force case insensitive - //HB_HSETCASEMATCH( s_hFileAliases, FALSE ) + //HB_HSETCASEMATCH( s_hScriptAliases, FALSE ) // ----------------- Line command parameters checking ---------------------- i := 1 - while ( i <= PCount() ) + DO WHILE ( i <= PCount() ) cPar := hb_PValue( i++ ) - do case - case cPar == "--port" .OR. cPar == "-p" + DO CASE + CASE cPar == "--port" .OR. cPar == "-p" cCmdPort := hb_PValue( i++ ) - case cPar == "--docroot" .OR. cPar == "-d" + CASE cPar == "--docroot" .OR. cPar == "-d" cCmdDocumentRoot := hb_PValue( i++ ) - case cPar == "--indexes" .OR. cPar == "-i" + CASE cPar == "--indexes" .OR. cPar == "-i" lCmdIndexes := TRUE - case cPar == "--stop" .OR. cPar == "-s" + CASE cPar == "--stop" .OR. cPar == "-s" lStop := TRUE - case cPar == "--config" .OR. cPar == "-c" + CASE cPar == "--config" .OR. cPar == "-c" cConfig := hb_PValue( i++ ) - case cPar == "--start-threads" .OR. cPar == "-ts" + CASE cPar == "--start-threads" .OR. cPar == "-ts" nCmdStartThreads := Val( hb_PValue( i++ ) ) - case cPar == "--max-threads" .OR. cPar == "-tm" + CASE cPar == "--max-threads" .OR. cPar == "-tm" nCmdMaxThreads := Val( hb_PValue( i++ ) ) - case cPar == "--help" .OR. Lower( cPar ) == "-h" .OR. cPar == "-?" + CASE cPar == "--help" .OR. Lower( cPar ) == "-h" .OR. cPar == "-?" help() RETURN 0 - otherwise + OTHERWISE help() RETURN 0 - endcase - enddo + ENDCASE + ENDDO // -------------------- checking STOP request ------------------------------- @@ -287,12 +292,12 @@ LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads FOR EACH xVal IN hDefault[ "ALIASES" ] IF HB_ISSTRING( xVal ) - hb_HSet( s_hFileAliases, xVal:__enumKey(), xVal ) + hb_HSet( s_hScriptAliases, xVal:__enumKey(), xVal ) ENDIF NEXT //hb_ToOutDebug( "hDefault = %s\n\r", hb_ValToExp( hDefault ) ) - //hb_ToOutDebug( "s_hFileAliases = %s\n\r", hb_ValToExp( s_hFileAliases ) ) + //hb_ToOutDebug( "s_hScriptAliases = %s\n\r", hb_ValToExp( s_hScriptAliases ) ) // ------------------- Parameters forced from command line ---------------- @@ -539,731 +544,616 @@ LOCAL cCmdPort, cCmdDocumentRoot, lCmdIndexes, nCmdStartThreads, nCmdMaxThreads SET CURSOR ON -RETURN 0 + RETURN 0 // --------------------------------------------------------------------------------- // // THREAD FUNCTIONS // --------------------------------------------------------------------------------- // STATIC FUNCTION AcceptConnections() - LOCAL hSocket - LOCAL nConnections, nThreads, nMaxThreads, n - LOCAL nServiceConnections, nServiceThreads, nMaxServiceThreads, nThreadID - LOCAL pThread + LOCAL hSocket + LOCAL nConnections, nThreads, nMaxThreads, n + LOCAL nServiceConnections, nServiceThreads, nMaxServiceThreads, nThreadID + LOCAL pThread - WriteToConsole( "Starting AcceptConnections()" ) + WriteToConsole( "Starting AcceptConnections()" ) - // Starting initial running threads - FOR n := 1 TO s_nStartThreads - pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) - AADD( s_aRunningThreads, { pThread, nThreadID } ) - NEXT + // Starting initial running threads + FOR n := 1 TO s_nStartThreads + pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) + AADD( s_aRunningThreads, { pThread, nThreadID } ) + NEXT - // Starting initial service threads - FOR n := 1 TO s_nStartServiceThreads - pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) - AADD( s_aServiceThreads, { pThread, nThreadID } ) - NEXT + // Starting initial service threads + FOR n := 1 TO s_nStartServiceThreads + pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) + AADD( s_aServiceThreads, { pThread, nThreadID } ) + NEXT - // Main AcceptConnections loop - DO WHILE .T. + // Main AcceptConnections loop + DO WHILE .T. - // reset socket - hSocket := NIL + // reset socket + hSocket := NIL - // releasing resources - WIN_SYSREFRESH( 1 ) + // releasing resources + WIN_SYSREFRESH( 1 ) - // Waiting a connection from main application loop - hb_mutexSubscribe( s_hmtxQueue,, @hSocket ) + // Waiting a connection from main application loop + hb_mutexSubscribe( s_hmtxQueue,, @hSocket ) - // I have a QUIT request - IF hSocket == NIL + // I have a QUIT request + IF hSocket == NIL - // Requesting to Running threads to quit (using -1 value) - AEVAL( s_aRunningThreads, {|| hb_mutexNotify( s_hmtxRunningThreads, -1 ) } ) - // waiting running threads to quit - AEVAL( s_aRunningThreads, {|h| hb_threadJoin( h[1] ) } ) + // Requesting to Running threads to quit (using -1 value) + AEVAL( s_aRunningThreads, {|| hb_mutexNotify( s_hmtxRunningThreads, -1 ) } ) + // waiting running threads to quit + AEVAL( s_aRunningThreads, {|h| hb_threadJoin( h[1] ) } ) - // Requesting to Service threads to quit (using -1 value) - AEVAL( s_aServiceThreads, {|| hb_mutexNotify( s_hmtxServiceThreads, -1 ) } ) - // waiting service threads to quit - AEVAL( s_aServiceThreads, {|h| hb_threadJoin( h[1] ) } ) + // Requesting to Service threads to quit (using -1 value) + AEVAL( s_aServiceThreads, {|| hb_mutexNotify( s_hmtxServiceThreads, -1 ) } ) + // waiting service threads to quit + AEVAL( s_aServiceThreads, {|h| hb_threadJoin( h[1] ) } ) - EXIT - ENDIF + EXIT + ENDIF - // Load current state - IF hb_mutexLock( s_hmtxBusy ) - nConnections := s_nConnections - nThreads := s_nThreads - nMaxThreads := s_nMaxThreads - nServiceConnections:= s_nServiceConnections - nServiceThreads := s_nServiceThreads - nMaxServiceThreads := s_nMaxServiceThreads - hb_mutexUnlock( s_hmtxBusy ) - ENDIF + // Load current state + IF hb_mutexLock( s_hmtxBusy ) + nConnections := s_nConnections + nThreads := s_nThreads + nMaxThreads := s_nMaxThreads + nServiceConnections:= s_nServiceConnections + nServiceThreads := s_nServiceThreads + nMaxServiceThreads := s_nMaxServiceThreads + hb_mutexUnlock( s_hmtxBusy ) + ENDIF - // If I have no more thread to use ... - IF nConnections > nMaxThreads + // If I have no more threads to use ... + IF nConnections > nMaxThreads - // If I have no more of service threads to use ... (DOS attack ?) - IF nServiceConnections > nMaxServiceThreads - // DROP connection + // If I have no more of service threads to use ... (DOS attack ?) + IF nServiceConnections > nMaxServiceThreads + // DROP connection #ifdef USE_HB_INET - hb_InetClose( hSocket ) + hb_InetClose( hSocket ) #else - socket_shutdown( hSocket ) - socket_close( hSocket ) + socket_shutdown( hSocket ) + socket_close( hSocket ) #endif - // If I have no service threads in use ... - ELSEIF nServiceConnections >= nServiceThreads - // Add one more - pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) - AADD( s_aServiceThreads, { pThread, nThreadID } ) - ENDIF - // Otherwise I send connection to service thread - hb_mutexNotify( s_hmtxServiceThreads, hSocket ) + // If I have no service threads in use ... + ELSEIF nServiceConnections >= nServiceThreads + // Add one more + pThread := hb_threadStart( @ServiceConnection(), @nThreadID ) + AADD( s_aServiceThreads, { pThread, nThreadID } ) + ENDIF + // Otherwise I send connection to service thread + hb_mutexNotify( s_hmtxServiceThreads, hSocket ) - LOOP + LOOP - // If I have no running threads in use ... - ELSEIF nConnections >= nThreads - // Add one more - pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) - AADD( s_aRunningThreads, { pThread, nThreadID } ) - ENDIF - // Otherwise I send connection to running thread - hb_mutexNotify( s_hmtxRunningThreads, hSocket ) + // If I have no running threads in use ... + ELSEIF nConnections >= nThreads + // Add one more + pThread := hb_threadStart( @ProcessConnection(), @nThreadID ) + AADD( s_aRunningThreads, { pThread, nThreadID } ) + ENDIF + // Otherwise I send connection to running thread + hb_mutexNotify( s_hmtxRunningThreads, hSocket ) - ENDDO + ENDDO - WriteToConsole( "Quitting AcceptConnections()" ) + WriteToConsole( "Quitting AcceptConnections()" ) -RETURN 0 + RETURN 0 // --------------------------------------------------------------------------------- // // CONNECTIONS // --------------------------------------------------------------------------------- // -STATIC FUNCTION ProcessConnection( nThreadId ) -LOCAL hSocket, cBuf, nLen, cRequest, cSend -LOCAL nMsecs, nParseTime, nPos -//LOCAL nThreadId +STATIC FUNCTION ProcessConnection( /*@*/ nThreadId ) + LOCAL hSocket, nLen, cRequest, cSend + LOCAL nMsecs, nParseTime, nPos + + nThreadId := hb_threadID() + + ErrorBlock( { | oError | uhttpd_DefError( oError ) } ) + + WriteToConsole( "Starting ProcessConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nThreads++ + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // ProcessConnection Loop + DO WHILE .T. + + // Reset socket + hSocket := NIL + + // releasing resources + WIN_SYSREFRESH( 1 ) + + // Waiting a connection from AcceptConnections() but up to defined time + hb_mutexSubscribe( s_hmtxRunningThreads, THREAD_MAX_WAIT, @hSocket ) + + // received a -1 value, I have to quit + IF HB_ISNUMERIC( hSocket ) + EXIT + // no socket received, thread can graceful quit only if over minimal number + ELSEIF hSocket == NIL + IF hb_mutexLock( s_hmtxBusy ) + IF s_nThreads <= s_nStartThreads + hb_mutexUnlock( s_hmtxBusy ) + LOOP + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + EXIT + ENDIF + + // Connection accepted + IF hb_mutexLock( s_hmtxBusy ) + s_nConnections++ + s_nTotConnections++ + s_nMaxConnections := Max( s_nConnections, s_nMaxConnections ) + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // Save initial time + nMsecs := hb_milliseconds() + + BEGIN SEQUENCE + + /* receive query */ + nLen := readRequest( hSocket, @cRequest ) + + IF nLen == -1 #ifdef USE_HB_INET -LOCAL nRcvLen, nContLen + ? "recv() error:", hb_InetErrorCode( hSocket ), hb_InetErrorDesc( hSocket ) #else -LOCAL aI + ? "recv() error:", socket_error() #endif - nThreadId := hb_threadID() - //nThreadIdRef := nThreadId + ELSEIF nLen == 0 /* connection closed */ + ELSE - ErrorBlock( { | oError | httpd_DefError( oError ) } ) + //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) - WriteToConsole( "Starting ProcessConnections() " + hb_CStr( nThreadId ) ) + PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _COOKIE := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost + t_cResult := "" + t_aHeader := {} + t_nStatusCode := 200 + t_cErrorMsg := "" - IF hb_mutexLock( s_hmtxBusy ) - s_nThreads++ - hb_mutexUnlock( s_hmtxBusy ) - ENDIF + defineServerAdresses( hSocket ) - // ProcessConnection Loop - DO WHILE .T. + IF ParseRequest( cRequest ) + //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) + define_Env( _SERVER ) + cSend := uproc_default() + ELSE + uhttpd_SetStatusCode( 400 ) + cSend := MakeResponse() + ENDIF - // Reset socket - hSocket := NIL + //hb_ToOutDebug( "cSend = %s\n\r", cSend ) - // releasing resources - WIN_SYSREFRESH( 1 ) + sendReply( hSocket, cSend ) - // Waiting a connection from AcceptConnections() but up to defined time - hb_mutexSubscribe( s_hmtxRunningThreads, THREAD_MAX_WAIT, @hSocket ) + WriteToLog( cRequest ) - // received a -1 value, I have to quit - IF HB_ISNUMERIC( hSocket ) - EXIT - // no socket received, thread can graceful quit only if over minimal number - ELSEIF hSocket == NIL - IF hb_mutexLock( s_hmtxBusy ) - IF s_nThreads <= s_nStartThreads - hb_mutexUnlock( s_hmtxBusy ) - LOOP - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - EXIT - ENDIF - - // Connection accepted - IF hb_mutexLock( s_hmtxBusy ) - s_nConnections++ - s_nTotConnections++ - s_nMaxConnections := Max( s_nConnections, s_nMaxConnections ) - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // Save initial time - nMsecs := hb_milliseconds() - - BEGIN SEQUENCE - - /* receive query */ -#ifdef USE_HB_INET - cRequest := "" - nLen := 0 - nRcvLen := 1 - nContLen := 0 - DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 - cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) - //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) - cRequest += cBuf + CR_LF - nLen += nRcvLen - IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 - cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) - nContLen := Val( cBuf ) - ENDIF - ENDDO - - //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) - // if the request has a content-lenght, we must read it - IF nLen > 0 .AND. nContLen > 0 - // cPostData is autoAllocated - cBuf := Space( nContLen ) - IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 - nLen := -1 // force error check - ELSE - cRequest += cBuf - ENDIF - ENDIF -#else - cRequest := "" - nLen := 1 - DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 - nLen := socket_recv( hSocket, @cBuf ) - cRequest += cBuf - ENDDO -#endif - - IF nLen == -1 -#ifdef USE_HB_INET - ? "recv() error:", HB_INETERRORCODE( hSocket ), HB_INETERRORDESC( hSocket ) -#else - ? "recv() error:", socket_error() -#endif - - ELSEIF nLen == 0 /* connection closed */ - ELSE - - //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) - - PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost - t_cResult := "" - t_aHeader := {} - t_nStatusCode := 200 - t_cErrorMsg := "" + ENDIF #ifdef USE_HB_INET - _SERVER["REMOTE_ADDR"] := hb_InetAddress( hSocket ) - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := hb_InetPort( hSocket ) - - _SERVER["SERVER_ADDR"] := s_cLocalAddress - _SERVER["SERVER_PORT"] := LTrim( Str( s_nLocalPort ) ) + hb_InetClose( hSocket ) #else - IF socket_getpeername( hSocket, @aI ) != -1 - _SERVER["REMOTE_ADDR"] := aI[2] - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := aI[3] - ENDIF - - IF socket_getsockname( hSocket, @aI ) != -1 - _SERVER["SERVER_ADDR"] := aI[2] - _SERVER["SERVER_PORT"] := LTrim( Str( aI[3] ) ) - ENDIF + socket_shutdown( hSocket ) + socket_close( hSocket ) #endif - IF ParseRequest( cRequest ) - //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) - define_Env( _SERVER ) - cSend := uproc_default() - ELSE - uSetStatusCode( 400 ) - cSend := MakeResponse() - ENDIF + END SEQUENCE - //hb_ToOutDebug( "cSend = %s\n\r", cSend ) + nParseTime := hb_milliseconds() - nMsecs + WriteToConsole( "Page served in : " + Str( nParseTime/1000, 7, 4 ) + " seconds" ) + IF hb_mutexLock( s_hmtxBusy ) + s_nConnections-- + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + ENDDO + + WriteToConsole( "Quitting ProcessConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nThreads-- + IF ( nPos := aScan( s_aRunningThreads, {|h| h[2] == nThreadId } ) > 0 ) + hb_aDel( s_aRunningThreads, nPos, TRUE ) + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + RETURN 0 + +STATIC FUNCTION ServiceConnection( /*@*/ nThreadId ) + LOCAL hSocket, nLen, cRequest, cSend + LOCAL nMsecs, nParseTime, nPos + LOCAL nError := 500013 + + ErrorBlock( { | oError | uhttpd_DefError( oError ) } ) + + nThreadId := hb_threadID() + //nThreadIdRef := nThreadId + + WriteToConsole( "Starting ServiceConnections() " + hb_CStr( nThreadId ) ) + + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceThreads++ + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + DO WHILE .T. + + // Reset socket + hSocket := NIL + + // releasing resources + WIN_SYSREFRESH( 1 ) + + // Waiting a connection from AcceptConnections() but up to defined time + hb_mutexSubscribe( s_hmtxServiceThreads, THREAD_MAX_WAIT, @hSocket ) + + // received a -1 value, I have to quit + IF HB_ISNUMERIC( hSocket ) + EXIT + // no socket received, thread can graceful quit only if over minimal number + ELSEIF hSocket == NIL + IF hb_mutexLock( s_hmtxBusy ) + IF s_nServiceThreads <= s_nStartServiceThreads + hb_mutexUnlock( s_hmtxBusy ) + LOOP + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + EXIT + ENDIF + + // Connection accepted + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceConnections++ + s_nTotServiceConnections++ + s_nMaxServiceConnections := Max( s_nServiceConnections, s_nMaxServiceConnections ) + hb_mutexUnlock( s_hmtxBusy ) + ENDIF + + // Save initial time + nMsecs := hb_milliseconds() + + BEGIN SEQUENCE + + /* receive query */ + nLen := readRequest( hSocket, @cRequest ) + + IF nLen == -1 #ifdef USE_HB_INET - DO WHILE LEN( cSend ) > 0 - IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 - ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) - WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO + ? "recv() error:", hb_InetErrorCode( hSocket ), hb_InetErrorDesc( hSocket ) #else - DO WHILE LEN( cSend ) > 0 - IF ( nLen := socket_send( hSocket, cSend ) ) == -1 - ? "send() error:", socket_error() - WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO + ? "recv() error:", socket_error() #endif - WriteToLog( cRequest ) + ELSEIF nLen == 0 /* connection closed */ + ELSE - ENDIF + //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 + t_cResult := "" + t_aHeader := {} + t_nStatusCode := 200 + t_cErrorMsg := "" + + defineServerAdresses( hSocket ) + + IF ParseRequest( cRequest ) + //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) + define_Env( _SERVER ) + ENDIF + // Error page served + uhttpd_SetStatusCode( nError ) + cSend := MakeResponse() + + sendReply( hSocket, cSend ) + + WriteToLog( cRequest ) + + ENDIF #ifdef USE_HB_INET - hb_InetClose( hSocket ) + hb_InetClose( hSocket ) #else - socket_shutdown( hSocket ) - socket_close( hSocket ) + socket_shutdown( hSocket ) + socket_close( hSocket ) #endif - END SEQUENCE + END SEQUENCE - nParseTime := hb_milliseconds() - nMsecs - WriteToConsole( "Page served in : " + Str( nParseTime/1000, 10, 7 ) + " seconds" ) + nParseTime := hb_milliseconds() - nMsecs + WriteToConsole( "Page served in : " + Str( nParseTime/1000, 7, 4 ) + " seconds" ) - IF hb_mutexLock( s_hmtxBusy ) - s_nConnections-- - hb_mutexUnlock( s_hmtxBusy ) - ENDIF + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceConnections-- + hb_mutexUnlock( s_hmtxBusy ) + ENDIF - ENDDO + ENDDO - WriteToConsole( "Quitting ProcessConnections() " + hb_CStr( nThreadId ) ) + WriteToConsole( "Quitting ServiceConnections() " + hb_CStr( nThreadId ) ) - IF hb_mutexLock( s_hmtxBusy ) - s_nThreads-- - IF ( nPos := aScan( s_aRunningThreads, {|h| h[2] == nThreadId } ) > 0 ) - hb_aDel( s_aRunningThreads, nPos, TRUE ) - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF + IF hb_mutexLock( s_hmtxBusy ) + s_nServiceThreads-- + IF ( nPos := aScan( s_aServiceThreads, {|h| h[2] == nThreadId } ) > 0 ) + hb_aDel( s_aServiceThreads, nPos, TRUE ) + ENDIF + hb_mutexUnlock( s_hmtxBusy ) + ENDIF -RETURN 0 - -STATIC FUNCTION ServiceConnection( nThreadId ) -LOCAL hSocket, cBuf, nLen, cRequest, cSend -LOCAL nMsecs, nParseTime, nPos -//LOCAL nThreadId -LOCAL nError := 500013 -#ifdef USE_HB_INET -LOCAL nRcvLen, nContLen -#else -LOCAL aI -#endif - - ErrorBlock( { | oError | httpd_DefError( oError ) } ) - - nThreadId := hb_threadID() - //nThreadIdRef := nThreadId - - WriteToConsole( "Starting ServiceConnections() " + hb_CStr( nThreadId ) ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceThreads++ - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - DO WHILE .T. - - // Reset socket - hSocket := NIL - - // releasing resources - WIN_SYSREFRESH( 1 ) - - // Waiting a connection from AcceptConnections() but up to defined time - hb_mutexSubscribe( s_hmtxServiceThreads, THREAD_MAX_WAIT, @hSocket ) - - // received a -1 value, I have to quit - IF HB_ISNUMERIC( hSocket ) - EXIT - // no socket received, thread can graceful quit only if over minimal number - ELSEIF hSocket == NIL - IF hb_mutexLock( s_hmtxBusy ) - IF s_nServiceThreads <= s_nStartServiceThreads - hb_mutexUnlock( s_hmtxBusy ) - LOOP - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - EXIT - ENDIF - - // Connection accepted - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceConnections++ - s_nTotServiceConnections++ - s_nMaxServiceConnections := Max( s_nServiceConnections, s_nMaxServiceConnections ) - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - // Save initial time - nMsecs := hb_milliseconds() - - BEGIN SEQUENCE - - /* receive query */ -#ifdef USE_HB_INET - cRequest := "" - nLen := 0 - nRcvLen := 1 - nContLen := 0 - DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 - cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) - //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) - cRequest += cBuf + CR_LF - nLen += nRcvLen - IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 - cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) - nContLen := Val( cBuf ) - ENDIF - ENDDO - - //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) - // if the request has a content-lenght, we must read it - IF nLen > 0 .AND. nContLen > 0 - // cPostData is autoAllocated - cBuf := Space( nContLen ) - IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 - nLen := -1 // force error check - ELSE - cRequest += cBuf - ENDIF - ENDIF -#else - cRequest := "" - nLen := 1 - DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 - nLen := socket_recv( hSocket, @cBuf ) - cRequest += cBuf - ENDDO -#endif - - IF nLen == -1 -#ifdef USE_HB_INET - ? "recv() error:", hb_InetErrorCode( hSocket ), hb_InetErrorDesc( hSocket ) -#else - ? "recv() error:", socket_error() -#endif - ELSEIF nLen == 0 /* connection closed */ - ELSE - - //hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest ) - - PRIVATE _SERVER := HB_IHASH(), _GET := HB_IHASH(), _POST := HB_IHASH(), _REQUEST := HB_IHASH(), _HTTP_REQUEST := HB_IHASH(), m_cPost - t_cResult := "" - t_aHeader := {} - t_nStatusCode := 200 - t_cErrorMsg := "" - -#ifdef USE_HB_INET - _SERVER["REMOTE_ADDR"] := hb_InetAddress( hSocket ) - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := hb_InetPort( hSocket ) - - _SERVER["SERVER_ADDR"] := s_cLocalAddress - _SERVER["SERVER_PORT"] := LTrim( Str( s_nLocalPort ) ) -#else - IF socket_getpeername( hSocket, @aI ) != -1 - _SERVER["REMOTE_ADDR"] := aI[2] - _SERVER["REMOTE_HOST"] := _SERVER["REMOTE_ADDR"] // no reverse DNS - _SERVER["REMOTE_PORT"] := aI[3] - ENDIF - - IF socket_getsockname( hSocket, @aI ) != -1 - _SERVER["SERVER_ADDR"] := aI[2] - _SERVER["SERVER_PORT"] := LTrim( Str( aI[3] ) ) - ENDIF -#endif - - IF ParseRequest( cRequest ) - //hb_ToOutDebug( "_SERVER = %s,\n\r _GET = %s,\n\r _POST = %s,\n\r _REQUEST = %s,\n\r _HTTP_REQUEST = %s\n\r", hb_ValToExp( _SERVER ), hb_ValToExp( _GET ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ), hb_ValToExp( _HTTP_REQUEST ) ) - define_Env( _SERVER ) - ENDIF - // Error page served - uSetStatusCode( nError ) - cSend := MakeResponse() - -#ifdef USE_HB_INET - DO WHILE LEN( cSend ) > 0 - IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 - ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) - WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO -#else - DO WHILE LEN( cSend ) > 0 - IF ( nLen := socket_send( hSocket, cSend ) ) == -1 - ? "send() error:", socket_error() - WriteToConsole( hb_sprintf( "ServiceConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR( cSend, nLen + 1 ) - ENDIF - ENDDO -#endif - - WriteToLog( cRequest ) - - ENDIF -#ifdef USE_HB_INET - hb_InetClose( hSocket ) -#else - socket_shutdown( hSocket ) - socket_close( hSocket ) -#endif - END SEQUENCE - - nParseTime := hb_milliseconds() - nMsecs - WriteToConsole( "Page served in : " + Str( nParseTime/1000, 10, 7 ) + " seconds" ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceConnections-- - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - - ENDDO - - WriteToConsole( "Quitting ServiceConnections() " + hb_CStr( nThreadId ) ) - - IF hb_mutexLock( s_hmtxBusy ) - s_nServiceThreads-- - IF ( nPos := aScan( s_aServiceThreads, {|h| h[2] == nThreadId } ) > 0 ) - hb_aDel( s_aServiceThreads, nPos, TRUE ) - ENDIF - hb_mutexUnlock( s_hmtxBusy ) - ENDIF - -RETURN 0 + RETURN 0 STATIC FUNCTION ParseRequest( cRequest ) -LOCAL aRequest, aLine, nI, nJ, cI -LOCAL cReq, aVal, cPost + LOCAL aRequest, aLine, nI, nJ, cI + LOCAL cReq, aVal, cFields, hVars - // RFC2616 - aRequest := split( CR_LF, cRequest ) + // RFC2616 + aRequest := uhttpd_split( CR_LF, cRequest ) - //hb_ToOutDebug( "aRequest = %s\n\r", hb_ValToExp( aRequest ) ) + //hb_ToOutDebug( "aRequest = %s\n\r", hb_ValToExp( aRequest ) ) - WriteToConsole( aRequest[1] ) - aLine := split( " ", aRequest[1] ) - IF LEN( aLine ) != 3 .OR. ; - ( aLine[1] != "GET" .AND. aLine[1] != "POST" ) .OR. ; // Sorry, we support GET and POST only - LEFT( aLine[3], 5 ) != "HTTP/" - RETURN .F. - ENDIF + WriteToConsole( aRequest[1] ) + aLine := uhttpd_split( " ", aRequest[1] ) + IF LEN( aLine ) != 3 .OR. ; + ( aLine[1] != "GET" .AND. aLine[1] != "POST" ) .OR. ; // Sorry, we support GET and POST only + LEFT( aLine[3], 5 ) != "HTTP/" + RETURN .F. + ENDIF - // define _SERVER var - _SERVER["REQUEST_METHOD"] := aLine[1] - _SERVER["REQUEST_URI"] := aLine[2] - _SERVER["SERVER_PROTOCOL"] := aLine[3] + // define _SERVER var + _SERVER[ "REQUEST_METHOD" ] := aLine[1] + _SERVER[ "REQUEST_URI" ] := aLine[2] + _SERVER[ "SERVER_PROTOCOL" ] := aLine[3] - IF ( nI := AT( "?", _SERVER["REQUEST_URI"] ) ) > 0 - _SERVER["SCRIPT_NAME"] := LEFT( _SERVER["REQUEST_URI"], nI - 1) - _SERVER["QUERY_STRING"] := SUBSTR( _SERVER["REQUEST_URI"], nI + 1) - ELSE - _SERVER["SCRIPT_NAME"] := _SERVER["REQUEST_URI"] - _SERVER["QUERY_STRING"] := "" - ENDIF + IF ( nI := AT( "?", _SERVER["REQUEST_URI"] ) ) > 0 + _SERVER[ "SCRIPT_NAME" ] := LEFT( _SERVER["REQUEST_URI"], nI - 1) + _SERVER[ "QUERY_STRING" ] := SUBSTR( _SERVER["REQUEST_URI"], nI + 1) + ELSE + _SERVER[ "SCRIPT_NAME" ] := _SERVER["REQUEST_URI"] + _SERVER[ "QUERY_STRING" ] := "" + ENDIF - _SERVER["HTTP_ACCEPT"] := "" - _SERVER["HTTP_ACCEPT_CHARSET"] := "" - _SERVER["HTTP_ACCEPT_ENCODING"] := "" - _SERVER["HTTP_ACCEPT_LANGUAGE"] := "" - _SERVER["HTTP_CONNECTION"] := "" - _SERVER["HTTP_HOST"] := "" - _SERVER["HTTP_KEEP_ALIVE"] := "" - _SERVER["HTTP_REFERER"] := "" - _SERVER["HTTP_USER_AGENT"] := "" - _SERVER["HTTP_CACHE_CONTROL"] := "" + _SERVER[ "HTTP_ACCEPT" ] := "" + _SERVER[ "HTTP_ACCEPT_CHARSET" ] := "" + _SERVER[ "HTTP_ACCEPT_ENCODING" ] := "" + _SERVER[ "HTTP_ACCEPT_LANGUAGE" ] := "" + _SERVER[ "HTTP_CONNECTION" ] := "" + _SERVER[ "HTTP_HOST" ] := "" + _SERVER[ "HTTP_KEEP_ALIVE" ] := "" + _SERVER[ "HTTP_REFERER" ] := "" + _SERVER[ "HTTP_USER_AGENT" ] := "" + _SERVER[ "HTTP_CACHE_CONTROL" ] := "" + _SERVER[ "HTTP_COOKIE" ] := "" - FOR nI := 2 TO LEN( aRequest ) - IF aRequest[nI] == ""; EXIT - ELSEIF ( nJ := AT( ":", aRequest[nI] ) ) > 0 - cI := LTRIM( SUBSTR( aRequest[nI], nJ + 1)) - SWITCH UPPER( LEFT( aRequest[nI], nJ - 1)) - CASE "ACCEPT" - CASE "ACCEPT-CHARSET" - CASE "ACCEPT-ENCODING" - CASE "ACCEPT-LANGUAGE" - CASE "CACHE-CONTROL" - CASE "CONNECTION" - CASE "KEEP-ALIVE" - CASE "REFERER" - CASE "USER-AGENT" - _SERVER[ "HTTP_" + STRTRAN( UPPER( LEFT( aRequest[nI], nJ - 1 ) ), "-", "_" ) ] := cI - EXIT - CASE "HOST" - aVal := split( ":", aRequest[ nI ] ) - _SERVER[ "HTTP_" + STRTRAN( UPPER( aVal[ 1 ] ), "-", "_")] := AllTrim( aVal[ 2 ] ) - EXIT - CASE "CONTENT-TYPE" - CASE "CONTENT-LENGTH" - _SERVER[ STRTRAN( UPPER( LEFT( aRequest[ nI ], nJ - 1 ) ), "-", "_" ) ] := cI - EXIT - ENDSWITCH - ENDIF - NEXT - - // GET vars - FOR EACH cI IN split( "&", _SERVER["QUERY_STRING"] ) - IF ( nI := AT( "=", cI ) ) > 0 - _GET[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - _REQUEST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - ELSE - _GET[ cI ] := "" - _REQUEST[ cI ] := "" - ENDIF - NEXT - - // Load _HTTP_REQUEST - FOR EACH cReq IN aRequest - IF cReq:__enumIndex() == 1 // GET request - hb_HSet( _HTTP_REQUEST, "HTTP Request", cReq ) - ELSEIF Empty( cReq ) - EXIT - ELSE - aVal := split( ":", cReq, 1 ) - hb_HSet( _HTTP_REQUEST, aVal[ 1 ], IIF( Len( aVal ) == 2, AllTrim( aVal[ 2 ] ), NIL ) ) + FOR nI := 2 TO LEN( aRequest ) + IF aRequest[nI] == ""; EXIT + ELSEIF ( nJ := AT( ":", aRequest[nI] ) ) > 0 + cI := LTRIM( SUBSTR( aRequest[nI], nJ + 1)) + SWITCH UPPER( LEFT( aRequest[nI], nJ - 1)) + CASE "ACCEPT" + CASE "ACCEPT-CHARSET" + CASE "ACCEPT-ENCODING" + CASE "ACCEPT-LANGUAGE" + CASE "CACHE-CONTROL" + CASE "CONNECTION" + CASE "COOKIE" + CASE "KEEP-ALIVE" + CASE "REFERER" + CASE "USER-AGENT" + _SERVER[ "HTTP_" + STRTRAN( UPPER( LEFT( aRequest[nI], nJ - 1 ) ), "-", "_" ) ] := cI + EXIT + CASE "HOST" + aVal := uhttpd_split( ":", aRequest[ nI ] ) + _SERVER[ "HTTP_" + STRTRAN( UPPER( aVal[ 1 ] ), "-", "_")] := AllTrim( aVal[ 2 ] ) + EXIT + CASE "CONTENT-TYPE" + CASE "CONTENT-LENGTH" + _SERVER[ STRTRAN( UPPER( LEFT( aRequest[ nI ], nJ - 1 ) ), "-", "_" ) ] := cI + EXIT + ENDSWITCH ENDIF - NEXT + NEXT - // POST vars - IF "POST" $ Upper( _SERVER[ 'REQUEST_METHOD' ] ) - //hb_ToOutDebug( "POST: %s\n\r", aTail( aRequest ) ) - cPost := aTail( aRequest ) - FOR EACH cI IN split( "&", cPost ) - IF ( nI := AT( "=", cI ) ) > 0 - _POST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - _REQUEST[ LEFT( cI, nI - 1 )] := SUBSTR( cI, nI + 1 ) - ELSE - _POST[ cI ] := "" - _REQUEST[ cI ] := "" - ENDIF - NEXT - m_cPost := cPost - ENDIF + // Load _HTTP_REQUEST + FOR EACH cReq IN aRequest + IF cReq:__enumIndex() == 1 // GET request + hb_HSet( _HTTP_REQUEST, "HTTP Request", cReq ) + ELSEIF Empty( cReq ) + EXIT + ELSE + aVal := uhttpd_split( ":", cReq, 1 ) + hb_HSet( _HTTP_REQUEST, aVal[ 1 ], IIF( Len( aVal ) == 2, AllTrim( aVal[ 2 ] ), NIL ) ) + ENDIF + NEXT - // Complete _SERVER - _SERVER[ "SERVER_NAME" ] = split( ":", _HTTP_REQUEST[ "HOST" ], 1 )[ 1 ] - _SERVER[ "SERVER_SOFTWARE" ] = APP_NAME + " " + APP_VERSION + " (" + OS() + ")" - _SERVER[ "SERVER_SIGNATURE" ] = "
" + _SERVER[ "SERVER_SOFTWARE" ] + " Server at " + _SERVER[ "SERVER_NAME" ] + " Port " + _SERVER[ "SERVER_PORT" ] + "
" - _SERVER[ "DOCUMENT_ROOT" ] = s_cDocumentRoot - _SERVER[ "SERVER_ADMIN" ] = "root" - _SERVER[ "SCRIPT_FILENAME" ] = STRTRAN( STRTRAN( _SERVER[ "DOCUMENT_ROOT" ] + _SERVER[ "SCRIPT_NAME" ], "//", "/" ), "\", "/" ) - _SERVER[ "GATEWAY_INTERFACE" ] = "CGI/1.1" - _SERVER[ "SCRIPT_URL" ] := _SERVER["SCRIPT_NAME"] - _SERVER[ "SCRIPT_URI" ] := "http://" + _HTTP_REQUEST[ "HOST" ] + _SERVER["SCRIPT_NAME"] + //hb_toOutDebug( "_HTTP_REQUEST: aRequest = %s, _HTTP_REQUEST = %s\n\r", hb_ValToExp( aRequest ), hb_ValToExp( _HTTP_REQUEST ) ) - //hb_ToOutDebug( "_SERVER = %s\n\r", hb_ValToExp( _SERVER ) ) - //hb_ToOutDebug( "_GET = %s\n\r", hb_ValToExp( _GET ) ) - //hb_ToOutDebug( "_POST = %s\n\r", hb_ValToExp( _POST ) ) - //hb_ToOutDebug( "_HTTP_REQUEST = %s\n\r", hb_ValToExp( _HTTP_REQUEST ) ) + // GET + cFields := _SERVER[ "QUERY_STRING" ] + IF !Empty( cFields ) + hVars := uhttpd_GetVars( cFields ) + hb_HMerge( _GET, hVars ) + hb_HMerge( _REQUEST, hVars ) + ENDIF -RETURN .T. + //hb_toOutDebug( "GET: cFields = %s, hVars = %s, _GET = %s, _REQUEST = %s\n\r", cFields, hb_ValToExp( hVars ), hb_ValToExp( _GET ), hb_ValToExp( _REQUEST ) ) + + // POST + IF "POST" $ Upper( _SERVER[ 'REQUEST_METHOD' ] ) + cFields := aTail( aRequest ) + IF !Empty( cFields ) + hVars := uhttpd_GetVars( cFields ) + hb_HMerge( _POST, hVars ) + hb_HMerge( _REQUEST, hVars ) + ENDIF + m_cPost := cFields + ENDIF + + //hb_toOutDebug( "POST: cFields = %s, hVars = %s, _POST = %s, _REQUEST = %s\n\r", cFields, hb_ValToExp( hVars ), hb_ValToExp( _POST ), hb_ValToExp( _REQUEST ) ) + + // COOKIES + cFields := _SERVER[ 'HTTP_COOKIE' ] + IF !Empty( cFields ) + hVars := uhttpd_GetVars( cFields, ";" ) + hb_HMerge( _COOKIE, hVars ) + hb_HMerge( _REQUEST, hVars ) + ENDIF + //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() + ")" + _SERVER[ "SERVER_SIGNATURE" ] := "
" + _SERVER[ "SERVER_SOFTWARE" ] + " Server at " + _SERVER[ "SERVER_NAME" ] + " Port " + _SERVER[ "SERVER_PORT" ] + "
" + _SERVER[ "DOCUMENT_ROOT" ] := s_cDocumentRoot + _SERVER[ "SERVER_ADMIN" ] := "root@localhost" // TOFIX: put real user + _SERVER[ "SCRIPT_FILENAME" ] := STRTRAN( STRTRAN( _SERVER[ "DOCUMENT_ROOT" ] + _SERVER[ "SCRIPT_NAME" ], "//", "/" ), "\", "/" ) + _SERVER[ "GATEWAY_INTERFACE" ] := "CGI/1.1" + _SERVER[ "SCRIPT_URL" ] := _SERVER["SCRIPT_NAME"] + _SERVER[ "SCRIPT_URI" ] := "http://" + _HTTP_REQUEST[ "HOST" ] + _SERVER["SCRIPT_NAME"] + + //hb_ToOutDebug( "_SERVER = %s\n\r", hb_ValToExp( _SERVER ) ) + //hb_ToOutDebug( "_GET = %s\n\r", hb_ValToExp( _GET ) ) + //hb_ToOutDebug( "_POST = %s\n\r", hb_ValToExp( _POST ) ) + //hb_ToOutDebug( "_COOKIE = %s\n\r", hb_ValToExp( _COOKIE ) ) + //hb_ToOutDebug( "_HTTP_REQUEST = %s\n\r", hb_ValToExp( _HTTP_REQUEST ) ) + + RETURN .T. STATIC FUNCTION MakeResponse() -LOCAL cRet, cReturnCode + LOCAL cRet, cReturnCode - uAddHeader("Connection", "close") + uhttpd_AddHeader( "Connection", "close" ) - IF uGetHeader("Location") != NIL - t_nStatusCode := 301 - ENDIF - IF uGetHeader("Content-Type") == NIL - uAddHeader("Content-Type", "text/html") - ENDIF + IF uhttpd_GetHeader( "Location" ) != NIL + t_nStatusCode := 301 + ENDIF + IF uhttpd_GetHeader( "Content-Type" ) == NIL + uhttpd_AddHeader( "Content-Type", "text/html" ) + ENDIF - cRet := "HTTP/1.1 " - cReturnCode := DecodeStatusCode() + cRet := "HTTP/1.1 " + cReturnCode := DecodeStatusCode() - SWITCH t_nStatusCode - CASE 200 - EXIT + SWITCH t_nStatusCode + CASE 200 + EXIT - CASE 301 - CASE 400 - CASE 401 - CASE 402 - CASE 403 - CASE 404 - CASE 503 - t_cResult := "

" + cReturnCode + "

" - EXIT + CASE 301 + CASE 400 + CASE 401 + CASE 402 + CASE 403 + CASE 404 + CASE 503 + t_cResult := "

" + cReturnCode + "

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

500 Server Too Busy

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

500 Server Too Busy

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

" + cReturnCode + "

" - ENDSWITCH + OTHERWISE + cReturnCode := "403 Forbidden" + t_cResult := "

" + cReturnCode + "

" + ENDSWITCH - WriteToConsole( cReturnCode ) - cRet += cReturnCode + CR_LF - AEVAL( t_aHeader, {|x| cRet += x[1] + ": " + x[2] + CR_LF } ) - cRet += CR_LF - cRet += t_cResult -RETURN cRet + WriteToConsole( cReturnCode ) + cRet += cReturnCode + CR_LF + AEVAL( t_aHeader, {|x| cRet += x[1] + ": " + x[2] + CR_LF } ) + cRet += CR_LF + cRet += t_cResult + RETURN cRet STATIC FUNCTION DecodeStatusCode() -LOCAL cReturnCode + LOCAL cReturnCode - SWITCH t_nStatusCode - CASE 200 - cReturnCode := "200 OK" - EXIT - CASE 301 - cReturnCode := "301 Moved Permanently" - EXIT - CASE 400 - cReturnCode := "400 Bad Request" - EXIT - CASE 401 - cReturnCode := "401 Unauthorized" - EXIT - CASE 402 - cReturnCode := "402 Payment Required" - EXIT - CASE 403 - cReturnCode := "403 Forbidden" - EXIT - CASE 404 - cReturnCode := "404 Not Found" - EXIT - CASE 503 - cReturnCode := "503 Service Unavailable" - EXIT + SWITCH t_nStatusCode + CASE 200 + cReturnCode := "200 OK" + EXIT + CASE 301 + cReturnCode := "301 Moved Permanently" + EXIT + CASE 400 + cReturnCode := "400 Bad Request" + EXIT + CASE 401 + cReturnCode := "401 Unauthorized" + EXIT + CASE 402 + cReturnCode := "402 Payment Required" + EXIT + CASE 403 + cReturnCode := "403 Forbidden" + EXIT + CASE 404 + cReturnCode := "404 Not Found" + EXIT + CASE 503 + cReturnCode := "503 Service Unavailable" + EXIT - // extended error messages - from Microsoft IIS Server - CASE 500013 // error: 500-13 Server too busy - cReturnCode := "500-13 Server Too Busy" - EXIT + // extended error messages - from Microsoft IIS Server + CASE 500013 // error: 500-13 Server too busy + cReturnCode := "500-13 Server Too Busy" + EXIT - CASE 500100 // error: 500-100 Undeclared Variable + CASE 500100 // error: 500-100 Undeclared Variable - OTHERWISE - cReturnCode := "403 Forbidden" - ENDSWITCH + OTHERWISE + cReturnCode := "403 Forbidden" + ENDSWITCH -RETURN cReturnCode + RETURN cReturnCode STATIC PROCEDURE WriteToLog( cRequest ) LOCAL cTime, cDate @@ -1281,15 +1171,15 @@ STATIC PROCEDURE WriteToLog( cRequest ) dDate := Date() cDate := DTOS( dDate ) nSize := LEN( t_cResult ) - cReferer := _SERVER["HTTP_REFERER"] + cReferer := _SERVER[ "HTTP_REFERER" ] cBias := WIN_TIMEZONEBIAS() - cAccess := _SERVER["REMOTE_ADDR"] + " - - [" + RIGHT( cDate, 2 ) + "/" + ; + cAccess := _SERVER[ "REMOTE_ADDR" ] + " - - [" + RIGHT( cDate, 2 ) + "/" + ; aMonths[ VAL( SUBSTR( cDate, 5, 2 ) ) ] + ; "/" + LEFT( cDate, 4 ) + ":" + cTime + ' ' + cBias + '] "' + ; LEFT( cRequest, AT( CR_LF, cRequest ) - 1 ) + '" ' + ; LTRIM( STR( t_nStatusCode ) ) + " " + IIF( nSize == 0, "-", LTRIM( STR( nSize ) ) ) + ; - ' "' + IIF( Empty( cReferer ), "-", cReferer ) + '" "' + _SERVER["HTTP_USER_AGENT"] + ; + ' "' + IIF( Empty( cReferer ), "-", cReferer ) + '" "' + _SERVER[ "HTTP_USER_AGENT" ] + ; '"' + HB_OSNewLine() //hb_ToOutDebug( "AccessLog = %s \n\r", cAccess ) @@ -1305,7 +1195,7 @@ STATIC PROCEDURE WriteToLog( cRequest ) cErrorMsg := t_cErrorMsg cError := "[" + Left( aDays[ nDoW ], 3 ) + " " + aMonths[ nMonth ] + " " + StrZero( nDay, 2 ) + " " + ; - PadL( LTrim( cTime ), 8, "0" ) + " " + StrZero( nYear, 4 ) + "] [error] [client " + _SERVER["REMOTE_ADDR"] + "] " + ; + PadL( LTrim( cTime ), 8, "0" ) + " " + StrZero( nYear, 4 ) + "] [error] [client " + _SERVER[ "REMOTE_ADDR" ] + "] " + ; cErrorMsg + HB_OSNewLine() //hb_ToOutDebug( "ErrorLog = %s \n\r", cError ) @@ -1316,7 +1206,7 @@ STATIC PROCEDURE WriteToLog( cRequest ) hb_mutexUnlock( s_hmtxLog ) ENDIF -RETURN + RETURN STATIC FUNCTION CGIExec( cProc, /*@*/ cOutPut ) LOCAL hOut @@ -1411,13 +1301,13 @@ STATIC PROCEDURE CGIKill() INIT PROCEDURE SocketInit() #ifdef USE_HB_INET - hb_InetInit() + hb_InetInit() #else - IF socket_init() != 0 - ? "socket_init() error" - ENDIF + IF socket_init() != 0 + ? "socket_init() error" + ENDIF #endif -RETURN + RETURN EXIT PROCEDURE Socketxit() @@ -1426,242 +1316,365 @@ EXIT PROCEDURE Socketxit() #else socket_exit() #endif -RETURN + RETURN /******************************************************************** Public helper functions ********************************************************************/ -STATIC FUNCTION split( cSeparator, cString, nMax ) - LOCAL aRet := {}, nI - LOCAL nIter := 0 - DEFAULT nMax TO 0 +FUNCTION uhttpd_OSFileName( cFileName ) + IF HB_OSPathSeparator() != "/" + RETURN STRTRAN( cFileName, "/", HB_OSPathSeparator() ) + ENDIF + RETURN cFileName - DO WHILE ( nI := AT( cSeparator, cString ) ) > 0 - AADD( aRet, LEFT( cString, nI - 1 ) ) - cString := SUBSTR( cString, nI + LEN( cSeparator ) ) - IF nMax > 0 .AND. ++nIter >= nMax - EXIT - ENDIF - ENDDO - AADD( aRet, cString ) -RETURN aRet +PROCEDURE uhttpd_SetStatusCode(nStatusCode) + t_nStatusCode := nStatusCode + RETURN -STATIC FUNCTION join( cSeparator, aData ) -LOCAL cRet := "", nI - FOR nI := 1 TO LEN( aData ) - IF nI > 1; cRet += cSeparator +PROCEDURE uhttpd_AddHeader( cType, cValue, lReplace ) + LOCAL nI + DEFAULT lReplace TO TRUE // Needed from SetCookie() + + IF lReplace .AND. ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 + t_aHeader[ nI, 2 ] := cValue + ELSE + AADD( t_aHeader, { cType, cValue } ) + ENDIF + RETURN + +FUNCTION uhttpd_GetHeader( cType, /*@*/ nPos ) + DEFAULT nPos TO 1 + IF ( nPos := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) }, nPos ) ) > 0 + RETURN t_aHeader[ nPos, 2 ] + ENDIF + RETURN NIL + +PROCEDURE uhttpd_DelHeader( cType ) + LOCAL nI + + IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 + hb_aDel( t_aHeader, nI, TRUE ) + ENDIF + RETURN + +PROCEDURE uhttpd_Write( cString ) + t_cResult += cString + RETURN + +/******************************************************************** + Internal helper functions +********************************************************************/ + +STATIC FUNCTION readRequest( hSocket, /* @ */ cRequest ) + LOCAL nLen, cBuf +#ifdef USE_HB_INET + LOCAL nRcvLen, nContLen +#endif + + /* receive query */ +#ifdef USE_HB_INET + cRequest := "" + nLen := 0 + nRcvLen := 1 + nContLen := 0 + DO WHILE /* AT( CR_LF + CR_LF, cRequest ) == 0 .AND. */ nRcvLen > 0 + cBuf := hb_InetRecvLine( hSocket, @nRcvLen ) + //hb_ToOutDebug( " nRcvLen = %i, cBuf = %s \n\r", nRcvLen, cBuf ) + cRequest += cBuf + CR_LF + nLen += nRcvLen + IF nRcvLen > 0 .AND. At( "CONTENT-LENGTH:", Upper( cBuf ) ) == 1 + cBuf := Substr( cBuf, At( ":", cBuf ) + 1 ) + nContLen := Val( cBuf ) ENDIF - IF VALTYPE(aData[nI]) $ "CM"; cRet += aData[nI] - ELSEIF VALTYPE(aData[nI]) == "N"; cRet += LTRIM(STR(aData[nI])) - ELSEIF VALTYPE(aData[nI]) == "D"; cRet += IF(!EMPTY(aData[nI]), DTOC(aData[nI]), "") + ENDDO + + //hb_ToOutDebug( " nLen = %i, nContLen = %i \n\r", nLen, nContLen ) + // if the request has a content-lenght, we must read it + IF nLen > 0 .AND. nContLen > 0 + // cPostData is autoAllocated + cBuf := Space( nContLen ) + IF InetRecvAll( hSocket, @cBuf, nContLen ) <= 0 + nLen := -1 // force error check ELSE + cRequest += cBuf ENDIF - NEXT -RETURN cRet + ENDIF +#else + cRequest := "" + nLen := 1 + DO WHILE AT( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 + nLen := socket_recv( hSocket, @cBuf ) + cRequest += cBuf + ENDDO +#endif + //hb_ToOutDebug( " nLen = %i, cRequese = %s \n\r", nLen, cRequest ) -FUNCTION uOSFileName( cFileName ) - IF HB_OSPathSeparator() != "/" - RETURN STRTRAN( cFileName, "/", HB_OSPathSeparator() ) - ENDIF -RETURN cFileName + RETURN nLen -PROCEDURE uSetStatusCode(nStatusCode) - t_nStatusCode := nStatusCode -RETURN +STATIC FUNCTION sendReply( hSocket, cSend ) + LOCAL nError := 0 + LOCAL nLen +#ifdef USE_HB_INET + DO WHILE LEN( cSend ) > 0 + IF ( nLen := hb_InetSendAll( hSocket, cSend ) ) == -1 + ? "send() error:", hb_InetErrorCode( hSocket ), HB_InetErrorDesc( hSocket ) + WriteToConsole( hb_sprintf( "ProcessConnection() - send() error: %s, cSend = %s, hSocket = %s", hb_InetErrorDesc( hSocket ), cSend, hSocket ) ) + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR( cSend, nLen + 1 ) + ENDIF + ENDDO +#else + DO WHILE LEN( cSend ) > 0 + IF ( nLen := socket_send( hSocket, cSend ) ) == -1 + ? "send() error:", socket_error() + WriteToConsole( hb_sprintf( "ServiceConnection() - send() error: %s, cSend = %s, hSocket = %s", socket_error(), cSend, hSocket ) ) + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR( cSend, nLen + 1 ) + ENDIF + ENDDO +#endif -PROCEDURE uAddHeader( cType, cValue ) -LOCAL nI + RETURN nError - IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 - t_aHeader[ nI, 2 ] := cValue - ELSE - AADD( t_aHeader, { cType, cValue } ) - ENDIF -RETURN +STATIC PROCEDURE defineServerAdresses( hSocket ) +#ifndef USE_HB_INET + LOCAL aI +#endif +#ifdef USE_HB_INET + _SERVER[ "REMOTE_ADDR" ] := hb_InetAddress( hSocket ) + _SERVER[ "REMOTE_HOST" ] := _SERVER[ "REMOTE_ADDR" ] // no reverse DNS + _SERVER[ "REMOTE_PORT" ] := hb_InetPort( hSocket ) + _SERVER[ "SERVER_ADDR" ] := s_cLocalAddress + _SERVER[ "SERVER_PORT" ] := LTrim( Str( s_nLocalPort ) ) +#else + IF socket_getpeername( hSocket, @aI ) != -1 + _SERVER[ "REMOTE_ADDR" ] := aI[2] + _SERVER[ "REMOTE_HOST" ] := _SERVER[ "REMOTE_ADDR" ] // no reverse DNS + _SERVER[ "REMOTE_PORT" ] := aI[3] + ENDIF -FUNCTION uGetHeader( cType ) -LOCAL nI + IF socket_getsockname( hSocket, @aI ) != -1 + _SERVER[ "SERVER_ADDR" ] := aI[2] + _SERVER[ "SERVER_PORT" ] := LTrim( Str( aI[3] ) ) + ENDIF +#endif - IF ( nI := ASCAN( t_aHeader, {|x| UPPER( x[ 1 ] ) == UPPER( cType ) } ) ) > 0 - RETURN t_aHeader[ nI, 2 ] - ENDIF -RETURN NIL + RETURN +FUNCTION uhttpd_split( cSeparator, cString, nMax ) + LOCAL aRet := {}, nI + LOCAL nIter := 0 -PROCEDURE uWrite( cString ) - t_cResult += cString -RETURN + DEFAULT nMax TO 0 -#define XP_SUCCESS 0 + DO WHILE ( nI := AT( cSeparator, cString ) ) > 0 + AADD( aRet, LEFT( cString, nI - 1 ) ) + cString := SUBSTR( cString, nI + LEN( cSeparator ) ) + IF nMax > 0 .AND. ++nIter >= nMax + EXIT + ENDIF + ENDDO + AADD( aRet, cString ) + RETURN aRet + +FUNCTION uhttpd_join( cSeparator, aData ) + LOCAL cRet := "", nI + + FOR nI := 1 TO LEN( aData ) + IF nI > 1; cRet += cSeparator + ENDIF + IF VALTYPE(aData[nI]) $ "CM"; cRet += aData[nI] + ELSEIF VALTYPE(aData[nI]) == "N"; cRet += LTRIM(STR(aData[nI])) + ELSEIF VALTYPE(aData[nI]) == "D"; cRet += IF(!EMPTY(aData[nI]), DTOC(aData[nI]), "") + ELSE + ENDIF + NEXT + RETURN cRet STATIC FUNCTION uproc_default() -LOCAL cFileName, nI, cI -LOCAL cExt, xResult, pHRB, oError + LOCAL cFileName, nI, cI + LOCAL cExt, xResult, pHRB, oError, cHRBBody - //cFileName := STRTRAN(cRoot + _SERVER["SCRIPT_NAME"], "//", "/") - cFileName := _SERVER[ "SCRIPT_FILENAME" ] + //cFileName := STRTRAN(cRoot + _SERVER["SCRIPT_NAME"], "//", "/") + cFileName := _SERVER[ "SCRIPT_FILENAME" ] - //hb_ToOutDebug( "cFileName = %s, uOSFileName( cFileName ) = %s,\n\r _SERVER = %s\n\r", cFileName, uOSFileName( cFileName ), hb_ValToExp( _SERVER ) ) + //hb_ToOutDebug( "cFileName = %s, uhttpd_OSFileName( cFileName ) = %s,\n\r _SERVER = %s\n\r", cFileName, uhttpd_OSFileName( cFileName ), hb_ValToExp( _SERVER ) ) - // Security - IF ".." $ cFileName - uSetStatusCode( 403 ) - t_cErrorMsg := "Characters not allowed" - RETURN MakeResponse() - ENDIF + IF HB_HHasKey( s_hScriptAliases, _SERVER[ "SCRIPT_NAME" ] ) + cFileName := _SERVER[ "DOCUMENT_ROOT" ] + hb_hGet( s_hScriptAliases, _SERVER[ "SCRIPT_NAME" ] ) + ENDIF - IF HB_HHasKey( s_hFileAliases, _SERVER[ "SCRIPT_NAME" ] ) - cFileName := _SERVER[ "DOCUMENT_ROOT" ] + hb_hGet( s_hFileAliases, _SERVER[ "SCRIPT_NAME" ] ) - ENDIF + // Security + IF ".." $ cFileName + uhttpd_SetStatusCode( 403 ) + t_cErrorMsg := "Characters not allowed" + RETURN MakeResponse() + ENDIF - //hb_toOutDebug( "cFileName = %s, uOSFileName( cFileName ) = %s,\n\r s_hFileAliases = %s\n\r", cFileName, uOSFileName( cFileName ), hb_ValToExp( s_hFileAliases ) ) + //hb_toOutDebug( "cFileName = %s, uhttpd_OSFileName( cFileName ) = %s,\n\r s_hScriptAliases = %s\n\r", cFileName, uhttpd_OSFileName( cFileName ), hb_ValToExp( s_hScriptAliases ) ) - IF Upper( _SERVER[ "SCRIPT_NAME" ] ) == "/SERVERSTATUS" - ShowServerStatus() - ELSEIF HB_FileExists( uOSFileName( cFileName ) ) - IF ( nI := RAT( ".", cFileName ) ) > 0 - SWITCH ( cExt := LOWER( SUBSTR( cFileName, nI + 1 ) ) ) - CASE "hrb" ; cI := "text/html"; EXIT - CASE "exe" ; cI := "text/html"; EXIT + IF Upper( _SERVER[ "SCRIPT_NAME" ] ) == "/SERVERSTATUS" + ShowServerStatus() + ELSEIF HB_FileExists( uhttpd_OSFileName( cFileName ) ) + IF ( nI := RAT( ".", cFileName ) ) > 0 + SWITCH ( cExt := LOWER( SUBSTR( cFileName, nI + 1 ) ) ) + CASE "hrb" ; cI := "text/html"; EXIT + CASE "exe" ; cI := "text/html"; EXIT - CASE "css" ; cI := "text/css"; EXIT - CASE "htm" ; CASE "html"; cI := "text/html"; EXIT - CASE "txt" ; CASE "text"; CASE "asc" - CASE "c" ; CASE "h"; CASE "cpp" - CASE "hpp" ; CASE "log"; cI := "text/plain"; EXIT - CASE "rtf" ; cI := "text/rtf"; EXIT - CASE "xml" ; cI := "text/xml"; EXIT - CASE "xsl" ; cI := "text/xsl"; EXIT - CASE "bmp" ; cI := "image/bmp"; EXIT - CASE "gif" ; cI := "image/gif"; EXIT - CASE "jpg" ; CASE "jpe"; CASE "jpeg"; cI := "image/jpeg"; EXIT - CASE "png" ; cI := "image/png"; EXIT - CASE "tif" ; CASE "tiff"; cI := "image/tiff"; EXIT - CASE "djv" ; CASE "djvu"; cI := "image/vnd.djvu"; EXIT - CASE "ico" ; cI := "image/x-icon"; EXIT - CASE "xls" ; cI := "application/excel"; EXIT - CASE "doc" ; cI := "application/msword"; EXIT - CASE "pdf" ; cI := "application/pdf"; EXIT - CASE "ps" ; CASE "eps"; cI := "application/postscript"; EXIT - CASE "ppt" ; cI := "application/powerpoint"; EXIT - CASE "bz2" ; cI := "application/x-bzip2"; EXIT - CASE "gz" ; cI := "application/x-gzip"; EXIT - CASE "tgz" ; cI := "application/x-gtar"; EXIT - CASE "js" ; cI := "application/x-javascript"; EXIT - CASE "tar" ; cI := "application/x-tar"; EXIT - CASE "tex" ; cI := "application/x-tex"; EXIT - CASE "zip" ; cI := "application/zip"; EXIT - CASE "midi"; cI := "audio/midi"; EXIT - CASE "mp3" ; cI := "audio/mpeg"; EXIT - CASE "wav" ; cI := "audio/x-wav"; EXIT - CASE "qt" ; CASE "mov"; cI := "video/quicktime"; EXIT - CASE "avi" ; cI := "video/x-msvideo"; EXIT - OTHERWISE - cI := "application/octet-stream" - ENDSWITCH + CASE "css" ; cI := "text/css"; EXIT + CASE "htm" ; CASE "html"; cI := "text/html"; EXIT + CASE "txt" ; CASE "text"; CASE "asc" + CASE "c" ; CASE "h"; CASE "cpp" + CASE "hpp" ; CASE "log"; cI := "text/plain"; EXIT + CASE "rtf" ; cI := "text/rtf"; EXIT + CASE "xml" ; cI := "text/xml"; EXIT + CASE "xsl" ; cI := "text/xsl"; EXIT + CASE "bmp" ; cI := "image/bmp"; EXIT + CASE "gif" ; cI := "image/gif"; EXIT + CASE "jpg" ; CASE "jpe"; CASE "jpeg"; cI := "image/jpeg"; EXIT + CASE "png" ; cI := "image/png"; EXIT + CASE "tif" ; CASE "tiff"; cI := "image/tiff"; EXIT + CASE "djv" ; CASE "djvu"; cI := "image/vnd.djvu"; EXIT + CASE "ico" ; cI := "image/x-icon"; EXIT + CASE "xls" ; cI := "application/excel"; EXIT + CASE "doc" ; cI := "application/msword"; EXIT + CASE "pdf" ; cI := "application/pdf"; EXIT + CASE "ps" ; CASE "eps"; cI := "application/postscript"; EXIT + CASE "ppt" ; cI := "application/powerpoint"; EXIT + CASE "bz2" ; cI := "application/x-bzip2"; EXIT + CASE "gz" ; cI := "application/x-gzip"; EXIT + CASE "tgz" ; cI := "application/x-gtar"; EXIT + CASE "js" ; cI := "application/x-javascript"; EXIT + CASE "tar" ; cI := "application/x-tar"; EXIT + CASE "tex" ; cI := "application/x-tex"; EXIT + CASE "zip" ; cI := "application/zip"; EXIT + CASE "midi"; cI := "audio/midi"; EXIT + CASE "mp3" ; cI := "audio/mpeg"; EXIT + CASE "wav" ; cI := "audio/x-wav"; EXIT + CASE "qt" ; CASE "mov"; cI := "video/quicktime"; EXIT + CASE "avi" ; cI := "video/x-msvideo"; EXIT + OTHERWISE + cI := "application/octet-stream" + ENDSWITCH - IF cExt == "hrb" + IF cExt == "hrb" - // Starting HRB module + // Starting HRB module - TRY - IF hb_mutexLock( s_hmtxHRB ) - IF !EMPTY( pHRB := __HRBLOAD( uOSFileName(cFileName) ) ) + TRY + // Lock HRB to avoid MT race conditions + IF !HRB_ACTIVATE_CACHE + cHRBBody := HRB_LoadFromFile( uhttpd_OSFileName( cFileName ) ) + ENDIF + IF hb_mutexLock( s_hmtxHRB ) + IF HRB_ACTIVATE_CACHE + // caching modules + IF !hb_HHasKey( s_hHRBModules, cFileName ) + hb_HSet( s_hHRBModules, cFileName, HRB_LoadFromFile( uhttpd_OSFileName( cFileName ) ) ) + ENDIF + cHRBBody := s_hHRBModules[ cFileName ] + ENDIF + IF !EMPTY( pHRB := HB_HRBLOAD( cHRBBody ) ) - xResult := HRBMAIN() + xResult := HRBMAIN() - __HRBUNLOAD( pHRB ) + HB_HRBUNLOAD( pHRB ) + ELSE + uhttpd_SetStatusCode( 404 ) + t_cErrorMsg := "File does not exist: " + cFileName + ENDIF + hb_mutexUnlock( s_hmtxHRB ) - ENDIF - hb_mutexUnlock( s_hmtxHRB ) - ENDIF + ENDIF - IF HB_ISSTRING( xResult ) - uAddHeader( "Content-Type", cI ) - uWrite( xResult ) - ELSE - // Application in HRB module is responsible to send HTML content - ENDIF + IF HB_ISSTRING( xResult ) + uhttpd_AddHeader( "Content-Type", cI ) + uhttpd_Write( xResult ) + ELSE + // Application in HRB module is responsible to send HTML content + ENDIF - CATCH oError + CATCH oError - WriteToConsole( "Error!" ) + WriteToConsole( "Error!" ) - uAddHeader( "Content-Type", "text/html" ) - uWrite( "Error" ) - uWrite( "
Description: " + hb_cStr( oError:Description ) ) - uWrite( "
Filename: " + hb_cStr( oError:filename ) ) - uWrite( "
Operation: " + hb_cStr( oError:operation ) ) - uWrite( "
OsCode: " + hb_cStr( oError:osCode ) ) - uWrite( "
GenCode: " + hb_cStr( oError:genCode ) ) - uWrite( "
SubCode: " + hb_cStr( oError:subCode ) ) - uWrite( "
SubSystem: " + hb_cStr( oError:subSystem ) ) - uWrite( "
Args: " + hb_cStr( hb_ValToExp( oError:args ) ) ) - uWrite( "
ProcName: " + hb_cStr( procname( 0 ) ) ) - uWrite( "
ProcLine: " + hb_cStr( procline( 0 ) ) ) - END + uhttpd_AddHeader( "Content-Type", "text/html" ) + uhttpd_Write( "Error" ) + uhttpd_Write( "
Description: " + hb_cStr( oError:Description ) ) + uhttpd_Write( "
Filename: " + hb_cStr( oError:filename ) ) + uhttpd_Write( "
Operation: " + hb_cStr( oError:operation ) ) + uhttpd_Write( "
OsCode: " + hb_cStr( oError:osCode ) ) + uhttpd_Write( "
GenCode: " + hb_cStr( oError:genCode ) ) + uhttpd_Write( "
SubCode: " + hb_cStr( oError:subCode ) ) + uhttpd_Write( "
SubSystem: " + hb_cStr( oError:subSystem ) ) + uhttpd_Write( "
Args: " + hb_cStr( hb_ValToExp( oError:args ) ) ) + uhttpd_Write( "
ProcName: " + hb_cStr( procname( 0 ) ) ) + uhttpd_Write( "
ProcLine: " + hb_cStr( procline( 0 ) ) ) + END - ELSEIF cExt == "exe" + ELSEIF cExt == "exe" - // Starting CGI application + // Starting CGI application - IF ( CGIExec( uOSFileName(cFileName), @xResult ) ) == 0 + IF ( CGIExec( uhttpd_OSFileName(cFileName), @xResult ) ) == 0 - //uAddHeader( "Content-Type", cI ) - //uWrite( xResult ) - RETURN "HTTP/1.1 200 OK " + CR_LF + xResult + //uhttpd_AddHeader( "Content-Type", cI ) + //uhttpd_Write( xResult ) + RETURN "HTTP/1.1 200 OK " + CR_LF + xResult - ELSE + ELSE - uAddHeader( "Content-Type", cI ) - uWrite( "CGI Error" ) + uhttpd_AddHeader( "Content-Type", cI ) + uhttpd_Write( "CGI Error" ) - ENDIF + ENDIF - ELSE - uAddHeader( "Content-Type", cI ) - uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) - ENDIF + ELSE + uhttpd_AddHeader( "Content-Type", cI ) + uhttpd_Write( HB_MEMOREAD( uhttpd_OSFileName( cFileName ) ) ) + ENDIF - ELSE - cI := "application/octet-stream" - uAddHeader( "Content-Type", cI ) - uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) - ENDIF + ELSE + cI := "application/octet-stream" + uhttpd_AddHeader( "Content-Type", cI ) + uhttpd_Write( HB_MEMOREAD( uhttpd_OSFileName( cFileName ) ) ) + ENDIF - ELSEIF HB_DirExists( uOSFileName( cFileName ) ) - IF RIGHT( cFileName, 1 ) != "/" - uAddHeader( "Location", "http://" + _SERVER[ "HTTP_HOST" ] + _SERVER[ "SCRIPT_NAME" ] + "/" ) - RETURN MakeResponse() - ENDIF - IF ASCAN( { "index.html", "index.htm" }, ; - {|x| IIF( HB_FileExists( uOSFileName( cFileName + X ) ), ( cFileName += X, .T. ), .F. ) } ) > 0 - uAddHeader( "Content-Type", "text/html" ) - uWrite( HB_MEMOREAD( uOSFileName( cFileName ) ) ) - RETURN MakeResponse() - ENDIF + ELSEIF HB_DirExists( uhttpd_OSFileName( cFileName ) ) + IF RIGHT( cFileName, 1 ) != "/" + uhttpd_AddHeader( "Location", "http://" + _SERVER[ "HTTP_HOST" ] + _SERVER[ "SCRIPT_NAME" ] + "/" ) + RETURN MakeResponse() + ENDIF + IF ASCAN( { "index.html", "index.htm" }, ; + {|x| IIF( HB_FileExists( uhttpd_OSFileName( cFileName + X ) ), ( cFileName += X, .T. ), .F. ) } ) > 0 + uhttpd_AddHeader( "Content-Type", "text/html" ) + uhttpd_Write( HB_MEMOREAD( uhttpd_OSFileName( cFileName ) ) ) + RETURN MakeResponse() + ENDIF - // If I'm here it's means that I have no page, so, if it is defined, I will display content folder - IF !s_lIndexes - uSetStatusCode( 403 ) - t_cErrorMsg := "Display file list not allowed" - RETURN MakeResponse() - ENDIF + // If I'm here it's means that I have no page, so, if it is defined, I will display content folder + IF !s_lIndexes + uhttpd_SetStatusCode( 403 ) + t_cErrorMsg := "Display file list not allowed" + RETURN MakeResponse() + ENDIF - // ----------------------- display folder content ------------------------------------- - ShowFolder( cFileName ) + // ----------------------- display folder content ------------------------------------- + ShowFolder( cFileName ) - ELSE - uSetStatusCode( 404 ) - t_cErrorMsg := "File does not exist: " + cFileName - ENDIF -RETURN MakeResponse() + ELSE + uhttpd_SetStatusCode( 404 ) + t_cErrorMsg := "File does not exist: " + cFileName + ENDIF + RETURN MakeResponse() // Define environment SET variables - TODO: Actually only for windows, make multiplatform STATIC PROCEDURE Define_Env( hmServer ) @@ -1671,48 +1684,48 @@ STATIC PROCEDURE Define_Env( hmServer ) WIN_SETENV( v:__enumKey(), v:__enumValue() ) NEXT -RETURN + RETURN // ------------------------------- DEFAULT PAGES ----------------------------------- STATIC PROCEDURE ShowServerStatus() - uAddHeader( "Content-Type", "text/html" ) - uWrite( '' ) - uWrite( '' ) - uWrite( 'Server Status

Server Status

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

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

      ')
-   uWrite( 'Name                                                  ')
-   uWrite( 'Modified             ' )
-   uWrite( 'Size' + CR_LF + '
' )
+   uhttpd_Write( '
Index of ' + _SERVER[ "SCRIPT_NAME" ] + '
      ')
+   uhttpd_Write( 'Name                                                  ')
+   uhttpd_Write( 'Modified             ' )
+   uhttpd_Write( 'Size' + CR_LF + '
' )
 
    // Adding Upper Directory
    nPos := RAT( "/", SUBSTR( cDir, 1, Len( cDir ) - 1 ) )
@@ -1748,23 +1761,46 @@ STATIC PROCEDURE ShowFolder( cDir )
 
    FOR EACH aF IN aDir
        IF aF[ 1 ] == ""
-          uWrite( '[DIR] ..' + ;
+          uhttpd_Write( '[DIR] ..' + ;
                   CR_LF )
        ELSEIF LEFT( aF[ 1 ], 1 ) == "."
        ELSEIF "D" $ aF[ 5 ]
-          uWrite( '[DIR] '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
+          uhttpd_Write( '[DIR] '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
                   DTOC( aF[ 3 ] ) + ' ' + aF[ 4 ] + CR_LF )
        ELSE
-          uWrite( '      '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
+          uhttpd_Write( '      '+ aF[ 1 ] + '' + SPACE( 50 - LEN( aF[ 1 ] ) ) + ;
                   DTOC( aF[ 3 ]) + ' ' + aF[ 4 ] + STR( aF[ 2 ], 12 ) + CR_LF )
        ENDIF
    NEXT
-   uWrite( "
" )
+   uhttpd_Write( "
" ) -RETURN + RETURN // ------------------------------- Utility functions -------------------------------- +// from Przemek's example, useful to use encrypted HRB module files +STATIC FUNCTION HRB_LoadFromFileEncrypted( cFile, cKey ) + LOCAL cHrbBody + cHrbBody := hb_memoread( cFile ) + cHrbBody := sx_decrypt( cHrbBody, cKey ) + cHrbBody := hb_zuncompress( cHrbBody ) + RETURN cHrbBody + +/* +// Reverse function to save is: +PROCEDURE HRB_SaveToFileEncrypted( cHrbBody, cKey, cEncFileName ) + LOCAL cFile + IF !Empty( cHrbBody ) + cHrbBody := hb_zcompress( cHrbBody ) + cHrbBody := sx_encrypt( cHrbBody, cKey ) + hb_memowrit( cEncFileName, cHrbBody ) + ENDIF + RETURN +*/ + +STATIC FUNCTION HRB_LoadFromFile( cFile ) + RETURN hb_memoread( cFile ) + STATIC PROCEDURE Help() //LOCAL cPrg := hb_argv( 0 ) //LOCAL nPos := RAt( "\", cPrg ) @@ -1791,7 +1827,7 @@ STATIC PROCEDURE Help() ? "-h | -? | --help This help message" ? WAIT -RETURN + RETURN STATIC PROCEDURE SysSettings() SET SCOREBOARD OFF @@ -1805,7 +1841,7 @@ STATIC PROCEDURE SysSettings() SET WRAP ON SET EPOCH TO 2000 //RDDSetDefault( "DBFCDX" ) -RETURN + RETURN STATIC FUNCTION Exe_Path() LOCAL cPath := hb_argv( 0 ) @@ -1815,7 +1851,7 @@ STATIC FUNCTION Exe_Path() ELSE cPath := SubStr( cPath, 1, nPos-1 ) ENDIF -RETURN cPath + RETURN cPath STATIC FUNCTION Exe_Name() LOCAL cPrg := hb_argv( 0 ) @@ -1823,9 +1859,9 @@ STATIC FUNCTION Exe_Name() IF nPos > 0 cPrg := SubStr( cPrg, nPos+1 ) ENDIF -RETURN cPrg + RETURN cPrg -STATIC PROCEDURE Progress( nProgress ) +STATIC PROCEDURE Progress( /*@*/ nProgress ) LOCAL cString := "[" DO CASE @@ -1851,7 +1887,7 @@ STATIC PROCEDURE Progress( nProgress ) hb_dispOutAt( 10, 5, cString ) hb_dispOutAt( 0, 60, "Time: " + Time() ) -RETURN + RETURN // Show messages in console #define CONSOLE_FIRSTROW 12 @@ -1877,7 +1913,7 @@ STATIC PROCEDURE WriteToConsole( ... ) hb_mutexUnlock( s_hmtxConsole ) ENDIF -RETURN + RETURN STATIC FUNCTION ParseIni( cConfig ) LOCAL hIni := HB_ReadIni( cConfig ) @@ -1913,11 +1949,13 @@ STATIC FUNCTION ParseIni( cConfig ) IF HB_IsHash( hSect ) FOR EACH cKey IN hSect:Keys + IF cSection == "ALIASES" xVal := hSect[ cKey ] IF xVal <> NIL hDefault[ cSection ][ cKey ] := xVal ENDIF + ELSEIF cKey $ hDefault[ cSection ] cVal := hSect[ cKey ] @@ -1952,6 +1990,7 @@ STATIC FUNCTION ParseIni( cConfig ) IF xVal <> NIL hDefault[ cSection ][ cKey ] := xVal ENDIF + ENDIF NEXT ENDIF @@ -1961,7 +2000,7 @@ STATIC FUNCTION ParseIni( cConfig ) RETURN hDefault -STATIC FUNCTION httpd_DefError( oError ) +STATIC FUNCTION uhttpd_DefError( oError ) LOCAL cMessage LOCAL cCallstack LOCAL cDOSError @@ -2099,3 +2138,4 @@ STATIC FUNCTION ErrorMessage( oError ) ENDCASE RETURN cMessage +