diff --git a/harbour/ChangeLog b/harbour/ChangeLog
index e97ee59c6a..14e3ac0899 100644
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -16,18 +16,41 @@
The license applies to all entries newer than 2009-04-28.
*/
+2012-01-27 20:52 UTC+0100 Viktor Szakats (harbour syenar.net)
+ * contrib/hbplist
+ * contrib/hbhttpd/core.prg
+ * contrib/hbhttpd/hbhttpd.hbp
+ * contrib/hbhttpd/hbhttpd.hbc
+ + contrib/hbhttpd/hbhttpds.hbp
+ + contrib/hbhttpd/hbhttpds.hbc
+ * contrib/hbhttpd/widgets.prg
+ * contrib/hbhttpd/hbhttpd.hbx
+ - contrib/hbhttpd/tests/webapp.prg
+ + contrib/hbhttpd/tests/eshop.prg
+ * contrib/hbhttpd/tests/files/main.js
+ + contrib/hbhttpd/tests/tpl
+ + merged latest uhttpd changes (0.4) posted by Mindaugas on his
+ website into hbhttpd. It implements these changes (quote):
+ * strict scope for UHttpd class methods and variables
+ * support for more HTTP status codes
+ * added error handler for child processes
+ ! fixed bug in HttpDateUnformat()
+ * new server parameters setting approach implemented
+ * more friendly UProcInfo() output format
+ + client IP filtering
+
2012-01-27 18:25 UTC+0200 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt)
* src/vm/hashes.c
* src/vm/hashfunc.c
+ implemented posibility to use hashes a sorted arays with binary search.
- Implemented HB_BOOL hb_hashScanSoft( pHash, pKey, &nPos ). Function
+ Implemented HB_BOOL hb_hashScanSoft( pHash, pKey, &nPos ). Function
if similar to, but returns nPos even if pKey is not found in pHash.
Extended HB_HHASKEY( aHash, xKey [, @nPos ] ) --> lFound
- Function optionaly returns position of the item with a largest key
- smaller or equal to xKey. If xKey is less than all keys in hash,
- zero position is returned. I.e.,
+ Function optionaly returns position of the item with a largest key
+ smaller or equal to xKey. If xKey is less than all keys in hash,
+ zero position is returned. I.e.,
aHash := {10=>, 20=>}
? HB_HHASKEY( aHash, 5, @nPos ), nPos // .F. 0
? HB_HHASKEY( aHash, 10, @nPos ), nPos // .T. 1
diff --git a/harbour/contrib/hbhttpd/core.prg b/harbour/contrib/hbhttpd/core.prg
index da86831df1..04620c3c42 100644
--- a/harbour/contrib/hbhttpd/core.prg
+++ b/harbour/contrib/hbhttpd/core.prg
@@ -4,11 +4,22 @@
#include "hbclass.ch"
#include "error.ch"
-
#include "hbsocket.ch"
+#include "hbthread.ch"
+
+#ifdef HB_HAS_OPENSSL
+#include "hbssl.ch"
+#endif
#pragma -km+
+/*
+openssl genrsa -out privatekey.pem 2048
+openssl req -new -subj "/C=LT/CN=mycompany.org/O=My Company" -key privatekey.pem -out certrequest.csr
+openssl x509 -req -days 730 -in certrequest.csr -signkey privatekey.pem -out certificate.pem
+openssl x509 -in certificate.pem -text -noout
+*/
+
/*
Docs:
@@ -18,44 +29,39 @@
*/
-#define THREAD_COUNT_PREALLOC 0
+#define THREAD_COUNT_PREALLOC 3
#define THREAD_COUNT_MAX 50
#define SESSION_TIMEOUT 600
#define CR_LF ( Chr( 13 ) + Chr( 10 ) )
-THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_lSessionDestroy
+THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_aSessionData
-MEMVAR server, get, post, cookie, session
+MEMVAR server, get, post, cookie, session, httpd
+CREATE CLASS UHttpd MODULE FRIENDLY
-CREATE CLASS UHttpd
- /* Settings */
- VAR nPort INIT 80
- VAR cBindAddress INIT "0.0.0.0"
- VAR bLogAccess INIT {|| NIL }
- VAR bLogError INIT {|| NIL }
- VAR bTrace INIT {|| NIL }
- VAR bIdle INIT {|| NIL }
- VAR hMount INIT { => }
+ EXPORTED:
+ METHOD RUN( hConfig )
+ METHOD Stop()
- /* Results */
VAR cError INIT ""
- /* Private */
+ HIDDEN:
+ VAR hConfig
+
+ VAR aFirewallFilter
+
VAR hmtxQueue
VAR hmtxLog
VAR hmtxSession
VAR hListen
+ VAR hSSLCtx
VAR hSession
VAR lStop
- METHOD RUN()
- METHOD Stop()
-
- /* Private */
METHOD LogAccess()
METHOD LogError( cError )
@@ -65,45 +71,96 @@ FUNCTION UHttpdNew()
RETURN UHttpd()
-METHOD RUN() CLASS UHttpd
+METHOD RUN( hConfig ) CLASS UHttpd
- LOCAL hSocket, nI, aThreads
- LOCAL nWaiters
+ LOCAL hSocket, nI, aI, xValue, aThreads, nJobs, nWorkers
IF ! HB_MTVM()
Self:cError := "Multithread support required"
RETURN .F.
ENDIF
- IF Self:nPort < 1 .OR. Self:nPort > 65535
+ Self:hConfig := {;
+ "SSL" => .F. , ;
+ "Port" => 80, ;
+ "BindAddress" => "0.0.0.0", ;
+ "LogAccess" => {|| NIL }, ;
+ "LogError" => {|| NIL }, ;
+ "Trace" => {|| NIL }, ;
+ "Idle" => {|| NIL }, ;
+ "Mount" => { => }, ;
+ "PrivateKeyFilename" => "", ;
+ "CertificateFilename" => "", ;
+ "FirewallFilter" => "0.0.0.0/0" }
+
+ FOR EACH xValue IN hConfig
+ IF ! HB_HHasKey( Self:hConfig, xValue:__enumKey ) .OR. ValType( xValue ) != ValType( Self:hConfig[xValue:__enumKey] )
+ Self:cError := "Invalid config option '" + xValue:__enumKey + "'"
+ RETURN .F.
+ ENDIF
+ Self:hConfig[ xValue:__enumKey ] := xValue
+ NEXT
+
+
+ IF Self:hConfig["SSL"]
+#ifdef HB_HAS_OPENSSL
+ SSL_INIT()
+ DO WHILE RAND_STATUS() != 1
+ RAND_add( Str( hb_random(), 18, 15 ) + Str( hb_milliseconds(), 20 ), 1 )
+ ENDDO
+
+ Self:hSSLCtx := SSL_CTX_NEW( HB_SSL_CTX_NEW_METHOD_SSLV23_SERVER )
+ SSL_CTX_SET_OPTIONS( Self:hSSLCtx, HB_SSL_OP_NO_TLSv1 )
+ IF SSL_CTX_USE_PRIVATEKEY_FILE( Self:hSSLCtx, Self:hConfig["PrivateKeyFilename"], HB_SSL_FILETYPE_PEM ) != 1
+ Self:cError := "Invalid private key file"
+ RETURN .F.
+ ENDIF
+ IF SSL_CTX_USE_CERTIFICATE_FILE( Self:hSSLCtx, Self:hConfig["CertificateFilename"], HB_SSL_FILETYPE_PEM ) != 1
+ Self:cError := "Invalid certificate file"
+ RETURN .F.
+ ENDIF
+#else
+ Self:cError := "SSL not supported"
+ RETURN .F.
+#endif
+ ENDIF
+
+ IF Self:hConfig["Port"] < 1 .OR. Self:hConfig["Port"] > 65535
Self:cError := "Invalid port number"
RETURN .F.
ENDIF
+ IF ParseFirewallFilter( Self:hConfig["FirewallFilter"], @aI )
+ Self:aFirewallFilter := aI
+ ELSE
+ Self:cError := "Invalid firewall filter"
+ RETURN .F.
+ ENDIF
+
Self:hmtxQueue := hb_mutexCreate()
Self:hmtxLog := hb_mutexCreate()
Self:hmtxSession := hb_mutexCreate()
IF Empty( Self:hListen := hb_socketOpen() )
- Self:cError := "Socket create error " + hb_ntos( hb_socketGetError() )
+ Self:cError := "Socket create error: " + hb_socketErrorString()
RETURN .F.
ENDIF
- IF ! hb_socketBind( Self:hListen, { HB_SOCKET_AF_INET, Self:cBindAddress, Self:nPort } )
- Self:cError := "Bind error " + hb_ntos( hb_socketGetError() )
+ IF ! hb_socketBind( Self:hListen, { HB_SOCKET_AF_INET, Self:hConfig["BindAddress"], Self:hConfig["Port"] } )
+ Self:cError := "Bind error: " + hb_socketErrorString()
hb_socketClose( Self:hListen )
RETURN .F.
ENDIF
IF ! hb_socketListen( Self:hListen )
- Self:cError := "Listen error " + hb_ntos( hb_socketGetError() )
+ Self:cError := "Listen error: " + hb_socketErrorString()
hb_socketClose( Self:hListen )
RETURN .F.
ENDIF
aThreads := {}
FOR nI := 1 TO THREAD_COUNT_PREALLOC
- AAdd( aThreads, hb_threadStart( @ProcessConnection(), Self ) )
+ AAdd( aThreads, hb_threadStart( HB_THREAD_INHERIT_PUBLIC, @ProcessConnection(), Self ) )
NEXT
Self:lStop := .F.
@@ -112,43 +169,34 @@ METHOD RUN() CLASS UHttpd
DO WHILE .T.
IF Empty( hSocket := hb_socketAccept( Self:hListen,, 1000 ) )
IF hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT
- Eval( Self:bIdle, Self )
+ Eval( Self:hConfig["Idle"], Self )
IF Self:lStop
EXIT
ENDIF
ELSE
- Self:LogError( "[error] Accept error " + hb_ntos( hb_socketGetError() ) )
+ Self:LogError( "[error] Accept error: " + hb_socketErrorString() )
ENDIF
ELSE
- hb_mutexQueueInfo( Self:hmtxQueue, @nWaiters )
- Eval( Self:bTrace, "New connection", hSocket )
- Eval( Self:bTrace, "Waiters:", nWaiters )
- IF nWaiters < 2 .AND. Len( aThreads ) < THREAD_COUNT_MAX
- /*
- We need two threads in worst case. If first thread becomes a sessioned
- thread, the second one will continue to serve sessionless requests for
- the same connection. We create two threads here to avoid free thread count
- check (and aThreads variable sync) in ProcessRequest().
- */
- AAdd( aThreads, hb_threadStart( @ProcessConnection(), Self ) )
- AAdd( aThreads, hb_threadStart( @ProcessConnection(), Self ) )
+ Eval( Self:hConfig[ "Trace" ], "New connection", hSocket )
+ IF hb_mutexQueueInfo( Self:hmtxQueue, @nWorkers, @nJobs ) .AND. ;
+ Len( aThreads ) < THREAD_COUNT_MAX .AND. ;
+ nJobs >= nWorkers
+ AAdd( aThreads, hb_threadStart( HB_THREAD_INHERIT_PUBLIC, @ProcessConnection(), Self ) )
ENDIF
- hb_mutexNotify( Self:hmtxQueue, { hSocket, "" } )
+ hb_mutexNotify( Self:hmtxQueue, hSocket )
ENDIF
ENDDO
hb_socketClose( Self:hListen )
/* End child threads */
- hb_mutexLock( Self:hmtxSession )
- HB_HEVAL( Self:hSession, {|k, v| hb_mutexNotify( v[ 2 ], NIL ), HB_SYMBOL_UNUSED( k ) } )
- hb_mutexUnlock( Self:hmtxSession )
AEval( aThreads, {|| hb_mutexNotify( Self:hmtxQueue, NIL ) } )
- AEval( aThreads, {|h| hb_threadJoin( h ) } )
+ AEval( aThreads, {| h | hb_threadJoin( h ) } )
RETURN .T.
METHOD Stop() CLASS UHttpd
+ Eval( Self:hConfig[ "Trace" ], "stopping" )
Self:lStop := .T.
RETURN NIL
@@ -156,7 +204,7 @@ METHOD Stop() CLASS UHttpd
METHOD LogError( cError ) CLASS UHttpd
hb_mutexLock( Self:hmtxLog )
- Eval( Self:bLogError, DToS( Date() ) + " " + Time() + " " + cError )
+ Eval( Self:hConfig[ "LogError" ], DToS( Date() ) + " " + Time() + " " + cError )
hb_mutexUnlock( Self:hmtxLog )
RETURN NIL
@@ -166,491 +214,746 @@ METHOD LogAccess() CLASS UHttpd
LOCAL cDate := DToS( Date() ), cTime := Time()
hb_mutexLock( Self:hmtxLog )
- Eval( Self:bLogAccess, ;
- server[ "REMOTE_ADDR" ] + " - - [" + Right( cDate, 2 ) + "/" + ;
- { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }[ VAL( SUBSTR( cDate, 5, 2 ) ) ] + ;
- "/" + Left( cDate, 4 ) + ":" + cTime + ' +0000] "' + server[ "REQUEST_ALL" ] + '" ' + ;
+ Eval( Self:hConfig[ "LogAccess" ], ;
+ server["REMOTE_ADDR"] + " - - [" + Right( cDate, 2 ) + "/" + ;
+ { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }[VAL(SUBSTR(cDate, 5, 2))] + ;
+ "/" + Left( cDate, 4 ) + ":" + cTime + ' +0000] "' + server["REQUEST_ALL"] + '" ' + ;
hb_ntos( t_nStatusCode ) + " " + hb_ntos( Len( t_cResult ) ) + ;
- ' "' + server[ "HTTP_REFERER" ] + '" "' + server[ "HTTP_USER_AGENT" ] + ;
+ ' "' + server["HTTP_REFERER"] + '" "' + server["HTTP_USER_AGENT"] + ;
'"' )
hb_mutexUnlock( Self:hmtxLog )
RETURN NIL
+STATIC FUNCTION IPAddr2Num( cIP )
+
+ LOCAL aA, n1, n2, n3, n4
+
+ aA := hb_regex( "^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$", cIP )
+ IF Len( aA ) == 5 .AND. ( n1 := Val( aA[2] ) ) <= 255 .AND. ( n2 := Val( aA[3] ) ) <= 255 .AND. ;
+ ( n3 := Val( aA[4] ) ) <= 255 .AND. ( n4 := Val( aA[5] ) ) <= 255
+ RETURN ( ( (n1 * 256 ) + n2 ) * 256 + n3 ) * 256 + n4
+ ENDIF
+
+ RETURN NIL
+
+STATIC FUNCTION ParseFirewallFilter( cFilter, aFilter )
+
+ LOCAL cExpr, nI, cI, nPrefix, nAddr, nAddr2, nPos, nPos2, lDeny, aDeny, aI
+
+ aFilter := { => }
+ aDeny := {}
+ FOR EACH cExpr IN hb_ATokens( cFilter, " " )
+ IF ! Empty( cExpr )
+ IF lDeny := ( Left( cExpr, 1 ) == "!" )
+ cExpr := SubStr( cExpr, 2 )
+ ENDIF
+ IF ( nI := At( "/", cExpr ) ) > 0
+ cI := SubStr( cExpr, nI + 1 )
+ cExpr := Left( cExpr, nI - 1 )
+ IF "." $ cI
+ IF ( nI := IPAddr2Num( cI ) ) == NIL
+ RETURN .F.
+ ENDIF
+ nPrefix := 32
+ DO WHILE hb_bitAnd( nI, 1 ) == 0
+ nPrefix--
+ nI := hb_bitShift( nI, - 1 )
+ ENDDO
+ IF nI + 1 != hb_bitShift( 1, nPrefix )
+ RETURN .F.
+ ENDIF
+ ELSE
+ nPrefix := Val( cI )
+ IF nPrefix < 0 .OR. nPrefix > 32 .OR. ! ( HB_NTOS( nPrefix ) == cI )
+ RETURN .F.
+ ENDIF
+ ENDIF
+ ELSE
+ nPrefix := 32
+ ENDIF
+ IF ( nAddr := IPAddr2Num( cExpr ) ) == NIL
+ RETURN .F.
+ ENDIF
+ nPrefix := 0x100000000 - hb_bitShift( 1, 32 - nPrefix )
+
+ // Remove unnecessary network address part
+ nAddr := hb_bitAnd( nAddr, nPrefix )
+ nAddr2 := hb_bitOr( nAddr, hb_bitXor( nPrefix, 0xFFFFFFFF ) )
+
+ IF lDeny
+ AAdd( aDeny, { nAddr, nAddr2 } )
+ ELSE
+ // Add to filter
+ HB_HHasKey( aFilter, nAddr, @nPos )
+ IF nPos == 0 .OR. HB_HValueAt( aFilter, nPos ) + 1 < nAddr
+ // Does not overlap/glue with nPos
+ // So, add new interval
+ aFilter[ nAddr ] := nAddr2
+ nPos++
+ ENDIF
+ HB_HHasKey( aFilter, nAddr2 + 1, @nPos2 )
+ // Merge and delete inner subintervals
+ aFilter[ HB_HKeyAt( aFilter, nPos ) ] := Max( HB_HValueAt( aFilter, nPos2 ), nAddr2 )
+ DO WHILE nPos2-- > nPos
+ HB_HDelAt( aFilter, nPos + 1 )
+ ENDDO
+ ENDIF
+ ENDIF
+ NEXT
+
+ FOR EACH aI IN aDeny
+ nAddr := aI[1]
+ nAddr2 := aI[2]
+
+ // Delete from filter
+ HB_HHasKey( aFilter, nAddr, @nPos )
+ IF nPos == 0 .OR. HB_HValueAt( aFilter, nPos ) < nAddr
+ nPos++
+ ENDIF
+ IF nPos > Len( aFilter )
+ LOOP
+ ENDIF
+
+ HB_HHasKey( aFilter, nAddr2, @nPos2 )
+ IF nPos2 > 0 .AND. HB_HValueAt( aFilter, nPos2 ) > nAddr2
+ aFilter[ nAddr2 + 1 ] := HB_HValueAt( aFilter, nPos2 )
+ ENDIF
+ IF nAddr > HB_HKeyAt( aFilter, nPos )
+ aFilter[ HB_HKeyAt( aFilter, nPos ) ] := nAddr - 1
+ nPos++
+ ENDIF
+ DO WHILE nPos2-- >= nPos
+ HB_HDelAt( aFilter, nPos )
+ ENDDO
+ NEXT
+
+ RETURN .T.
+
+#ifdef HB_HAS_OPENSSL
+
+STATIC FUNCTION MY_SSL_READ( hConfig, hSSL, hSocket, cBuf, nTimeout, nError )
+
+ LOCAL nErr, nLen
+
+ nLen := SSL_READ( hSSL, @cBuf )
+ IF nLen < 0
+ nErr := SSL_GET_ERROR( hSSL, nLen )
+ IF nErr == HB_SSL_ERROR_WANT_READ
+ nErr := hb_socketSelectRead( hSocket, nTimeout )
+ IF nErr < 0
+ nError := hb_socketGetError()
+ ELSE // Both cases: data received and timeout
+ nError := HB_SOCKET_ERR_TIMEOUT
+ ENDIF
+ RETURN - 1
+ ELSEIF nErr == HB_SSL_ERROR_WANT_WRITE
+ nErr := hb_socketSelectWrite( hSocket, nTimeout )
+ IF nErr < 0
+ nError := hb_socketGetError()
+ ELSE // Both cases: data sent and timeout
+ nError := HB_SOCKET_ERR_TIMEOUT
+ ENDIF
+ RETURN - 1
+ ELSE
+ Eval( hConfig[ "Trace" ], "SSL_READ() error", nErr )
+ nError := 1000 + nErr
+ RETURN - 1
+ ENDIF
+ ENDIF
+
+ RETURN nLen
+
+STATIC FUNCTION MY_SSL_WRITE( hConfig, hSSL, hSocket, cBuf, nTimeout, nError )
+
+ LOCAL nErr, nLen
+
+ nLen := SSL_WRITE( hSSL, cBuf )
+ IF nLen <= 0
+ nErr := SSL_GET_ERROR( hSSL, nLen )
+ IF nErr == HB_SSL_ERROR_WANT_READ
+ nErr := hb_socketSelectRead( hSocket, nTimeout )
+ IF nErr < 0
+ nError := hb_socketGetError()
+ RETURN - 1
+ ELSE // Both cases: data received and timeout
+ RETURN 0
+ ENDIF
+ ELSEIF nErr == HB_SSL_ERROR_WANT_WRITE
+ nErr := hb_socketSelectWrite( hSocket, nTimeout )
+ IF nErr < 0
+ nError := hb_socketGetError()
+ RETURN - 1
+ ELSE // Both cases: data sent and timeout
+ RETURN 0
+ ENDIF
+ ELSE
+ Eval( hConfig[ "Trace" ], "SSL_WRITE() error", nErr )
+ nError := 1000 + nErr
+ RETURN - 1
+ ENDIF
+ ENDIF
+
+ RETURN nLen
+
+STATIC FUNCTION MY_SSL_ACCEPT( hConfig, hSSL, hSocket, nTimeout )
+
+ LOCAL nErr
+
+ nErr := SSL_ACCEPT( hSSL )
+ IF nErr > 0
+ RETURN 0
+ ELSEIF nErr < 0
+ nErr := SSL_GET_ERROR( hSSL, nErr )
+ IF nErr == HB_SSL_ERROR_WANT_READ
+ nErr := hb_socketSelectRead( hSocket, nTimeout )
+ IF nErr < 0
+ nErr := hb_socketGetError()
+ ELSE
+ nErr := HB_SOCKET_ERR_TIMEOUT
+ ENDIF
+ ELSEIF nErr == HB_SSL_ERROR_WANT_WRITE
+ nErr := hb_socketSelectWrite( hSocket, nTimeout )
+ IF nErr < 0
+ nErr := hb_socketGetError()
+ ELSE
+ nErr := HB_SOCKET_ERR_TIMEOUT
+ ENDIF
+ ELSE
+ Eval( hConfig[ "Trace" ], "SSL_ACCEPT() error", nErr )
+ nErr := 1000 + nErr
+ ENDIF
+ ELSE /* nErr == 0 */
+ nErr := SSL_GET_ERROR( hSSL, nErr )
+ Eval( hConfig[ "Trace" ], "SSL_ACCEPT() shutdown error", nErr )
+ nErr := 1000 + nErr
+ ENDIF
+
+ RETURN nErr
+
+#endif
+
STATIC FUNCTION ProcessConnection( oServer )
- LOCAL hSocket, cRequest, aI, nLen, nReqLen, cBuf
+ LOCAL hSocket, cRequest, aI, nLen, nErr, nTime, nReqLen, cBuf, aServer
+#ifdef HB_HAS_OPENSSL
+ LOCAL hSSL
+#endif
- PRIVATE server, get, post, cookie
+ ErrorBlock( {| o | UErrorHandler( o, oServer ) } )
+ PRIVATE server, get, post, cookie, session, httpd
+
+ httpd := oServer
+
+ /* main worker thread loop */
DO WHILE .T.
- hb_mutexSubscribe( oServer:hmtxQueue, , @aI )
- IF aI == NIL
+ hb_mutexSubscribe( oServer:hmtxQueue, , @hSocket )
+ IF hSocket == NIL
EXIT
ENDIF
- hSocket := aI[ 1 ]
- cRequest := aI[ 2 ]
+ /* Prepare server variable and clone it for every query,
+ because request handler script can ruin variable value */
+ aServer := { => }
+ aServer["HTTPS"] := oServer:hConfig["SSL"]
+ IF ! Empty( aI := hb_socketGetPeerName( hSocket ) )
+ aServer["REMOTE_ADDR"] := aI[2]
+ aServer["REMOTE_HOST"] := aServer["REMOTE_ADDR"] // no reverse DNS
+ aServer["REMOTE_PORT"] := aI[3]
+ ENDIF
+ IF ! Empty( aI := hb_socketGetSockName( hSocket ) )
+ aServer["SERVER_ADDR"] := aI[2]
+ aServer["SERVER_PORT"] := aI[3]
+ ENDIF
- BEGIN SEQUENCE
+ /* Firewall */
+ nLen := IPAddr2Num( aServer["REMOTE_ADDR"] )
+ HB_HHasKey( oServer:aFirewallFilter, nLen, @nErr )
+ IF nErr > 0 .AND. nLen <= HB_HValueAt( oServer:aFirewallFilter, nErr )
+ Eval( oServer:hConfig[ "Trace" ], "Firewall denied", aServer["REMOTE_ADDR"] )
+ hb_socketShutdown( hSocket )
+ hb_socketClose( hSocket )
+ LOOP
+ ENDIF
- /* receive query header */
- cRequest := ""
- nLen := 1
- DO WHILE At( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0
- cBuf := Space( 4096 )
- IF ( nLen := hb_socketRecv( hSocket, @cBuf,,, 10000 ) ) > 0 /* Timeout */
- cRequest += Left( cBuf, nLen )
+#ifdef HB_HAS_OPENSSL
+ IF oServer:hConfig["SSL"]
+ hSSL := SSL_NEW( oServer:hSSLCtx )
+ SSL_SET_MODE( hSSL, hb_bitOr( SSL_GET_MODE(hSSL ), HB_SSL_MODE_ENABLE_PARTIAL_WRITE ) )
+ hb_socketSetBlockingIO( hSocket, .F. )
+ SSL_SET_FD( hSSL, hb_socketGetFD( hSocket ) )
+
+ nTime := hb_milliseconds()
+ DO WHILE .T.
+ IF ( nErr := MY_SSL_ACCEPT( oServer:hConfig, hSSL, hSocket, 1000 ) ) == 0
+ EXIT
ELSE
- IF nLen == - 1 .AND. hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT
- nLen := 0
- Eval( oServer:bTrace, "recv() timeout", hSocket )
+ IF nErr == HB_SOCKET_ERR_TIMEOUT
+ IF ( hb_milliseconds() - nTime ) > 1000 * 30 .OR. oServer:lStop
+ Eval( oServer:hConfig[ "Trace" ], "SSL accept timeout", hSocket )
+ EXIT
+ ENDIF
+ ELSE
+ Eval( oServer:hConfig[ "Trace" ], "SSL accept error:", nErr, hb_socketErrorString( nErr ) )
+ EXIT
ENDIF
ENDIF
ENDDO
- IF nLen == - 1
- Eval( oServer:bTrace, "recv() error:", hb_socketGetError() )
- ELSEIF nLen == 0 /* connection closed */
- ELSE
+ IF nErr != 0
+ Eval( oServer:hConfig[ "Trace" ], "Close connection1", hSocket )
+ hb_socketShutdown( hSocket )
+ hb_socketClose( hSocket )
+ LOOP
+ ENDIF
- // PRIVATE
- server := { => }
- get := { => }
- post := { => }
- cookie := { => }
+ aServer["SSL_CIPHER"] := SSL_GET_CIPHER( hSSL )
+ aServer["SSL_PROTOCOL"] := SSL_GET_VERSION( hSSL )
+ aServer["SSL_CIPHER_USEKEYSIZE"] := SSL_GET_CIPHER_BITS( hSSL, @nErr )
+ aServer["SSL_CIPHER_ALGKEYSIZE"] := nErr
+ aServer["SSL_VERSION_LIBRARY"] := SSLEAY_VERSION( HB_SSLEAY_VERSION )
+ aServer["SSL_SERVER_I_DN"] := X509_NAME_ONELINE( X509_GET_ISSUER_NAME( SSL_GET_CERTIFICATE(hSSL ) ) )
+ aServer["SSL_SERVER_S_DN"] := X509_NAME_ONELINE( X509_GET_SUBJECT_NAME( SSL_GET_CERTIFICATE(hSSL ) ) )
+ ENDIF
+#endif
- t_cResult := ""
- t_aHeader := {}
- t_nStatusCode := 200
+ /* loop for processing connection */
- IF !Empty( aI := hb_socketGetPeerName( hSocket ) )
- server[ "REMOTE_ADDR" ] := aI[HB_SOCKET_ADINFO_ADDRESS]
- server[ "REMOTE_HOST" ] := server[ "REMOTE_ADDR" ] // no reverse DNS
- server[ "REMOTE_PORT" ] := aI[HB_SOCKET_ADINFO_PORT]
- ENDIF
+ /* Set cRequest to empty string here. This enables request pipelining */
+ cRequest := ""
+ DO WHILE ! oServer:lStop
- IF !Empty( aI := hb_socketGetSockName( hSocket ) )
- server[ "SERVER_ADDR" ] := aI[HB_SOCKET_ADINFO_ADDRESS]
- server[ "SERVER_PORT" ] := aI[HB_SOCKET_ADINFO_PORT]
- ENDIF
-
- Eval( oServer:bTrace, Left( cRequest, At( CR_LF + CR_LF, cRequest ) + 1 ) )
-
- nReqLen := ParseRequestHeader( @cRequest )
- IF nReqLen == NIL
- USetStatusCode( 400 )
+ /* receive query header */
+ nLen := 1
+ nTime := hb_milliseconds()
+ cBuf := Space( 4096 )
+ DO WHILE At( CR_LF + CR_LF, cRequest ) == 0
+#ifdef HB_HAS_OPENSSL
+ IF oServer:hConfig["SSL"]
+ nLen := MY_SSL_READ( oServer:hConfig, hSSL, hSocket, @cBuf, 1000, @nErr )
ELSE
-
- /* receive query body */
- DO WHILE Len( cRequest ) < nReqLen .AND. nLen > 0
- cBuf := Space( 4096 )
- IF ( nLen := hb_socketRecv( hSocket, @cBuf,,, 500 ) ) > 0
- cRequest += Left( cBuf, nLen )
+#endif
+ nLen := hb_socketRecv( hSocket, @cBuf, , , 1000 )
+ IF nLen < 0
+ nErr := hb_socketGetError()
+ ENDIF
+#ifdef HB_HAS_OPENSSL
+ ENDIF
+#endif
+ IF nLen > 0
+ cRequest += Left( cBuf, nLen )
+ ELSEIF nLen == 0
+ /* connection closed */
+ EXIT
+ ELSE
+ /* nLen == -1 socket error */
+ IF nErr == HB_SOCKET_ERR_TIMEOUT
+ IF ( hb_milliseconds() - nTime ) > 1000 * 30 .OR. oServer:lStop
+ Eval( oServer:hConfig[ "Trace" ], "receive timeout", hSocket )
+ EXIT
ENDIF
- ENDDO
-
- IF nLen == - 1
- Eval( oServer:bTrace, "recv() error:", hb_socketGetError() )
- ELSEIF nLen == 0 /* connection closed */
ELSE
- Eval( oServer:bTrace, cRequest )
- ParseRequestBody( Left( cRequest, nReqLen ) )
- cRequest := SubStr( cRequest, nReqLen + 1 )
-
- /* Deal with supported protocols and methods */
- IF server[ "SERVER_PROTOCOL" ] $ "HTTP/1.0 HTTP/1.1"
- IF !( server[ "REQUEST_METHOD" ] $ "GET POST" )
- USetStatusCode( 501 )
- ELSE
- IF server[ "SERVER_PROTOCOL" ] == "HTTP/1.1"
- IF Lower( server[ "HTTP_CONNECTION" ] ) == "close"
- UAddHeader( "Connection", "close" )
- ELSE
- UAddHeader( "Connection", "keep-alive" )
- ENDIF
- ENDIF
- IF ! ProcessRequest( oServer, hSocket )
- BREAK
- ENDIF
- ENDIF
- ELSE /* We do not support another protocols */
- USetStatusCode( 400 )
- ENDIF
+ Eval( oServer:hConfig[ "Trace" ], "receive error:", nErr, hb_socketErrorString( nErr ) )
+ EXIT
ENDIF
ENDIF
+ ENDDO
- SendResponse( oServer, hSocket )
-
- IF Lower( UGetHeader( "Connection" ) ) == "close" .OR. server[ "SERVER_PROTOCOL" ] == "HTTP/1.0"
- ELSE
- hb_mutexNotify( oServer:hmtxQueue, { hSocket, cRequest } )
- BREAK
- ENDIF
- ENDIF
- Eval( oServer:bTrace, "Close connection1", hSocket )
- hb_socketShutdown( hSocket )
- hb_socketClose( hSocket )
- END SEQUENCE
- ENDDO
- dbCloseAll()
-
- RETURN 0
-
-STATIC FUNCTION ProcessRequest( oServer, hSocket, cBuffer )
-
- LOCAL nI, cMount, cPath, cSID, hmtx, aData, bEval
-
- PRIVATE session
-
- // Search mounting table
- cMount := server[ "SCRIPT_NAME" ]
- IF cMount $ oServer:hMount
- cPath := ""
- ELSE
- nI := Len( cMount )
- DO WHILE ( nI := HB_RAT( "/", cMount,, nI ) ) > 0
- IF ( Left( cMount, nI ) + "*" ) $ oServer:hMount
- cMount := Left( cMount, nI ) + "*"
- cPath := SubStr( server[ "SCRIPT_NAME" ], nI + 1 )
+ IF nLen <= 0 .OR. oServer:lStop
EXIT
ENDIF
- nI--
- ENDDO
- ENDIF
- IF cPath != NIL
- bEval := oServer:hMount[ cMount, 1 ]
+ // PRIVATE
+ server := HB_HCLONE( aServer )
+ get := { => }
+ post := { => }
+ cookie := { => }
+ session := NIL
- IF oServer:hMount[ cMount, 2 ]
- /* sessioned */
- IF "SESSID" $ cookie
- cSID := cookie[ "SESSID" ]
- ENDIF
+ t_cResult := ""
+ t_aHeader := {}
+ t_nStatusCode := 200
+ t_aSessionData := NIL
- hb_mutexLock( oServer:hmtxSession )
- IF cSID == NIL .OR. !( cSID $ oServer:hSession )
+ Eval( oServer:hConfig[ "Trace" ], Left( cRequest, At( CR_LF + CR_LF, cRequest ) + 1 ) )
- /* create new session */
+ nReqLen := ParseRequestHeader( @cRequest )
+ IF nReqLen == NIL
+ USetStatusCode( 400 )
+ UAddHeader( "Connection", "close" )
+ ELSE
- cSID := HB_MD5( DToS( Date() ) + Time() + Str( HB_RANDOM(), 15, 12 ) )
- hmtx := hb_mutexCreate()
- oServer:hSession[ cSID ] := { hb_threadSelf(), hmtx, { => } }
-
- // PRIVATE
- session := oServer:hSession[ cSID, 3 ]
-
- hb_mutexUnlock( oServer:hmtxSession )
-
- DO WHILE .T.
- t_cResult := ""
- t_aHeader := {}
- t_nStatusCode := 200
- t_lSessionDestroy := .F.
- BEGIN SEQUENCE WITH {|oErr| iif( UErrorHandler( oErr, oServer ), Break( oErr ), ) }
- Eval( bEval, cPath )
- RECOVER
- USetStatusCode( 500 )
- END SEQUENCE
-
- IF t_lSessionDestroy
- UAddHeader( "Set-Cookie", "SESSID=" + cSID + "; path=/; Max-Age=0" )
+ /* receive query body */
+ nLen := 1
+ nTime := hb_milliseconds()
+ cBuf := Space( 4096 )
+ DO WHILE Len( cRequest ) < nReqLen
+#ifdef HB_HAS_OPENSSL
+ IF oServer:hConfig["SSL"]
+ nLen := MY_SSL_READ( oServer:hConfig, hSSL, hSocket, @cBuf, 1000, @nErr )
ELSE
- UAddHeader( "Set-Cookie", "SESSID=" + cSID + "; path=/" )
+#endif
+ nLen := hb_socketRecv( hSocket, @cBuf, , , 1000 )
+ IF nLen < 0
+ nErr := hb_socketGetError()
+ ENDIF
+#ifdef HB_HAS_OPENSSL
ENDIF
+#endif
+ IF nLen > 0
+ cRequest += Left( cBuf, nLen )
+ ELSEIF nLen == 0
+ /* connection closed */
+ EXIT
+ ELSE
+ /* nLen == -1 socket error */
+ IF nErr == HB_SOCKET_ERR_TIMEOUT
+ IF ( hb_milliseconds() - nTime ) > 1000 * 120 .OR. oServer:lStop
+ Eval( oServer:hConfig[ "Trace" ], "receive timeout", hSocket )
+ EXIT
+ ENDIF
+ ELSE
+ Eval( oServer:hConfig[ "Trace" ], "receive error:", nErr, hb_socketErrorString( nErr ) )
+ EXIT
+ ENDIF
+ ENDIF
+ ENDDO
- IF server[ "SERVER_PROTOCOL" ] == "HTTP/1.1"
- IF Lower( server[ "HTTP_CONNECTION" ] ) == "close"
+ IF nLen <= 0 .OR. oServer:lStop
+ EXIT
+ ENDIF
+
+ Eval( oServer:hConfig[ "Trace" ], cRequest )
+ ParseRequestBody( Left( cRequest, nReqLen ) )
+ cRequest := SubStr( cRequest, nReqLen + 1 )
+
+ /* Deal with supported protocols and methods */
+ IF ! ( Left( server["SERVER_PROTOCOL"], 5 ) == "HTTP/" )
+ USetStatusCode( 400 ) /* Bad request */
+ UAddHeader( "Connection", "close" )
+ ELSEIF ! ( SubStr( server["SERVER_PROTOCOL"], 6 ) $ "1.0 1.1" )
+ USetStatusCode( 505 ) /* HTTP version not supported */
+ ELSEIF !( server["REQUEST_METHOD"] $ "GET POST" )
+ USetStatusCode( 501 ) /* Not implemented */
+ ELSE
+ IF server["SERVER_PROTOCOL"] == "HTTP/1.1"
+ IF Lower( server["HTTP_CONNECTION"] ) == "close"
UAddHeader( "Connection", "close" )
ELSE
UAddHeader( "Connection", "keep-alive" )
ENDIF
ENDIF
- SendResponse( oServer, hSocket )
+ /* Do the job */
+ ProcessRequest( oServer )
+ dbCloseAll()
+ ENDIF
+ ENDIF /* request header ok */
- IF t_lSessionDestroy
- /* Destroy session before closing socket, since graceful close requires some time */
- hb_mutexLock( oServer:hmtxSession )
- HB_HDel( oServer:hSession, cSID )
- hb_mutexUnlock( oServer:hmtxSession )
+ // Send response
+ cBuf := MakeResponse( oServer:hConfig )
+
+ DO WHILE Len( cBuf ) > 0 .AND. ! oServer:lStop
+#ifdef HB_HAS_OPENSSL
+ IF oServer:hConfig["SSL"]
+ nLen := MY_SSL_WRITE( oServer:hConfig, hSSL, hSocket, cBuf, 1000, @nErr )
+ ELSE
+#endif
+ nLen := hb_socketSend( hSocket, cBuf, , , 1000 )
+ IF nLen < 0
+ nErr := hb_socketGetError()
ENDIF
+#ifdef HB_HAS_OPENSSL
+ ENDIF
+#endif
+ IF nLen < 0
+ Eval( oServer:hConfig[ "Trace" ], "send error:", nErr, hb_socketErrorString( nErr ) )
+ EXIT
+ ELSEIF nLen > 0
+ cBuf := SubStr( cBuf, nLen + 1 )
+ ENDIF
+ ENDDO
- IF Lower( UGetHeader( "Connection" ) ) == "close" .OR. server[ "SERVER_PROTOCOL" ] == "HTTP/1.0"
- Eval( oServer:bTrace, "Close connection2", hSocket )
- hb_socketShutdown( hSocket )
- hb_socketClose( hSocket )
- ELSE
- /* pass connection to common queue */
- hb_mutexNotify( oServer:hmtxQueue, { hSocket, cBuffer } )
- ENDIF
-
- IF t_lSessionDestroy
- EXIT
- ENDIF
-
- IF ! hb_mutexSubscribe( hmtx, SESSION_TIMEOUT, @aData ) .OR. aData == NIL
- Eval( oServer:bTrace, "Session exit" )
- hb_mutexLock( oServer:hmtxSession )
- HB_HDel( oServer:hSession, cSID )
- hb_mutexUnlock( oServer:hmtxSession )
- EXIT
- ENDIF
- hSocket := aData[ 1 ]
- cBuffer := aData[ 2 ]
- bEval := aData[ 3 ]
- cPath := aData[ 4 ]
- server := aData[ 5 ]
- get := aData[ 6 ]
- post := aData[ 7 ]
- cookie := aData[ 8 ]
- session := aData[ 9 ]
- aData := NIL
- ENDDO
-
- /* close databases and release variables */
- dbCloseAll()
- server := NIL
- get := NIL
- post := NIL
- cookie := NIL
- session := NIL
- ELSE
- /* session already exists */
- Eval( oServer:bTrace, "session pries", server[ "SCRIPT_NAME" ] )
- hb_mutexNotify( oServer:hSession[ cSID, 2 ], { hSocket, cBuffer, oServer:hMount[ cMount, 1 ], cPath, server, get, post, cookie, oServer:hSession[ cSID, 3 ] } )
- hb_mutexUnlock( oServer:hmtxSession )
+ IF oServer:lStop
+ EXIT
ENDIF
- RETURN .F.
- ELSE
- /* not sessioned */
- BEGIN SEQUENCE WITH {|oErr| iif( UErrorHandler( oErr, oServer ), Break( oErr ), ) }
- Eval( bEval, cPath )
- RECOVER
- USetStatusCode( 500 )
- END SEQUENCE
+ oServer:LogAccess()
+
+ IF Lower( UGetHeader( "Connection" ) ) == "close" .OR. server["SERVER_PROTOCOL"] == "HTTP/1.0"
+ EXIT
+ ENDIF
+ ENDDO
+
+#ifdef HB_HAS_OPENSSL
+ hSSL := NIL
+#endif
+ Eval( oServer:hConfig[ "Trace" ], "Close connection1", hSocket )
+ hb_socketShutdown( hSocket )
+ hb_socketClose( hSocket )
+ ENDDO
+
+ RETURN 0
+
+STATIC PROCEDURE ProcessRequest( oServer )
+
+ LOCAL nI, aMount, cMount, cPath, bEval, xRet, nT := HB_MILLISECONDS()
+
+ // Search mounting table
+ aMount := oServer:hConfig["Mount"]
+ cMount := server["SCRIPT_NAME"]
+ IF HB_HHasKey( aMount, cMount )
+ cPath := ""
+ ELSE
+ nI := Len( cMount )
+ DO WHILE ( nI := HB_RAT( "/", cMount,, nI ) ) > 0
+ IF HB_HHasKey( aMount, Left( cMount, nI ) + "*" )
+ Eval( oServer:hConfig[ "Trace" ], "HAS", Left( cMount, nI ) + "*" )
+ cMount := Left( cMount, nI ) + "*"
+ cPath := SubStr( server["SCRIPT_NAME"], nI + 1 )
+ EXIT
+ ENDIF
+ IF --nI == 0
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+ IF cPath != NIL
+ bEval := aMount[cMount]
+ BEGIN SEQUENCE WITH {| oErr | UErrorHandler( oErr, oServer ) }
+ xRet := Eval( bEval, cPath )
+ IF ValType( xRet ) == "C"
+ UWrite( xRet )
+ ELSEIF ValType( xRet ) == "H"
+ UWrite( UParse( xRet ) )
+ ENDIF
+ RECOVER
+ USetStatusCode( 500 )
+ UAddHeader( "Connection", "close" )
+ END SEQUENCE
+ dbCloseAll()
+ // Unlock session
+ IF t_aSessionData != NIL
+ session := NIL
+ hb_mutexUnlock( t_aSessionData[1] )
+ t_aSessionData := NIL
ENDIF
ELSE
USetStatusCode( 404 )
ENDIF
+ Eval( oServer:hConfig[ "Trace" ], "ProcessRequest time:", hb_ntos( HB_MILLISECONDS() - nT ), "ms" )
- RETURN .T.
+ RETURN
STATIC FUNCTION ParseRequestHeader( cRequest )
LOCAL aRequest, aLine, nI, nJ, cI, nK, nContentLength := 0
- aRequest := uhttpd_split( CR_LF, cRequest )
- aLine := uhttpd_split( " ", aRequest[ 1 ] )
+ nI := At( CR_LF + CR_LF, cRequest )
+ aRequest := hb_ATokens( Left( cRequest, nI - 1 ), CR_LF )
+ cRequest := SubStr( cRequest, nI + 4 )
- server[ "REQUEST_ALL" ] := aRequest[ 1 ]
- IF Len( aLine ) == 3 .AND. Left( aLine[ 3 ], 5 ) == "HTTP/"
- server[ "REQUEST_METHOD" ] := aLine[ 1 ]
- server[ "REQUEST_URI" ] := aLine[ 2 ]
- server[ "SERVER_PROTOCOL" ] := aLine[ 3 ]
+ aLine := hb_ATokens( aRequest[1], " " )
+
+ server["REQUEST_ALL"] := aRequest[1]
+ IF Len( aLine ) == 3 .AND. Left( aLine[3], 5 ) == "HTTP/"
+ server["REQUEST_METHOD"] := aLine[1]
+ server["REQUEST_URI"] := aLine[2]
+ server["SERVER_PROTOCOL"] := aLine[3]
ELSE
- server[ "REQUEST_METHOD" ] := aLine[ 1 ]
- server[ "REQUEST_URI" ] := iif( Len( aLine ) >= 2, aLine[ 2 ], "" )
- server[ "SERVER_PROTOCOL" ] := iif( Len( aLine ) >= 3, aLine[ 3 ], "" )
- RETURN 0
+ server["REQUEST_METHOD"] := aLine[1]
+ server["REQUEST_URI"] := iif( Len( aLine ) >= 2, aLine[2], "" )
+ server["SERVER_PROTOCOL"] := iif( Len( aLine ) >= 3, aLine[3], "" )
+ RETURN NIL
ENDIF
// Fix invalid queries: bind to root
- IF ! ( Left( server[ "REQUEST_URI" ], 1 ) == "/" )
- server[ "REQUEST_URI" ] := "/" + server[ "REQUEST_URI" ]
+ IF ! ( Left( server["REQUEST_URI"], 1 ) == "/" )
+ server["REQUEST_URI"] := "/" + server["REQUEST_URI"]
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 )
+ 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" ] := ""
+ 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_CONTENT_TYPE" ] := ""
+ 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"] := ""
FOR nI := 2 TO Len( aRequest )
- IF aRequest[ nI ] == ""
+ IF aRequest[nI] == ""
EXIT
- ELSEIF ( nJ := At( ":", aRequest[ nI ] ) ) > 0
- cI := AllTrim( SubStr( aRequest[ nI ], nJ + 1 ) )
- SWITCH Upper( Left( aRequest[ nI ], nJ - 1 ) )
+ ELSEIF ( nJ := At( ":", aRequest[nI] ) ) > 0
+ cI := AllTrim( SubStr( aRequest[nI], nJ + 1 ) )
+ SWITCH Upper( Left( aRequest[nI], nJ - 1 ) )
CASE "COOKIE"
+ server["HTTP_COOKIE"] := cI
IF ( nK := At( ";", cI ) ) == 0
nK := Len( RTrim( cI ) )
ENDIF
cI := Left( cI, nK )
IF ( nK := At( "=", cI ) ) > 0
/* cookie names are case insensitive, uppercase it */
- cookie[ UPPER( LEFT( cI, nK - 1 ) ) ] := SubStr( cI, nK + 1 )
+ cookie[UPPER(LEFT(cI, nK - 1))] := SubStr( cI, nK + 1 )
ENDIF
EXIT
CASE "CONTENT-LENGTH"
nContentLength := Val( cI )
EXIT
- OTHERWISE
- server[ "HTTP_" + STRTRAN( UPPER( LEFT( aRequest[ nI ], nJ - 1 ) ), "-", "_" ) ] := cI
+ CASE "CONTENT-TYPE"
+ server["CONTENT_TYPE"] := cI
+ EXIT
+ OTHERWISE
+ server["HTTP_" + STRTRAN(UPPER(LEFT(aRequest[nI], nJ - 1 ) ), "-", "_" )] := cI
EXIT
ENDSWITCH
ENDIF
NEXT
- IF !( server[ "QUERY_STRING" ] == "" )
- FOR EACH cI IN uhttpd_split( "&", server[ "QUERY_STRING" ] )
+ IF !( server["QUERY_STRING"] == "" )
+ FOR EACH cI IN hb_ATokens( server["QUERY_STRING"], "&" )
IF ( nI := At( "=", cI ) ) > 0
- get[ UUrlDecode( LEFT( cI, nI - 1 ) ) ] := UUrlDecode( SubStr( cI, nI + 1 ) )
+ get[UUrlDecode(LEFT(cI, nI - 1))] := UUrlDecode( SubStr( cI, nI + 1 ) )
ELSE
- get[ UUrlDecode( cI ) ] := NIL
+ get[UUrlDecode(cI)] := NIL
ENDIF
NEXT
ENDIF
- cRequest := SubStr( cRequest, At( CR_LF + CR_LF, cRequest ) + 4 )
RETURN nContentLength
STATIC FUNCTION ParseRequestBody( cRequest )
- LOCAL nI, cPart
+ LOCAL nI, cPart, cEncoding
- IF server[ "HTTP_CONTENT_TYPE" ] == "application/x-www-form-urlencoded"
- FOR EACH cPart IN uhttpd_split( "&", cRequest )
- IF ( nI := At( "=", cPart ) ) > 0
- post[ UUrlDecode( LEFT( cPart, nI - 1 ) ) ] := UUrlDecode( SubStr( cPart, nI + 1 ) )
+ IF HB_HHasKey( server, "CONTENT_TYPE" ) .AND. ;
+ Left( server["CONTENT_TYPE"], 33 ) == "application/x-www-form-urlencoded"
+ IF ( nI := At( "CHARSET=", Upper( server["CONTENT_TYPE"] ) ) ) > 0
+ cEncoding := Upper( SubStr( server["CONTENT_TYPE"], nI + 8 ) )
+ ENDIF
+ IF !( cRequest == "" )
+ IF cEncoding == "UTF-8"
+ FOR EACH cPart IN hb_ATokens( cRequest, "&" )
+ IF ( nI := At( "=", cPart ) ) > 0
+ post[ HB_UTF8TOSTR( UUrlDecode( LEFT( cPart, nI - 1 ) ) ) ] := HB_UTF8TOSTR( UUrlDecode( SubStr( cPart, nI + 1 ) ) )
+ ELSE
+ post[ HB_UTF8TOSTR( UUrlDecode( cPart ) ) ] := NIL
+ ENDIF
+ NEXT
ELSE
- post[ UUrlDecode( cPart ) ] := NIL
+ FOR EACH cPart IN hb_ATokens( cRequest, "&" )
+ IF ( nI := At( "=", cPart ) ) > 0
+ post[ UUrlDecode( LEFT( cPart, nI - 1 ) ) ] := UUrlDecode( SubStr( cPart, nI + 1 ) )
+ ELSE
+ post[ UUrlDecode( cPart ) ] := NIL
+ ENDIF
+ NEXT
ENDIF
- NEXT
+ ENDIF
ENDIF
RETURN NIL
-STATIC FUNCTION MakeResponse( oServer )
+STATIC FUNCTION MakeResponse( hConfig )
- LOCAL cRet
+ LOCAL cRet, cStatus
IF UGetHeader( "Content-Type" ) == NIL
UAddHeader( "Content-Type", "text/html" )
ENDIF
UAddHeader( "Date", HttpDateFormat( HB_DATETIME() ) )
- cRet := iif( server[ "SERVER_PROTOCOL" ] == "HTTP/1.0", "HTTP/1.0 ", "HTTP/1.1 " )
+ cRet := iif( server["SERVER_PROTOCOL"] == "HTTP/1.0", "HTTP/1.0 ", "HTTP/1.1 " )
SWITCH t_nStatusCode
- CASE 200
- cRet += "200 OK"
- EXIT
- CASE 301
- cRet += "301 Moved Permanently"
- t_cResult := "301 Moved Permanently "
- EXIT
- CASE 302
- cRet += "302 Found"
- t_cResult := "302 Found "
- EXIT
- CASE 303
- cRet += "303 See Other"
- t_cResult := "303 See Other "
- EXIT
- CASE 304
- cRet += "304 Not Modified"
- t_cResult := "304 Not Modified "
- EXIT
- CASE 400
- cRet += "400 Bad Request"
- t_cResult := "400 Bad Request "
- UAddHeader( "Connection", "close" )
- EXIT
- CASE 401
- cRet += "401 Unauthorized"
- t_cResult := "401 Unauthorized "
- EXIT
- CASE 402
- cRet += "402 Payment Required"
- t_cResult := "402 Payment Required "
- EXIT
- CASE 403
- cRet += "403 Forbidden"
- t_cResult := "403 Forbidden "
- EXIT
- CASE 404
- cRet += "404 Not Found"
- t_cResult := "404 Not Found "
- EXIT
- CASE 412
- cRet += "412 Precondition Failed"
- t_cResult := "412 Precondition Failed "
- EXIT
- CASE 500
- cRet += "500 Internal Server Error"
- t_cResult := "500 Internal Server Error "
- EXIT
- CASE 501
- cRet += "501 Not Implemented"
- t_cResult := "501 Not Implemented "
- UAddHeader( "Connection", "close" )
- EXIT
- OTHERWISE
- cRet += "500 Internal Server Error"
- t_cResult := "500 Internal Server Error "
- UAddHeader( "Connection", "close" )
+ CASE 100 ; cStatus := "100 Continue" ; EXIT
+ CASE 101 ; cStatus := "101 Switching Protocols" ; EXIT
+ CASE 200 ; cStatus := "200 OK" ; EXIT
+ CASE 201 ; cStatus := "201 Created" ; EXIT
+ CASE 202 ; cStatus := "202 Accepted" ; EXIT
+ CASE 203 ; cStatus := "203 Non-Authoritative Information" ; EXIT
+ CASE 204 ; cStatus := "204 No Content" ; EXIT
+ CASE 205 ; cStatus := "205 Reset Content" ; EXIT
+ CASE 206 ; cStatus := "206 Partial Content" ; EXIT
+ CASE 300 ; cStatus := "300 Multiple Choices" ; EXIT
+ CASE 301 ; cStatus := "301 Moved Permanently" ; EXIT
+ CASE 302 ; cStatus := "302 Found" ; EXIT
+ CASE 303 ; cStatus := "303 See Other" ; EXIT
+ CASE 304 ; cStatus := "304 Not Modified" ; EXIT
+ CASE 305 ; cStatus := "305 Use Proxy" ; EXIT
+ CASE 307 ; cStatus := "307 Temporary Redirect" ; EXIT
+ CASE 400 ; cStatus := "400 Bad Request" ; EXIT
+ CASE 401 ; cStatus := "401 Unauthorized" ; EXIT
+ CASE 402 ; cStatus := "402 Payment Required" ; EXIT
+ CASE 403 ; cStatus := "403 Forbidden" ; EXIT
+ CASE 404 ; cStatus := "404 Not Found" ; EXIT
+ CASE 405 ; cStatus := "405 Method Not Allowed" ; EXIT
+ CASE 406 ; cStatus := "406 Not Acceptable" ; EXIT
+ CASE 407 ; cStatus := "407 Proxy Authentication Required" ; EXIT
+ CASE 408 ; cStatus := "408 Request Timeout" ; EXIT
+ CASE 409 ; cStatus := "409 Conflict" ; EXIT
+ CASE 410 ; cStatus := "410 Gone" ; EXIT
+ CASE 411 ; cStatus := "411 Length Required" ; EXIT
+ CASE 412 ; cStatus := "412 Precondition Failed" ; EXIT
+ CASE 413 ; cStatus := "413 Request Entity Too Large" ; EXIT
+ CASE 414 ; cStatus := "414 Request-URI Too Long" ; EXIT
+ CASE 415 ; cStatus := "415 Unsupprted Media Type" ; EXIT
+ CASE 416 ; cStatus := "416 Requested Range Not Satisfiable" ; EXIT
+ CASE 417 ; cStatus := "417 Expectation Failed" ; EXIT
+ CASE 500 ; cStatus := "500 Internal Server Error" ; EXIT
+ CASE 501 ; cStatus := "501 Not Implemented" ; EXIT
+ CASE 502 ; cStatus := "502 Bad Gateway" ; EXIT
+ CASE 503 ; cStatus := "503 Service Unavailable" ; EXIT
+ CASE 504 ; cStatus := "504 Gateway Timeout" ; EXIT
+ CASE 505 ; cStatus := "505 HTTP Version Not Supported" ; EXIT
+ OTHERWISE; cStatus := "500 Internal Server Error"
ENDSWITCH
- cRet += CR_LF
+
+ cRet += cStatus + CR_LF
+ IF t_nStatusCode != 200
+ t_cResult := "" + cStatus + " "
+ ENDIF
UAddHeader( "Content-Length", hb_ntos( Len( t_cResult ) ) )
- AEval( t_aHeader, {|x| cRet += x[ 1 ] + ": " + x[ 2 ] + CR_LF } )
+ AEval( t_aHeader, {| x | cRet += x[1] + ": " + x[2] + CR_LF } )
cRet += CR_LF
- Eval( oServer:bTrace, cRet )
+ Eval( hConfig[ "Trace" ], cRet )
cRet += t_cResult
RETURN cRet
-STATIC PROCEDURE SendResponse( oServer, hSocket )
-
- LOCAL cSend, nLen
-
- cSend := MakeResponse( oServer )
-
- // Eval( oServer:bTrace, cSend )
-
- DO WHILE Len( cSend ) > 0
- IF ( nLen := hb_socketSend( hSocket, cSend ) ) == - 1
- Eval( oServer:bTrace, "send() error:", hb_socketGetError(), hSocket )
- EXIT
- ELSEIF nLen > 0
- cSend := SubStr( cSend, nLen + 1 )
- ENDIF
- ENDDO
- oServer:LogAccess()
-
- RETURN
-
STATIC FUNCTION HttpDateFormat( tDate )
- RETURN { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }[ DOW( tDate ) ] + ", " + ;
+ tDate -= HB_UTCOFFSET() / ( 3600 * 24 )
+
+ RETURN { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }[DOW(tDate)] + ", " + ;
PadL( Day( tDate ), 2, "0" ) + " " + ;
- { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }[ MONTH( tDate ) ] + ;
- " " + PadL( Year( tDate ), 4, "0" ) + HB_TTOC( tDate, "", "HH:MM:SS" ) + " GMT" // TOFIX: time zone
+ { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }[MONTH(tDate)] + ;
+ " " + PadL( Year( tDate ), 4, "0" ) + " " + HB_TTOC( tDate, "", "HH:MM:SS" ) + " GMT" // TOFIX: time zone
STATIC FUNCTION HttpDateUnformat( cDate, tDate )
- LOCAL nMonth
+ LOCAL nMonth, tI
// TODO: support outdated compatibility format RFC2616
IF Len( cDate ) == 29 .AND. Right( cDate, 4 ) == " GMT" .AND. SubStr( cDate, 4, 2 ) == ", "
nMonth := AScan( { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", ;
"Oct", "Nov", "Dec" }, SubStr( cDate, 9, 3 ) )
IF nMonth > 0
- tDate := HB_STOT( SubStr( cDate, 13, 4 ) + PadL( nMonth, 2, "0" ) + SubStr( cDate, 6, 2 ) + ;
- StrTran( SubStr( cDate, 18, 8 ), ":" ) )
- RETURN ! Empty( tDate )
+ tI := HB_STOT( SubStr( cDate, 13, 4 ) + PadL( nMonth, 2, "0" ) + SubStr( cDate, 6, 2 ) + StrTran( SubStr(cDate, 18, 8 ), ":", "" ) )
+ IF ! Empty( tI )
+ tDate := tI + HB_UTCOFFSET() / ( 3600 * 24 )
+ RETURN .T.
+ ENDIF
ENDIF
ENDIF
@@ -658,6 +961,7 @@ STATIC FUNCTION HttpDateUnformat( cDate, tDate )
STATIC FUNCTION UErrorHandler( oErr, oServer )
+ Eval( oServer:hConfig[ "Trace" ], "UErrorHandler" )
IF oErr:genCode == EG_ZERODIV; RETURN 0
ELSEIF oErr:genCode == EG_LOCK; RETURN .T.
ELSEIF ( oErr:genCode == EG_OPEN .AND. oErr:osCode == 32 .OR. ;
@@ -665,14 +969,16 @@ STATIC FUNCTION UErrorHandler( oErr, oServer )
NetErr( .T. )
RETURN .F.
ENDIF
-
oServer:LogError( GetErrorDesc( oErr ) )
+ IF oErr != NIL // Dummy check to avoid unreachable code warning for RETURN NIL
+ BREAK( oErr )
+ ENDIF
- RETURN .T.
+ RETURN NIL
STATIC FUNCTION GetErrorDesc( oErr )
- LOCAL cRet, nI
+ LOCAL cRet, nI, cI, aPar, nJ, xI
cRet := "ERRORLOG ============================================================" + hb_eol() + ;
"Error: " + oErr:subsystem + "/" + ErrDescCode( oErr:genCode ) + "(" + hb_ntos( oErr:genCode ) + ") " + ;
@@ -687,15 +993,37 @@ STATIC FUNCTION GetErrorDesc( oErr )
ENDIF
IF hb_isArray( oErr:args )
cRet += "Arguments:" + hb_eol()
- AEval( oErr:args, {|X, Y| cRet += Str( Y, 5 ) + ": " + HB_CStr( X ) + hb_eol() } )
+ AEval( oErr:args, {| X, Y | cRet += Str( Y, 5 ) + ": " + HB_CStr( X ) + hb_eol() } )
ENDIF
cRet += hb_eol()
cRet += "Stack:" + hb_eol()
nI := 2
- DO WHILE ! Empty( ProcName( ++ nI ) )
+#if 0
+ DO WHILE ! Empty( ProcName( ++nI ) )
cRet += " " + ProcName( nI ) + "(" + hb_ntos( ProcLine( nI ) ) + ")" + hb_eol()
ENDDO
+#else
+ DO WHILE ! Empty( ProcName( ++nI ) )
+ cI := " " + ProcName( nI ) + "(" + hb_ntos( ProcLine( nI ) ) + ")"
+ cI := PadR( cI, Max( 32, Len( cI ) + 1 ) )
+ cI += "("
+ aPar := __dbgvmParLList( nI )
+ FOR nJ := 1 TO Len( aPar )
+ cI += cvt2str( aPar[nJ] )
+ IF nJ < Len( aPar )
+ cI += ", "
+ ENDIF
+ NEXT
+ cI += ")"
+ nJ := Len( aPar )
+ DO WHILE !( ValType( xI := __dbgvmVarLGet( nI, ++nJ ) ) == "S" )
+ cI += ", " + cvt2str( xI )
+ ENDDO
+ xI := NIL
+ cRet += cI + hb_eol()
+ ENDDO
+#endif
cRet += hb_eol()
cRet += "Executable: " + HB_PROGNAME() + hb_eol()
@@ -708,13 +1036,13 @@ STATIC FUNCTION GetErrorDesc( oErr )
cRet += "Database areas:" + hb_eol()
cRet += " Current: " + hb_ntos( Select() ) + " " + Alias() + hb_eol()
- BEGIN SEQUENCE WITH {|o| BREAK( o ) }
- IF !Empty( Alias() )
+ BEGIN SEQUENCE WITH {| o | BREAK( o ) }
+ IF Used()
cRet += " Filter: " + dbFilter() + hb_eol()
cRet += " Relation: " + dbRelation() + hb_eol()
cRet += " Index expression: " + OrdKey( OrdSetFocus() ) + hb_eol()
cRet += hb_eol()
- BEGIN SEQUENCE WITH {|o| BREAK( o ) }
+ BEGIN SEQUENCE WITH {| o | BREAK( o ) }
FOR nI := 1 TO FCount()
cRet += Str( nI, 6 ) + " " + PadR( FieldName( nI ), 14 ) + ": " + HB_VALTOEXP( FieldGet( nI ) ) + hb_eol()
NEXT
@@ -728,8 +1056,8 @@ STATIC FUNCTION GetErrorDesc( oErr )
END SEQUENCE
FOR nI := 1 TO 250
- BEGIN SEQUENCE WITH {|o| BREAK( o ) }
- IF ! Empty( Alias( nI ) )
+ BEGIN SEQUENCE WITH {| o | BREAK( o ) }
+ IF Used()
dbSelectArea( nI )
cRet += Str( nI, 6 ) + " " + rddName() + " " + PadR( Alias(), 15 ) + ;
Str( RecNo() ) + "/" + Str( LastRec() ) + ;
@@ -750,17 +1078,69 @@ STATIC FUNCTION ErrDescCode( nCode )
LOCAL cI := NIL
IF nCode > 0 .AND. nCode <= 41
- cI := {;
- "ARG" , "BOUND" , "STROVERFLOW", "NUMOVERFLOW", "ZERODIV" , "NUMERR" , "SYNTAX" , "COMPLEXITY" , ; // 1, 2, 3, 4, 5, 6, 7, 8
- NIL , NIL , "MEM" , "NOFUNC" , "NOMETHOD", "NOVAR" , "NOALIAS" , "NOVARMETHOD", ; // 9, 10, 11, 12, 13, 14, 15, 16
- "BADALIAS", "DUPALIAS" , NIL , "CREATE" , "OPEN" , "CLOSE" , "READ" , "WRITE" , ; // 17, 18, 19, 20, 21, 22, 23, 24
- "PRINT" , NIL , NIL , NIL , NIL , "UNSUPPORTED", "LIMIT" , "CORRUPTION" , ; // 25, 26 - 29, 30, 31, 32
- "DATATYPE", "DATAWIDTH", "NOTABLE" , "NOORDER" , "SHARED" , "UNLOCKED" , "READONLY", "APPENDLOCK" , ; // 33, 34, 35, 36, 37, 38, 39, 40
- "LOCK" }[ nCode ] // 41
+ cI := { "ARG" , "BOUND" , "STROVERFLOW", "NUMOVERFLOW", "ZERODIV" , "NUMERR" , "SYNTAX" , "COMPLEXITY" , ; // 1, 2, 3, 4, 5, 6, 7, 8
+ NIL , NIL , "MEM" , "NOFUNC" , "NOMETHOD", "NOVAR" , "NOALIAS" , "NOVARMETHOD", ; // 9, 10, 11, 12, 13, 14, 15, 16
+ "BADALIAS", "DUPALIAS" , NIL , "CREATE" , "OPEN" , "CLOSE" , "READ" , "WRITE" , ; // 17, 18, 19, 20, 21, 22, 23, 24
+ "PRINT" , NIL , NIL , NIL , NIL , "UNSUPPORTED", "LIMIT" , "CORRUPTION" , ; // 25, 26 - 29, 30, 31, 32
+ "DATATYPE", "DATAWIDTH", "NOTABLE" , "NOORDER" , "SHARED" , "UNLOCKED" , "READONLY", "APPENDLOCK" , ; // 33, 34, 35, 36, 37, 38, 39, 40
+ "LOCK" }[nCode] // 41
ENDIF
RETURN iif( cI == NIL, "", "EG_" + cI )
+STATIC FUNCTION cvt2str( xI, lLong )
+
+ LOCAL cValtype, cI, xJ
+
+ cValtype := ValType( xI )
+ lLong := ! Empty( lLong )
+ IF cValtype == "U"
+ RETURN iif( lLong, "[U]:NIL", "NIL" )
+ ELSEIF cValtype == "N"
+ RETURN iif( lLong, "[N]:" + Str( xI ), hb_ntos( xI ) )
+ ELSEIF cValtype $ "CM"
+ IF Len( xI ) <= 260
+ RETURN iif( lLong, "[" + cValtype + hb_ntos( Len( xI ) ) + "]:", "" ) + '"' + xI + '"'
+ ELSE
+ RETURN iif( lLong, "[" + cValtype + hb_ntos( Len( xI ) ) + "]:", "" ) + '"' + Left( xI, 100 ) + '"...'
+ ENDIF
+ ELSEIF cValtype == "A"
+ RETURN "[A" + hb_ntos( Len( xI ) ) + "]"
+ ELSEIF cValtype == "H"
+ RETURN "[H" + hb_ntos( Len( xI ) ) + "]"
+ ELSEIF cValtype == "O"
+ cI := ""
+ IF __objHasMsg( xI, "ID" )
+ xJ := xI:ID
+ IF ! hb_isObject( xJ )
+ cI += ",ID=" + cvt2str( xJ )
+ ENDIF
+ ENDIF
+ IF __objHasMsg( xI, "nID" )
+ xJ := xI:nID
+ IF ! hb_isObject( xJ )
+ cI += ",NID=" + cvt2str( xJ )
+ ENDIF
+ ENDIF
+ IF __objHasMsg( xI, "xValue" )
+ xJ := xI:xValue
+ IF ! hb_isObject( xJ )
+ cI += ",XVALUE=" + cvt2str( xJ )
+ ENDIF
+ ENDIF
+ RETURN "[O:" + xI:ClassName + cI + "]"
+ ELSEIF cValtype == "D"
+ RETURN iif( lLong, "[D]:", "" ) + DToC( xI )
+ ELSEIF cValtype == "L"
+ RETURN iif( lLong, "[L]:", "" ) + iif( xI, ".T.", ".F." )
+ ELSEIF cValtype == "P"
+ RETURN iif( lLong, "[P]:", "" ) + "0p" + HB_NumToHex( xI )
+ ELSE
+ RETURN "[" + cValtype + "]" // BS,etc
+ ENDIF
+
+ RETURN NIL
+
/********************************************************************
Public functions
@@ -776,8 +1156,8 @@ FUNCTION UGetHeader( cType )
LOCAL nI
- IF ( nI := AScan( t_aHeader, {|x| Upper( x[ 1 ] ) == Upper( cType ) } ) ) > 0
- RETURN t_aHeader[ nI, 2 ]
+ IF ( nI := AScan( t_aHeader, {| x | Upper(x[1] ) == Upper(cType ) } ) ) > 0
+ RETURN t_aHeader[nI, 2]
ENDIF
RETURN NIL
@@ -786,8 +1166,8 @@ PROCEDURE UAddHeader( cType, cValue )
LOCAL nI
- IF ( nI := AScan( t_aHeader, {|x| Upper( x[ 1 ] ) == Upper( cType ) } ) ) > 0
- t_aHeader[ nI, 2 ] := cValue
+ IF ( nI := AScan( t_aHeader, {| x | Upper(x[1] ) == Upper(cType ) } ) ) > 0
+ t_aHeader[nI, 2] := cValue
ELSE
AAdd( t_aHeader, { cType, cValue } )
ENDIF
@@ -804,21 +1184,108 @@ PROCEDURE URedirect( cURL, nCode )
RETURN
-PROCEDURE USessionDestroy()
-
- t_lSessionDestroy := .T.
-
- RETURN
-
PROCEDURE UWrite( cString )
t_cResult += cString
RETURN
+STATIC PROCEDURE USessionCreateInternal()
+
+ LOCAL cSID, hMtx
+
+ cSID := HB_MD5( DToS( Date() ) + Time() + Str( HB_RANDOM(), 15, 12 ) )
+ hMtx := hb_mutexCreate()
+ hb_mutexLock( hMtx )
+ t_aSessionData := httpd:hSession[cSID] := { hMtx, { "_unique" => HB_MD5( Str( HB_RANDOM(), 15, 12 ) ) }, HB_MILLISECONDS() + SESSION_TIMEOUT * 1000, cSID }
+ session := t_aSessionData[2]
+ UAddHeader( "Set-Cookie", "SESSID=" + cSID + "; path=/" )
+
+ RETURN
+
+STATIC PROCEDURE USessionDestroyInternal()
+
+ HB_HDel( httpd:hSession, t_aSessionData[4] )
+ hb_mutexUnlock( t_aSessionData[1] )
+ UAddHeader( "Set-Cookie", "SESSID=" + t_aSessionData[4] + "; path=/; Max-Age=0" )
+
+ RETURN
+
+PROCEDURE USessionStart()
+
+ LOCAL cSID
+
+ IF HB_HHasKey( cookie, "SESSID" )
+ cSID := cookie["SESSID"]
+ ENDIF
+
+ hb_mutexLock( httpd:hmtxSession )
+ IF cSID == NIL .OR. ! HB_HHasKey( httpd:hSession, cSID )
+ // Session does not exist
+ USessionCreateInternal()
+ ELSE
+
+ // Session exists
+ t_aSessionData := httpd:hSession[cSID]
+ IF hb_mutexLock( t_aSessionData[1], 0 )
+
+ // No concurent sessions
+ IF t_aSessionData[3] > HB_MILLISECONDS()
+ t_aSessionData[3] := HB_MILLISECONDS() + SESSION_TIMEOUT * 1000
+ session := t_aSessionData[2]
+ ELSE
+ USessionDestroyInternal()
+ USessionCreateInternal()
+ ENDIF
+ ELSE
+
+ // Concurent process exists
+ hb_mutexUnlock( httpd:hmtxSession )
+
+ // Wait for session
+ hb_mutexLock( t_aSessionData[1] )
+
+ // Check if session is not destroyed
+ hb_mutexLock( httpd:hmtxSession )
+ IF HB_HHasKey( httpd:hSession, cSID )
+ // Session exists
+ IF t_aSessionData[3] > HB_MILLISECONDS()
+ t_aSessionData[3] := HB_MILLISECONDS() + SESSION_TIMEOUT * 1000
+ session := t_aSessionData[2]
+ ELSE
+ USessionDestroyInternal()
+ USessionCreateInternal()
+ ENDIF
+ ELSE
+ // Session was destroyed by concurent process
+ USessionCreateInternal()
+ ENDIF
+ ENDIF
+ ENDIF
+ hb_mutexUnlock( httpd:hmtxSession )
+
+ RETURN
+
+PROCEDURE USessionStop()
+
+ session := NIL
+ hb_mutexUnlock( t_aSessionData[1] )
+ t_aSessionData := NIL
+
+ RETURN
+
+PROCEDURE USessionDestroy()
+
+ hb_mutexLock( httpd:hmtxSession )
+ USessionDestroyInternal()
+ USessionStop()
+ hb_mutexUnlock( httpd:hmtxSession )
+
+ RETURN
+
FUNCTION UOsFileName( cFileName )
- IF hb_ps() != "/"
+ IF !( hb_ps() == "/" )
RETURN StrTran( cFileName, "/", hb_ps() )
ENDIF
@@ -874,7 +1341,7 @@ FUNCTION UUrlDecode( cString )
EXIT
ENDIF
IF Upper( SubStr( cString, nI + 1, 1 ) ) $ "0123456789ABCDEF" .AND. ;
- Upper( SubStr( cString, nI + 2, 1 ) ) $ "0123456789ABCDEF"
+ Upper( SubStr( cString, nI + 2, 1 ) ) $ "0123456789ABCDEF"
cString := Stuff( cString, nI, 3, HB_HexToStr( SubStr(cString, nI + 1, 2 ) ) )
ENDIF
nI++
@@ -882,9 +1349,26 @@ FUNCTION UUrlDecode( cString )
RETURN cString
-FUNCTION ULink( cText, cURL )
+FUNCTION ULink( cText, cUrl )
- RETURN '' + UHtmlEncode( cText ) + ' '
+ RETURN '' + UHtmlEncode( cText ) + ' '
+
+FUNCTION UUrlCheckSum( cUrl )
+
+ RETURN cUrl + iif( "?" $ cUrl, "&", "?" ) + "_ucs=" + HB_MD5( session["_unique"] + cUrl + session["_unique"] )
+
+FUNCTION UUrlValidate( cUrl )
+
+ LOCAL nI
+
+ IF cUrl == NIL
+ cUrl := server["REQUEST_URI"]
+ ENDIF
+ IF ( nI := At( "?_ucs=", cUrl ) ) == 0
+ nI := At( "&_ucs=", cUrl )
+ ENDIF
+
+ RETURN HB_MD5( session["_unique"] + Left( cUrl, nI - 1 ) + session["_unique"] ) == SubStr( cUrl, nI + 6 )
PROCEDURE UProcFiles( cFileName, lIndex )
@@ -903,13 +1387,13 @@ PROCEDURE UProcFiles( cFileName, lIndex )
ENDIF
IF HB_FileExists( uOSFileName( cFileName ) )
- IF "HTTP_IF_MODIFIED_SINCE" $ server .AND. ;
- HttpDateUnformat( server[ "HTTP_IF_MODIFIED_SINCE" ], @tHDate ) .AND. ;
+ IF HB_HHasKey( server, "HTTP_IF_MODIFIED_SINCE" ) .AND. ;
+ HttpDateUnformat( server["HTTP_IF_MODIFIED_SINCE"], @tHDate ) .AND. ;
HB_FGETDATETIME( UOsFileName( cFileName ), @tDate ) .AND. ;
( tDate <= tHDate )
USetStatusCode( 304 )
- ELSEIF "HTTP_IF_UNMODIFIED_SINCE" $ server .AND. ;
- HttpDateUnformat( server[ "HTTP_IF_UNMODIFIED_SINCE" ], @tHDate ) .AND. ;
+ ELSEIF HB_HHasKey( server, "HTTP_IF_UNMODIFIED_SINCE" ) .AND. ;
+ HttpDateUnformat( server["HTTP_IF_UNMODIFIED_SINCE"], @tHDate ) .AND. ;
HB_FGETDATETIME( UOsFileName( cFileName ), @tDate ) .AND. ;
( tDate > tHDate )
USetStatusCode( 412 )
@@ -963,11 +1447,11 @@ PROCEDURE UProcFiles( cFileName, lIndex )
ENDIF
ELSEIF HB_DirExists( UOsFileName( cFileName ) )
IF Right( cFileName, 1 ) != "/"
- URedirect( "http://" + server[ "HTTP_HOST" ] + server[ "SCRIPT_NAME" ] + "/" )
+ URedirect( "http://" + server["HTTP_HOST"] + server["SCRIPT_NAME"] + "/" )
RETURN
ENDIF
IF AScan( { "index.html", "index.htm" }, ;
- {|x| iif( HB_FileExists( UOSFileName(cFileName + X ) ), ( cFileName += X, .T. ), .F. ) } ) > 0
+ {| x | iif( HB_FileExists( UOSFileName(cFileName + X ) ), ( cFileName += X, .T. ), .F. ) } ) > 0
UAddHeader( "Content-Type", "text/html" )
UWrite( HB_MEMOREAD( UOsFileName(cFileName ) ) )
RETURN
@@ -980,34 +1464,34 @@ PROCEDURE UProcFiles( cFileName, lIndex )
UAddHeader( "Content-Type", "text/html" )
aDir := Directory( UOsFileName( cFileName ), "D" )
- IF "s" $ get
- IF get[ "s" ] == "s"
- ASort( aDir, , , {|X, Y| iif( X[ 5 ] == "D", iif( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ;
- iif( Y[ 5 ] == "D", .F. , X[ 2 ] < Y[ 2 ] ) ) } )
- ELSEIF get[ "s" ] == "m"
- ASort( aDir, , , {|X, Y| iif( X[ 5 ] == "D", iif( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ;
- iif( Y[ 5 ] == "D", .F. , DToS( X[ 3 ] ) + X[ 4 ] < DToS( Y[ 3 ] ) + Y[ 4 ] ) ) } )
+ IF HB_HHasKey( get, "s" )
+ IF get["s"] == "s"
+ ASort( aDir, , , {| X, Y | iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+ iif( Y[5] == "D", .F. , X[2] < Y[2] ) ) } )
+ ELSEIF get["s"] == "m"
+ ASort( aDir, , , {| X, Y | iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+ iif( Y[5] == "D", .F. , DToS( X[3] ) + X[4] < DToS( Y[3] ) + Y[4] ) ) } )
ELSE
- ASort( aDir, , , {|X, Y| iif( X[ 5 ] == "D", iif( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ;
- iif( Y[ 5 ] == "D", .F. , X[ 1 ] < Y[ 1 ] ) ) } )
+ ASort( aDir, , , {| X, Y | iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+ iif( Y[5] == "D", .F. , X[1] < Y[1] ) ) } )
ENDIF
ELSE
- ASort( aDir, , , {|X, Y| iif( X[ 5 ] == "D", iif( Y[ 5 ] == "D", X[ 1 ] < Y[ 1 ], .T. ), ;
- iif( Y[ 5 ] == "D", .F. , X[ 1 ] < Y[ 1 ] ) ) } )
+ ASort( aDir, , , {| X, Y | iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+ iif( Y[5] == "D", .F. , X[1] < Y[1] ) ) } )
ENDIF
- UWrite( 'Index of ' + server[ "SCRIPT_NAME" ] + ' ' )
+ UWrite( 'Index of ' + server["SCRIPT_NAME"] + ' ' )
UWrite( 'Name ' )
UWrite( 'Modified ' )
UWrite( 'Size ' + CR_LF + '' + aF[ 1 ] + ' ' + Space( 50 - Len( aF[ 1 ] ) ) + ;
- DToC( aF[ 3 ] ) + ' ' + aF[ 4 ] + CR_LF )
+ IF Left( aF[1], 1 ) == "."
+ ELSEIF "D" $ aF[5]
+ UWrite( '[DIR] ' + aF[1] + ' ' + Space( 50 - Len(aF[1] ) ) + ;
+ DToC( aF[3] ) + ' ' + aF[4] + CR_LF )
ELSE
- UWrite( ' ' + aF[ 1 ] + ' ' + Space( 50 - Len( aF[ 1 ] ) ) + ;
- DToC( aF[ 3 ] ) + ' ' + aF[ 4 ] + Str( aF[ 2 ], 12 ) + CR_LF )
+ UWrite( ' ' + aF[1] + ' ' + Space( 50 - Len(aF[1] ) ) + ;
+ DToC( aF[3] ) + ' ' + aF[4] + Str( aF[2], 12 ) + CR_LF )
ENDIF
NEXT
UWrite( " " )
@@ -1019,6 +1503,8 @@ PROCEDURE UProcFiles( cFileName, lIndex )
PROCEDURE UProcInfo()
+ LOCAL cI
+
UWrite( 'Info ' )
UWrite( 'Platform ' )
@@ -1031,61 +1517,238 @@ PROCEDURE UProcInfo()
UWrite( 'Capabilities ' )
UWrite( ' ' )
- UWrite( 'RDD ' + UHtmlEncode( uhttpd_join( ", ", rddList() ) ) + ' RDD ' + UHtmlEncode( cI ) + '
' )
UWrite( 'Variables ' )
UWrite( 'server ' )
UWrite( '' )
- HB_HEval( server, {|k, v| UWrite( '' + k + ' ' + UHtmlEncode( HB_CStr(v ) ) + ' ' + X + ' ' + UHtmlEncode( HB_CStr( server[X] ) ) + '
' )
IF !Empty( get )
UWrite( 'get ' )
UWrite( '' )
- HB_HEval( get, {|k, v| UWrite( '' + k + ' ' + UHtmlEncode( HB_CStr(v ) ) + ' ' + X + ' ' + UHtmlEncode( HB_CStr( get[X] ) ) + '
' )
ENDIF
IF !Empty( post )
UWrite( 'post ' )
UWrite( '' )
- HB_HEval( post, {|k, v| UWrite( '' + k + ' ' + UHtmlEncode( HB_CStr(v ) ) + ' ' + X + ' ' + UHtmlEncode( HB_CStr( post[X] ) ) + '
' )
ENDIF
RETURN
-FUNCTION uhttpd_split( cSeparator, cString )
+FUNCTION UParse( aData, cFileName, hConfig )
- LOCAL aRet := {}
- LOCAL nI
+ RETURN parse_data( aData, compile_file( cFileName, hConfig ), hConfig )
- DO WHILE ( nI := At( cSeparator, cString ) ) > 0
- AAdd( aRet, Left( cString, nI - 1 ) )
- cString := SubStr( cString, nI + Len( cSeparator ) )
+STATIC FUNCTION parse_data( aData, aCode, hConfig )
+
+ LOCAL aInstr, aData2, cRet, xValue, aValue, cExtend := ""
+
+ DO WHILE cExtend != NIL
+ cExtend := NIL
+ cRet := ""
+ FOR EACH aInstr IN aCode
+ SWITCH aInstr[1]
+ CASE "txt"
+ cRet += aInstr[2]
+ EXIT
+
+ CASE "="
+ IF HB_HHasKey( aData, aInstr[2] )
+ xValue := aData[aInstr[2]]
+ IF HB_ISCHAR( xValue )
+ cRet += UHtmlEncode( xValue )
+ ELSEIF HB_ISNUMERIC( xValue )
+ cRet += UHtmlEncode( Str( xValue ) )
+ ELSEIF HB_ISDATE( xValue )
+ cRet += UHtmlEncode( DToC( xValue ) )
+ ELSEIF HB_ISTIMESTAMP( xValue )
+ cRet += UHtmlEncode( HB_TTOC( xValue ) )
+ ELSEIF HB_ISOBJECT( xValue )
+ cRet += UHtmlEncode( xValue:Output() )
+ ELSE
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: invalid type '%s'", ValType( xValue ) ) )
+ ENDIF
+ ELSE
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: variable '%s' not found", aInstr[2] ) )
+ ENDIF
+ EXIT
+
+ CASE ":"
+ IF HB_HHasKey( aData, aInstr[2] )
+ xValue := aData[aInstr[2]]
+ IF HB_ISCHAR( xValue )
+ cRet += xValue
+ ELSEIF HB_ISNUMERIC( xValue )
+ cRet += Str( xValue )
+ ELSEIF HB_ISDATE( xValue )
+ cRet += DToC( xValue )
+ ELSEIF HB_ISTIMESTAMP( xValue )
+ cRet += HB_TTOC( xValue )
+ ELSEIF HB_ISOBJECT( xValue )
+ cRet += xValue:Output()
+ ELSE
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: invalid type '%s'", ValType( xValue ) ) )
+ ENDIF
+ ELSE
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: variable '%s' not found", aInstr[2] ) )
+ ENDIF
+ EXIT
+
+ CASE "if"
+ xValue := iif( HB_HHasKey( aData, aInstr[2] ), aData[aInstr[2]], NIL )
+ IF ! Empty( xValue )
+ cRet += parse_data( aData, aInstr[3], hConfig )
+ ELSE
+ cRet += parse_data( aData, aInstr[4], hConfig )
+ ENDIF
+ EXIT
+
+ CASE "loop"
+ IF HB_HHasKey( aData, aInstr[2] ) .AND. hb_isArray( aValue := aData[aInstr[2]] )
+ FOR EACH xValue IN aValue
+ aData2 := HB_HCLONE( aData )
+ HB_HEVAL( xValue, {| k, v | aData2[aInstr[2] + "." + k] := v } )
+ aData2[aInstr[2] + ".__index"] := xValue:__enumIndex
+ cRet += parse_data( aData2, aInstr[3], hConfig )
+ aData2 := NIL
+ NEXT
+ ELSE
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: loop variable '%s' not found", aInstr[2] ) )
+ ENDIF
+ EXIT
+
+ CASE "extend"
+ cExtend := aInstr[2]
+ EXIT
+
+ CASE "include"
+ cRet += parse_data( aData, compile_file( aInstr[2], hConfig ), hConfig )
+ EXIT
+ ENDSWITCH
+ NEXT
+ IF cExtend != NIL
+ aData[""] := cRet
+ cRet := ""
+ aCode := compile_file( cExtend, hConfig )
+ ENDIF
ENDDO
- AAdd( aRet, cString )
-
- RETURN aRet
-
-FUNCTION uhttpd_join( cSeparator, aData )
-
- LOCAL cRet := ""
- LOCAL 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 += hb_ntos( aData[ nI ] )
- ELSEIF ValType( aData[ nI ] ) == "D" ; cRet += iif( Empty( aData[ nI ] ), "", DToC( aData[ nI ] ) )
- ELSE
- ENDIF
- NEXT
RETURN cRet
+
+STATIC FUNCTION compile_file( cFileName, hConfig )
+
+ LOCAL nPos, cTpl, aCode := {}
+
+ IF cFileName == NIL
+ cFileName := MEMVAR->server["SCRIPT_NAME"]
+ ENDIF
+ cFileName := UOsFileName( HB_DIRBASE() + "/tpl/" + cFileName + ".tpl" )
+ IF HB_FILEEXISTS( cFileName )
+ cTpl := HB_MEMOREAD( cFileName )
+ BEGIN SEQUENCE
+ IF ( nPos := compile_buffer( cTpl, 1, aCode ) ) < Len( cTpl ) + 1
+ BREAK( nPos )
+ ENDIF
+ RECOVER USING nPos
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: syntax at %s(%d,%d)", cFileName, SUBSTRCOUNT( Chr(10 ), cTpl,, nPos ) + 1, nPos - HB_RAT( Chr(10 ), Left(cTpl, nPos - 1 ) ) ) )
+ aCode := {}
+ END SEQUENCE
+ ELSE
+ Eval( hConfig[ "Trace" ], HB_STRFORMAT( "Template error: file '%s' not found", cFileName ) )
+ ENDIF
+
+ RETURN aCode
+
+STATIC FUNCTION compile_buffer( cTpl, nStart, aCode )
+
+ LOCAL nI, nS, nE, cTag, cParam
+
+ DO WHILE ( nS := HB_AT( "{{", cTpl, nStart ) ) > 0
+ IF nS > nStart
+ AAdd( aCode, { "txt", SubStr( cTpl, nStart, nS - nStart ) } )
+ ENDIF
+ nE := HB_AT( "}}", cTpl, nS )
+ IF nE > 0
+ IF ( nI := HB_AT( " ", cTpl, nS, nE ) ) == 0
+ nI := nE
+ ENDIF
+ cTag := SubStr( cTpl, nS + 2, nI - nS - 2 )
+ cParam := SubStr( cTpl, nI + 1, nE - nI - 1 )
+
+ SWITCH cTag
+ CASE "="
+ CASE ":"
+ AAdd( aCode, { cTag, cParam } )
+ nStart := nE + 2
+ EXIT
+
+ CASE "if"
+ AAdd( aCode, { "if", cParam, {}, {} } )
+ nI := compile_buffer( cTpl, nE + 2, ATAIL( aCode )[3] )
+ IF SubStr( cTpl, nI, 8 ) == "{{else}}"
+ nI := compile_buffer( cTpl, nI + 8, ATAIL( aCode )[4] )
+ ENDIF
+ IF SubStr( cTpl, nI, 9 ) == "{{endif}}"
+ nStart := nI + 9
+ ELSE
+ BREAK( nI )
+ ENDIF
+ EXIT
+
+ CASE "loop"
+ AAdd( aCode, { "loop", cParam, {} } )
+ nI := compile_buffer( cTpl, nE + 2, ATAIL( aCode )[3] )
+ IF SubStr( cTpl, nI, 11 ) == "{{endloop}}"
+ nStart := nI + 11
+ ELSE
+ BREAK( nI )
+ ENDIF
+ EXIT
+
+ CASE "extend"
+ AAdd( aCode, { "extend", cParam } )
+ nStart := nE + 2
+ EXIT
+
+ CASE "include"
+ AAdd( aCode, { "include", cParam } )
+ nStart := nE + 2
+ EXIT
+
+ OTHERWISE
+ RETURN nS
+
+ ENDSWITCH
+ ELSE
+ BREAK( nS )
+ ENDIF
+ ENDDO
+ IF nStart < Len( cTpl )
+ AAdd( aCode, { "txt", SubStr( cTpl, nStart ) } )
+ ENDIF
+
+ RETURN Len( cTpl ) + 1
+
+STATIC FUNCTION SUBSTRCOUNT( cSub, cString, nStart, nEnd )
+
+ LOCAL nCount := 0
+
+ IF nStart == NIL
+ nStart := 1
+ ENDIF
+ DO WHILE ( nStart := HB_AT( cSub, cString, nStart, nEnd ) ) > 0
+ nCount++
+ nStart++
+ ENDDO
+
+ RETURN nCount
diff --git a/harbour/contrib/hbhttpd/hbhttpd.hbc b/harbour/contrib/hbhttpd/hbhttpd.hbc
index bb118e4019..84a48a2a9d 100644
--- a/harbour/contrib/hbhttpd/hbhttpd.hbc
+++ b/harbour/contrib/hbhttpd/hbhttpd.hbc
@@ -4,6 +4,8 @@
incpaths=.
-libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}
+{!HB_HTTPD_OPENSSL|dos}libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}
+{HB_HTTPD_OPENSSL&!dos}libs=${_HB_DYNPREF}${hb_name}s${_HB_DYNSUFF}
+{HB_HTTPD_OPENSSL&!dos}libs=../hbssl/hbssl.hbc
mt=yes
diff --git a/harbour/contrib/hbhttpd/hbhttpd.hbp b/harbour/contrib/hbhttpd/hbhttpd.hbp
index 956385629f..f393a0adcc 100644
--- a/harbour/contrib/hbhttpd/hbhttpd.hbp
+++ b/harbour/contrib/hbhttpd/hbhttpd.hbp
@@ -5,7 +5,7 @@
-hblib
-inc
--o${hb_name}
+-o${hb_targetname}
-w3 -es2
@@ -16,3 +16,5 @@ hbhttpd.hbx
core.prg
widgets.prg
log.prg
+
+hbssl.hbc
diff --git a/harbour/contrib/hbhttpd/hbhttpd.hbx b/harbour/contrib/hbhttpd/hbhttpd.hbx
index c3b9a923af..acf8d1e322 100644
--- a/harbour/contrib/hbhttpd/hbhttpd.hbx
+++ b/harbour/contrib/hbhttpd/hbhttpd.hbx
@@ -32,18 +32,21 @@ DYNAMIC UHTMLENCODE
DYNAMIC UHTTPD
DYNAMIC UHTTPDLOG
DYNAMIC UHTTPDNEW
-DYNAMIC UHTTPD_JOIN
-DYNAMIC UHTTPD_SPLIT
DYNAMIC ULINK
DYNAMIC UOSFILENAME
+DYNAMIC UPARSE
DYNAMIC UPROCFILES
DYNAMIC UPROCINFO
DYNAMIC UPROCWIDGETS
DYNAMIC UREDIRECT
DYNAMIC USESSIONDESTROY
+DYNAMIC USESSIONSTART
+DYNAMIC USESSIONSTOP
DYNAMIC USETSTATUSCODE
+DYNAMIC UURLCHECKSUM
DYNAMIC UURLDECODE
DYNAMIC UURLENCODE
+DYNAMIC UURLVALIDATE
DYNAMIC UWBROWSE
DYNAMIC UWBROWSENEW
DYNAMIC UWDEFAULTHANDLER
@@ -61,6 +64,8 @@ DYNAMIC UWMAIN
DYNAMIC UWMAINNEW
DYNAMIC UWMENU
DYNAMIC UWMENUNEW
+DYNAMIC UWOPTION
+DYNAMIC UWOPTIONNEW
DYNAMIC UWPASSWORD
DYNAMIC UWPASSWORDNEW
DYNAMIC UWRITE
diff --git a/harbour/contrib/hbhttpd/hbhttpds.hbc b/harbour/contrib/hbhttpd/hbhttpds.hbc
new file mode 100644
index 0000000000..029395ded2
--- /dev/null
+++ b/harbour/contrib/hbhttpd/hbhttpds.hbc
@@ -0,0 +1,11 @@
+#
+# $Id$
+#
+
+incpaths=.
+
+libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}
+
+mt=yes
+
+libs=../hbssl/hbssl.hbc
diff --git a/harbour/contrib/hbhttpd/hbhttpds.hbp b/harbour/contrib/hbhttpd/hbhttpds.hbp
new file mode 100644
index 0000000000..847a9e86f4
--- /dev/null
+++ b/harbour/contrib/hbhttpd/hbhttpds.hbp
@@ -0,0 +1,9 @@
+#
+# $Id$
+#
+
+@hbhttpd.hbp
+
+../hbssl/hbssl.hbc
+
+-DHB_HAS_OPENSSL
diff --git a/harbour/contrib/hbhttpd/tests/eshop.prg b/harbour/contrib/hbhttpd/tests/eshop.prg
new file mode 100644
index 0000000000..3355593470
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/eshop.prg
@@ -0,0 +1,388 @@
+/*
+ * $Id$
+ */
+
+REQUEST DBFCDX
+
+MEMVAR server, get, post, cookie, session
+
+PROCEDURE Main()
+
+ LOCAL oServer
+
+ LOCAL oLogAccess
+ LOCAL oLogError
+
+ LOCAL nPort
+
+ IF HB_ARGCHECK( "help" )
+ ? "Usage: app [options]"
+ ? "Options:"
+ ? " //help Print help"
+ ? " //stop Stop running server"
+ RETURN
+ ENDIF
+
+ IF HB_ARGCHECK( "stop" )
+ HB_MEMOWRIT( ".uhttpd.stop", "" )
+ RETURN
+ ELSE
+ FErase( ".uhttpd.stop" )
+ ENDIF
+
+ rddSetDefault( "DBFCDX" )
+ SET( _SET_DATEFORMAT, "yyyy-mm-dd" )
+
+
+ IF ! HB_FILEEXISTS( "users.dbf" )
+ FErase( "users.cdx" )
+ dbCreate( "users", { { "USER", "C", 16, 0 }, { "PASSWORD", "C", 16, 0 }, { "NAME", "C", 50, 0 } }, , .T. , "user" )
+ dbAppend()
+ FIELD->USER := "demo"
+ FIELD->PASSWORD := "demo"
+ FIELD->NAME := "Demo"
+ OrdCreate( "users", "user", "USER" )
+ dbCloseArea()
+ ELSEIF ! HB_FILEEXISTS( "users.cdx" )
+ dbUseArea( .T. , , "users", , .F. , .F. )
+ OrdCreate( "users", "user", "USER" )
+ dbCloseArea()
+ ENDIF
+
+ IF ! HB_FILEEXISTS( "carts.dbf" )
+ FErase( "carts.cdx" )
+ dbCreate( "carts", { { "USER", "C", 16, 0 }, { "CODE", "C", 16, 0 }, { "AMOUNT", "N", 6, 0 }, { "TOTAL", "N", 9, 2 } }, , .T. , "cart" )
+ OrdCreate( "carts", "user", "USER+CODE" )
+ dbCloseArea()
+ ELSEIF ! HB_FILEEXISTS( "carts.cdx" )
+ dbUseArea( .T. , , "carts", , .F. , .F. )
+ OrdCreate( "carts", "user", "USER+CODE" )
+ dbCloseArea()
+ ENDIF
+
+ IF ! HB_FILEEXISTS( "items.dbf" )
+ FErase( "items.cdx" )
+ dbCreate( "items", { { "CODE", "C", 16, 0 }, { "TITLE", "C", 80, 0 }, { "PRICE", "N", 9, 2 } }, , .T. , "items" )
+ OrdCreate( "items", "code", "CODE" )
+ dbCloseArea()
+ ELSEIF ! HB_FILEEXISTS( "item.cdx" )
+ dbUseArea( .T. , , "items", , .F. , .F. )
+ OrdCreate( "items", "code", "CODE" )
+ dbCloseArea()
+ ENDIF
+
+ oLogAccess := UHttpdLog():New( "eshop_access.log" )
+
+ IF ! oLogAccess:Add( "" )
+ oLogAccess:Close()
+ ? "Access log file open error " + hb_ntos( FError() )
+ RETURN
+ ENDIF
+
+ oLogError := UHttpdLog():New( "eshop_error.log" )
+
+ IF ! oLogError:Add( "" )
+ oLogError:Close()
+ oLogAccess:Close()
+ ? "Error log file open error " + hb_ntos( FError() )
+ RETURN
+ ENDIF
+
+ ? "Listening on port:", nPort := 8002
+
+ oLogError:Add( "hello" )
+
+ oServer := UHttpdNew()
+
+ IF ! oServer:Run( {;
+ "FirewallFilter" => "", ;
+ "LogAccess" => {| m | oLogAccess:Add( m + hb_eol() ) }, ;
+ "LogError" => {| m | oLogError:Add( m + hb_eol() ) }, ;
+ "Trace" => {| ... | QOut( ... ) }, ;
+ "Port" => nPort, ;
+ "Idle" => {| o | iif( HB_FILEEXISTS( ".uhttpd.stop" ), ( FErase(".uhttpd.stop" ), o:Stop() ), NIL ) }, ;
+ "Mount" => {;
+ "/hello" => {|| UWrite( "Hello!" ) }, ;
+ "/info" => {|| UProcInfo() }, ;
+ "/files/*" => {| x | QOUT( HB_DIRBASE() + "/files/" + X ), UProcFiles( HB_DIRBASE() + "/files/" + X, .F. ) }, ;
+ "/app/login" => @proc_login(), ;
+ "/app/logout" => @proc_logout(), ;
+ "/app/account" => @proc_account(), ;
+ "/app/account/edit" => @proc_account_edit(), ;
+ "/app/register" => @proc_register(), ;
+ "/app/main" => @proc_main(), ;
+ "/app/shopping" => @proc_shopping(), ;
+ "/app/cart" => @proc_cart(), ;
+ "/" => {|| URedirect( "/app/login" ) } } } )
+ oLogError:Close()
+ oLogAccess:Close()
+ ? "Server error:", oServer:cError
+ ErrorLevel( 1 )
+ RETURN
+ ENDIF
+
+ oLogError:Close()
+ oLogAccess:Close()
+
+ RETURN
+
+STATIC FUNCTION proc_login()
+
+ LOCAL cUser
+
+ IF server["REQUEST_METHOD"] == "POST"
+ dbUseArea( .T. , , "users", "users", .T. , .T. )
+ OrdSetFocus( "user" )
+ cUser := PadR( HB_HGetDef( post, "user", "" ), 16 )
+ USessionStart()
+ IF !Empty( cUser ) .AND. dbSeek( cUser, .F. ) .AND. ! Deleted() .AND. ;
+ PadR( HB_HGetDef( post, "password", "" ), 16 ) == FIELD->PASSWORD
+ session["user"] := cUser
+ URedirect( "main" )
+ ELSE
+ URedirect( "login?err" )
+ USessionDestroy()
+ ENDIF
+ dbCloseArea()
+ ELSE
+ IF HB_HHasKey( get, "err" )
+ RETURN { "errtext" => "Invalid user name or password!" }
+ ENDIF
+ RETURN { => }
+ ENDIF
+
+ RETURN NIL
+
+STATIC FUNCTION proc_logout()
+
+ USessionStart()
+ USessionDestroy()
+
+ RETURN { => }
+
+STATIC FUNCTION proc_main()
+
+ USessionStart()
+ IF ! HB_HHasKey( session, "user" )
+ URedirect( "/app/login" )
+ RETURN NIL
+ ENDIF
+
+ RETURN { => }
+
+STATIC FUNCTION proc_shopping()
+
+ LOCAL oW, nT, cCode
+
+ USessionStart()
+ IF ! HB_HHasKey( session, "user" )
+ URedirect( "/app/login" )
+ RETURN NIL
+ ENDIF
+
+ dbUseArea( .T. , , "carts", "carts", .T. , .F. )
+ OrdSetFocus( "user" )
+ dbUseArea( .T. , , "items", "items", .T. , .T. )
+ OrdSetFocus( "code" )
+
+ IF HB_HHasKey( get, "add" )
+ cCode := PadR( get["add"], 16 )
+ IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
+ IF ! carts->( dbSeek( session["user"] + cCode ) )
+ carts->( dbAppend() )
+ carts->USER := session["user"]
+ carts->CODE := cCode
+ ENDIF
+ carts->AMOUNT += 1
+ carts->TOTAL += items->PRICE
+ carts->( dbUnlock() )
+ ENDIF
+ URedirect( "shopping" )
+ RETURN NIL
+ ENDIF
+
+ dbSelectArea( "carts" )
+ ORDSCOPE( 0, session["user"] )
+ ORDSCOPE( 1, session["user"] )
+ nT := 0
+ carts->( dbEval( { || nT += FIELD->TOTAL } ) )
+ dbSelectArea( "items" )
+ oW := UWBrowseNew( "br_item" )
+ oW:AddColumn( 101, "Item No.", "CODE" )
+ oW:AddColumn( 102, "Title", "TITLE" )
+ oW:AddColumn( 103, "Price", "PRICE" )
+ oW:AddColumn( 104, "", { || ULink( "Add to cart", "?add=" + RTrim( FIELD->CODE ) ) }, .T. )
+ oW:nPageSize := 10
+ IF HB_HHasKey( get, "_pos" )
+ oW:nPos := Val( get["_pos"] )
+ ENDIF
+
+ RETURN { "browse" => oW:Output(), "cartsum" => nT }
+
+STATIC FUNCTION proc_cart()
+
+ LOCAL oW, nT, cCode
+
+ USessionStart()
+ IF ! HB_HHasKey( session, "user" )
+ URedirect( "/app/login" )
+ RETURN NIL
+ ENDIF
+
+ dbUseArea( .T. , , "items", "items", .T. , .T. )
+ OrdSetFocus( "code" )
+ dbUseArea( .T. , , "carts", "carts", .T. , .F. )
+ OrdSetFocus( "user" )
+
+ IF HB_HHasKey( get, "del" )
+ cCode := PadR( get["del"], 16 )
+ IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
+ IF carts->( dbSeek( session["user"] + cCode ) )
+ carts->( dbDelete() )
+ carts->USER := ""
+ carts->CODE := cCode
+ ENDIF
+ carts->( dbUnlock() )
+ ENDIF
+ URedirect( "cart" )
+ RETURN NIL
+ ENDIF
+
+ ORDSCOPE( 0, session["user"] )
+ ORDSCOPE( 1, session["user"] )
+ nT := 0
+ carts->( dbEval( { || nT += FIELD->TOTAL } ) )
+
+ oW := UWBrowseNew( "br_cart" )
+ oW:AddColumn( 101, "Item No.", "CODE" )
+ oW:AddColumn( 102, "Title", { || items->( dbSeek( carts->CODE, .F. ), FIELD->TITLE ) } )
+ oW:AddColumn( 103, "Amount", "AMOUNT" )
+ oW:AddColumn( 104, "Total", "TOTAL" )
+ oW:AddColumn( 104, "", { || ULink( "Delete", "?del=" + RTrim( FIELD->CODE ) ) }, .T. )
+ oW:nPageSize := 10
+ IF HB_HHasKey( get, "_pos" )
+ oW:nPos := Val( get["_pos"] )
+ ENDIF
+
+ RETURN { "browse" => oW:Output(), "cartsum" => nT }
+
+STATIC FUNCTION proc_account()
+
+ USessionStart()
+ IF ! HB_HHasKey( session, "user" )
+ URedirect( "/app/login" )
+ RETURN NIL
+ ENDIF
+ dbUseArea( .T. , , "users", "users", .T. , .F. )
+ OrdSetFocus( "user" )
+ dbSeek( session["user"], .F. )
+
+ RETURN { "user" => users->USER, "name" => users->NAME }
+
+STATIC FUNCTION proc_account_edit()
+
+ LOCAL cName, cPassword1, cPassword2, aRet
+
+ USessionStart()
+ IF ! HB_HHasKey( session, "user" )
+ URedirect( "/app/login" )
+ RETURN NIL
+ ENDIF
+ dbUseArea( .T. , , "users", "users", .T. , .F. )
+ OrdSetFocus( "user" )
+ dbSeek( session["user"], .F. )
+
+ cName := users->NAME
+ IF HB_HHasKey( session, "formdata_account/edit" )
+ cName := session["formdata_account/edit", "name"]
+ ENDIF
+ IF server["REQUEST_METHOD"] == "POST"
+ cName := HB_HGetDef( post, "name", "" )
+ cPassword1 := HB_HGetDef( post, "password1", "" )
+ cPassword2 := HB_HGetDef( post, "password2", "" )
+ IF Empty( cName )
+ session["formdata_account/edit"] := { "name" => cName }
+ URedirect( "?err=1" )
+ ELSEIF ( ! Empty( cPassword1 ) .OR. ! Empty( cPassword2 ) ) .AND. ! ( cPassword1 == cPassword2 )
+ session["formdata_account/edit"] := { "name" => cName }
+ URedirect( "?err=2" )
+ ELSE
+ FLock()
+ FIELD->NAME := cName
+ IF ! Empty( cPassword1 )
+ FIELD->PASSWORD := cPassword1
+ ENDIF
+ dbUnlock()
+ IF HB_HHasKey( session, "formdata_account/edit" )
+ HB_HDel( session, "formdata_account/edit" )
+ ENDIF
+ URedirect( "/app/account" )
+ ENDIF
+ RETURN NIL
+ ENDIF
+
+ aRet := { "user" => users->USER, "name" => cName }
+ IF HB_HHasKey( get, "err" )
+ IF get["err"] == "1"
+ aRet["errtext"] := "Name value should not be empty!"
+ ELSEIF get["err"] == "2"
+ aRet["errtext"] := "Passwords do not match!"
+ ENDIF
+ ENDIF
+
+ RETURN aRet
+
+STATIC FUNCTION proc_register()
+
+ LOCAL cUser, cName, cPassword1, cPassword2, aRet
+
+ USessionStart()
+ cUser := ""
+ cName := ""
+ IF HB_HHasKey( session, "formdata_register" )
+ cUser := session["formdata_register", "user"]
+ cName := session["formdata_register", "name"]
+ ENDIF
+ IF server["REQUEST_METHOD"] == "POST"
+ dbUseArea( .T. , , "users", "users", .T. , .F. )
+ OrdSetFocus( "user" )
+ cUser := HB_HGetDef( post, "user", "" )
+ cName := HB_HGetDef( post, "name", "" )
+ cPassword1 := HB_HGetDef( post, "password1", "" )
+ cPassword2 := HB_HGetDef( post, "password2", "" )
+
+ IF Empty( cUser ) .OR. Empty( cName ) .OR. Empty( cPassword1 ) .OR. Empty( cPassword2 )
+ session["formdata_register"] := { "user" => cUser, "name" => cName }
+ URedirect( "?err=1" )
+ ELSEIF !( cPassword1 == cPassword2 )
+ session["formdata_register"] := { "user" => cUser, "name" => cName }
+ URedirect( "?err=2" )
+ ELSEIF dbSeek( cUser, .F. )
+ session["formdata_register"] := { "user" => cUser, "name" => cName }
+ URedirect( "?err=3" )
+ ELSE
+ FLock()
+ dbAppend()
+ FIELD->USER := cUser
+ FIELD->NAME := cName
+ FIELD->PASSWORD := cPassword1
+ dbUnlock()
+ USessionDestroy()
+ USessionStart()
+ session["user"] := cUser
+ URedirect( "/app/main" )
+ ENDIF
+ RETURN NIL
+ ENDIF
+ aRet := { "user" => cUser, "name" => cName }
+ IF HB_HHasKey( get, "err" )
+ IF get["err"] == "1"
+ aRet["errtext"] := "All fields are required!"
+ ELSEIF get["err"] == "2"
+ aRet["errtext"] := "Passwords does not match!"
+ ELSEIF get["err"] == "3"
+ aRet["errtext"] := "This user already exists!"
+ ENDIF
+ ENDIF
+
+ RETURN aRet
diff --git a/harbour/contrib/hbhttpd/tests/files/main.js b/harbour/contrib/hbhttpd/tests/files/main.js
deleted file mode 100644
index 65d0965d3c..0000000000
--- a/harbour/contrib/hbhttpd/tests/files/main.js
+++ /dev/null
@@ -1,39 +0,0 @@
-
-function getXmlHttp()
-{
- var obj=null;
-
- if( window.XMLHttpRequest )
- {
- obj = new XMLHttpRequest();
- }
- else if( window.ActiveXObject )
- {
- obj = new ActiveXObject("Microsoft.XMLHTTP");
- }
- if ( obj == null )
- {
- alert("Browser does not support HTTP Request");
- }
- return obj;
-}
-
-function ubrcall(id,param)
-{
- var tbl = document.getElementById(id);
- var r = getXmlHttp();
- r.open("GET", "?ajax=" + id + "&" + param, true);
- r.onreadystatechange=function ()
- {
- if( r.readyState == 4 )
- {
- if( r.status == 200 )
- {
- tbl.innerHTML = r.responseText;
- }
- r = null;
- }
- }
- r.send(null);
-}
-
diff --git a/harbour/contrib/hbhttpd/tests/tpl/_main.tpl b/harbour/contrib/hbhttpd/tests/tpl/_main.tpl
new file mode 100644
index 0000000000..52b80d8c5f
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/tpl/_main.tpl
@@ -0,0 +1,9 @@
+
+
+Shopping | Cart | Logout
+My account
+{{if errtext}}{{= errtext}} {{endif}}
+
+User name {{= user}} Name {{= name}}
+
+Edit
diff --git a/harbour/contrib/hbhttpd/tests/tpl/app/account/edit.tpl b/harbour/contrib/hbhttpd/tests/tpl/app/account/edit.tpl
new file mode 100644
index 0000000000..88ffefaf38
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/tpl/app/account/edit.tpl
@@ -0,0 +1,14 @@
+{{extend _main}}
+Shopping | Cart | My account | Logout
+
My account
+{{if errtext}}{{= errtext}} {{endif}}
+
\ No newline at end of file
diff --git a/harbour/contrib/hbhttpd/tests/tpl/app/cart.tpl b/harbour/contrib/hbhttpd/tests/tpl/app/cart.tpl
new file mode 100644
index 0000000000..9515ff78e0
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/tpl/app/cart.tpl
@@ -0,0 +1,8 @@
+{{extend _main}}
+Shopping | My account | Logout
+Cart
+Your cart is worth: {{= cartsum}}
+
+{{: browse}}
+
diff --git a/harbour/contrib/hbhttpd/tests/tpl/app/login.tpl b/harbour/contrib/hbhttpd/tests/tpl/app/login.tpl
new file mode 100644
index 0000000000..004562f4bd
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/tpl/app/login.tpl
@@ -0,0 +1,12 @@
+{{extend _main}}
+
Login
+{{if errtext}}{{= errtext}} {{endif}}
+
+
+Create new account
\ No newline at end of file
diff --git a/harbour/contrib/hbhttpd/tests/tpl/app/logout.tpl b/harbour/contrib/hbhttpd/tests/tpl/app/logout.tpl
new file mode 100644
index 0000000000..d643107f99
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/tpl/app/logout.tpl
@@ -0,0 +1,4 @@
+{{extend _main}}
+Login
+
Shopping | Cart | My account | Logout
+Login
+Create new account
+{{if errtext}}{{= errtext}} {{endif}}
+
\ No newline at end of file
diff --git a/harbour/contrib/hbhttpd/tests/tpl/app/shopping.tpl b/harbour/contrib/hbhttpd/tests/tpl/app/shopping.tpl
new file mode 100644
index 0000000000..4d69284743
--- /dev/null
+++ b/harbour/contrib/hbhttpd/tests/tpl/app/shopping.tpl
@@ -0,0 +1,8 @@
+{{extend _main}}
+Cart | My account | Logout
+Shopping
+Your cart is worth: {{= cartsum}}
+
+{{: browse}}
+
diff --git a/harbour/contrib/hbhttpd/tests/webapp.prg b/harbour/contrib/hbhttpd/tests/webapp.prg
deleted file mode 100644
index 583d1db732..0000000000
--- a/harbour/contrib/hbhttpd/tests/webapp.prg
+++ /dev/null
@@ -1,453 +0,0 @@
-/*
- * $Id$
- */
-
-REQUEST DBFCDX
-
-MEMVAR server, get, post, cookie, session
-
-PROCEDURE Main()
-
- LOCAL oServer
-
- LOCAL oLogAccess
- LOCAL oLogError
-
- LOCAL hMap
-
- IF HB_ARGCHECK( "help" )
- ? "Usage: app [options]"
- ? "Options:"
- ? " //help Print help"
- ? " //stop Stop running server"
- RETURN
- ENDIF
-
- IF HB_ARGCHECK( "stop" )
- HB_MEMOWRIT( ".uhttpd.stop", "" )
- RETURN
- ELSE
- FErase( ".uhttpd.stop" )
- ENDIF
-
- rddSetDefault( "DBFCDX" )
- SET( _SET_DATEFORMAT, "yyyy-mm-dd" )
-
- IF ! HB_FILEEXISTS( "users.dbf" )
- FErase( "users.cdx" )
- dbCreate( "users", { { "USER", "C", 16, 0 }, { "PASSWORD", "C", 16, 0 }, { "NAME", "C", 50, 0 } }, , .T. , "user" )
- OrdCreate( "users", "user", "USER" )
- dbCloseArea()
- ELSEIF ! HB_FILEEXISTS( "users.cdx" )
- dbUseArea( .T. , , "users", , .F. , .F. )
- OrdCreate( "users", "user", "USER" )
- dbCloseArea()
- ENDIF
-
- IF ! HB_FILEEXISTS( "carts.dbf" )
- FErase( "carts.cdx" )
- dbCreate( "carts", { { "USER", "C", 16, 0 }, { "CODE", "C", 16, 0 }, { "AMOUNT", "N", 6, 0 }, { "TOTAL", "N", 9, 2 } }, , .T. , "cart" )
- OrdCreate( "carts", "user", "USER+CODE" )
- dbCloseArea()
- ELSEIF ! HB_FILEEXISTS( "carts.cdx" )
- dbUseArea( .T. , , "carts", , .F. , .F. )
- OrdCreate( "carts", "user", "USER+CODE" )
- dbCloseArea()
- ENDIF
-
- IF ! HB_FILEEXISTS( "items.dbf" )
- FErase( "items.cdx" )
- dbCreate( "items", { { "CODE", "C", 16, 0 }, { "TITLE", "C", 80, 0 }, { "PRICE", "N", 9, 2 } }, , .T. , "items" )
- OrdCreate( "items", "code", "CODE" )
- dbCloseArea()
- ELSEIF ! HB_FILEEXISTS( "item.cdx" )
- dbUseArea( .T. , , "items", , .F. , .F. )
- OrdCreate( "items", "code", "CODE" )
- dbCloseArea()
- ENDIF
-
- oLogAccess := UHttpdLog():New( "webapp_access.log" )
-
- IF ! oLogAccess:Add( "" )
- oLogAccess:Close()
- ? "Access log file open error " + hb_ntos( FError() )
- RETURN
- ENDIF
-
- oLogError := UHttpdLog():New( "webapp_error.log" )
-
- IF ! oLogError:Add( "" )
- oLogError:Close()
- oLogAccess:Close()
- ? "Error log file open error " + hb_ntos( FError() )
- RETURN
- ENDIF
-
- oServer := UHttpdNew()
-
- oServer:bLogAccess := {| m | oLogAccess:Add( m + hb_eol() ) }
- oServer:bLogError := {| m | oLogError:Add( m + hb_eol() ) }
- oServer:bTrace := {| ... | QOut( ... ) }
-
- oServer:nPort := 8002
- oServer:bIdle := { |o| iif( HB_FILEEXISTS( ".uhttpd.stop" ), ( FErase(".uhttpd.stop" ), o:Stop() ), NIL ) }
-
-
- hMap := {;
- "login" => @proc_login(), ;
- "logout" => @proc_logout(), ;
- "register" => @proc_register(), ;
- "account" => @proc_account(), ;
- "account/edit" => @proc_account_edit(), ;
- "main" => @proc_main(), ;
- "shopping" => @proc_shopping(), ;
- "cart" => @proc_cart() }
-
- oServer:hMount := {;
- "/hello" => { {|| UWrite( "Hello!" ) }, .F. }, ;
- "/info" => { {|| UProcInfo() }, .F. }, ;
- "/files/*" => { {|x| UProcFiles( hb_dirBase() + "files/" + x, .F. ) }, .F. }, ;
- "/app/*" => { {|x| UProcWidgets( x, hMap ) }, .T. }, ;
- "/*" => { {|| URedirect( "/app/login" ) }, .F. } }
-
- ? "Listening on port:", oServer:nPort
-
- IF ! oServer:Run()
- oLogError:Close()
- oLogAccess:Close()
- ? "Server error:", oServer:cError
- ErrorLevel( 1 )
- RETURN
- ENDIF
-
- oLogError:Close()
- oLogAccess:Close()
-
- RETURN
-
-STATIC FUNCTION proc_login( cMethod )
-
- LOCAL cUser, oM, oF, oG
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- oM := UWMainNew()
- oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) )
- oM:Add( oF := UWFormNew( "" ) )
- oF:Add( oG := UWLayoutGridNew() )
- oG:Add( UWHtmlNew( "User" ), 1, 1 )
- oG:Add( UWInputNew( "user" ), 1, 2 )
- oG:Add( UWHtmlNew( "Password" ), 2, 1 )
- oG:Add( UWPasswordNew( "password" ), 2, 2 )
- oG:Add( UWSubmitNew( "submit", "Login" ), 3, 2 )
- oM:Add( UWHtmlNew( ULink("Register", "register" ) ) )
- ELSEIF cMethod == "POST"
- dbUseArea( .T. , , "users", "users", .T. , .T. )
- OrdSetFocus( "user" )
- cUser := PadR( hb_HGetDef( post, "user", "" ), 16 )
- IF !Empty( cUser ) .AND. dbSeek( cUser, .F. ) .AND. ! Deleted() .AND. ;
- PadR( hb_HGetDef( post, "password", "" ), 16 ) == FIELD->PASSWORD
- session[ "loggedin" ] := cUser
- URedirect( "main" )
- ELSE
- URedirect( "login?err" )
- USessionDestroy()
- ENDIF
- dbCloseArea()
- ELSEIF cMethod == "GET"
- IF HB_HHasKey( get, "err" )
- UGetWidgetById( "errtxt" ):cText := "Invalid username or password!"
- ENDIF
- UWDefaultHandler( cMethod )
- USessionDestroy()
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_register( cMethod )
-
- LOCAL cUser, cName, cPassword, cPassword2, oM, oF, oG
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- oM := UWMainNew()
- oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) )
- oM:Add( oF := UWFormNew( "" ) )
- oF:Add( oG := UWLayoutGridNew() )
- oG:Add( UWHtmlNew( "User name" ), 1, 1 )
- oG:Add( UWInputNew( "user",, "user" ), 1, 2 )
- oG:Add( UWHtmlNew( "Name" ), 2, 1 )
- oG:Add( UWInputNew( "name",, "name" ), 2, 2 )
- oG:Add( UWHtmlNew( "Password" ), 3, 1 )
- oG:Add( UWPasswordNew( "password" ), 3, 2 )
- oG:Add( UWHtmlNew( "Password again" ), 4, 1 )
- oG:Add( UWPasswordNew( "password2" ), 4, 2 )
- oG:Add( UWSubmitNew( "register", "Register" ), 5, 2 )
- ELSEIF cMethod == "POST"
- dbUseArea( .T. , , "users", "users", .T. , .F. )
- OrdSetFocus( "user" )
- cUser := hb_HGetDef( post, "user", "" )
- cName := hb_HGetDef( post, "name", "" )
- cPassword := hb_HGetDef( post, "password", "" )
- cPassword2 := hb_HGetDef( post, "password2", "" )
- UGetWidgetById( "user" ):cValue := cUser
- UGetWidgetById( "name" ):cValue := cName
- IF Empty( cUser ) .OR. Empty( cName ) .OR. Empty( cPassword ) .OR. Empty( cPassword2 )
- URedirect( "?err=1" )
- ELSEIF !( cPassword == cPassword2 )
- URedirect( "?err=2" )
- ELSEIF dbSeek( cUser, .F. )
- URedirect( "?err=3" )
- ELSE
- FLock()
- dbAppend()
- FIELD->USER := cUser
- FIELD->NAME := cName
- FIELD->PASSWORD := cPassword
- dbUnlock()
- session[ "loggedin" ] := cUser
- URedirect( "main" )
- ENDIF
- dbCloseArea()
- ELSEIF cMethod == "GET"
- IF HB_HHasKey( get, "err" )
- IF get[ "err" ] == "1"
- UGetWidgetById( "errtxt" ):cText := "All fields are required!"
- ELSEIF get[ "err" ] == "2"
- UGetWidgetById( "errtxt" ):cText := "Passwords does not match!"
- ELSEIF get[ "err" ] == "3"
- UGetWidgetById( "errtxt" ):cText := "This user already exists!"
- ENDIF
- ENDIF
- UWDefaultHandler( cMethod )
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_account( cMethod )
-
- LOCAL oM, oG
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
- ENDIF
- dbUseArea( .T. , , "users", "users", .T. , .F. )
- OrdSetFocus( "user" )
- ELSEIF cMethod == "GET"
- dbSeek( session[ "loggedin" ], .F. )
- /* Create object here because user name can be changed in account/edit */
- oM := UWMainNew()
- oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ):AddItem( "Cart", "cart" ):AddItem( "Logout", "logout" ) )
- oM:Add( UWSeparatorNew() )
- oM:Add( oG := UWLayoutGridNew() )
- oG:Add( UWHtmlNew( "User name:" ), 1, 1 )
- oG:Add( UWHtmlNew( session[ "loggedin" ] ), 1, 2 )
- oG:Add( UWHtmlNew( "Name:" ), 2, 1 )
- oG:Add( UWHtmlNew( FIELD->NAME ), 2, 2 )
- oM:Add( UWHtmlNew( ULink("Edit", "account/edit" ) ) )
- UWDefaultHandler( cMethod )
- ELSEIF cMethod == "EXIT"
- users->( dbCloseArea() )
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_account_edit( cMethod )
-
- LOCAL cName, cPassword, cPassword2, oM, oG, oF
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
- ENDIF
- dbSeek( session[ "loggedin" ], .F. )
- oM := UWMainNew()
- oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) )
- oM:Add( oF := UWFormNew( "" ) )
- oF:Add( oG := UWLayoutGridNew() )
- oG:Add( UWHtmlNew( "User name" ), 1, 1 )
- oG:Add( UWHtmlNew( session[ "loggedin" ] ), 1, 2 )
- oG:Add( UWHtmlNew( "Name" ), 2, 1 )
- oG:Add( UWInputNew( "name", RTrim( FIELD->NAME ), "name" ), 2, 2 )
- oG:Add( UWHtmlNew( "Password" ), 3, 1 )
- oG:Add( UWPasswordNew( "password" ), 3, 2 )
- oG:Add( UWHtmlNew( "Password again" ), 4, 1 )
- oG:Add( UWPasswordNew( "password2" ), 4, 2 )
- oG:Add( UWSubmitNew( "save", "Save" ), 5, 2 )
- ELSEIF cMethod == "POST"
- dbSeek( session[ "loggedin" ], .F. )
- cName := hb_HGetDef( post, "name", "" )
- cPassword := hb_HGetDef( post, "password", "" )
- cPassword2 := hb_HGetDef( post, "password2", "" )
- UGetWidgetById( "name" ):cValue := RTrim( cName )
- IF Empty( cName )
- URedirect( "?err=1" )
- ELSEIF ( ! Empty( cPassword ) .OR. ! Empty( cPassword2 ) ) .AND. ! ( cPassword == cPassword2 )
- URedirect( "?err=2" )
- ELSE
- FLock()
- FIELD->NAME := cName
- QOut( "PO DBAPPEND", Alias(), RecNo(), cName )
- IF ! Empty( cPassword )
- FIELD->PASSWORD := cPassword
- ENDIF
- dbUnlock()
- URedirect( "../account" )
- ENDIF
- ELSEIF cMethod == "GET"
- IF HB_HHasKey( get, "err" )
- IF get[ "err" ] == "1"
- UGetWidgetById( "errtxt" ):cText := "All fields are required!"
- ELSEIF get[ "err" ] == "2"
- UGetWidgetById( "errtxt" ):cText := "Passwords do not match!"
- ENDIF
- ENDIF
- UWDefaultHandler( cMethod )
- ELSEIF cMethod == "EXIT"
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_main( cMethod )
-
- LOCAL oM
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
- ENDIF
- oM := UWMainNew()
- oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" );
- :AddItem( "Cart", "cart" );
- :AddItem( "My account", "account" );
- :AddItem( "Logout", "logout" ) )
- oM:Add( UWSeparatorNew() )
- oM:Add( UWLabelNew( "You can do shopping, or edit your cart using menu links above" ) )
- ELSEIF cMethod == "GET"
- UWDefaultHandler( cMethod )
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_shopping( cMethod )
-
- LOCAL oM, oW, nT, cCode
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
- ENDIF
- oM := UWMainNew()
- oM:Add( UWMenuNew():AddItem( "Cart", "cart" ):AddItem( "My account", "account" ):AddItem( "Logout", "logout" ) )
- oM:Add( UWSeparatorNew() )
- oM:Add( UWLabelNew( "", "cartsum" ) )
-
- dbUseArea( .T. , , "carts", "carts", .T. , .F. )
- OrdSetFocus( "user" )
- ORDSCOPE( 0, session[ "loggedin" ] )
- ORDSCOPE( 1, session[ "loggedin" ] )
- dbUseArea( .T. , , "items", "items", .T. , .T. )
- OrdSetFocus( "code" )
- oW := UWBrowseNew( "1" )
- oW:AddColumn( 101, "Item No.", "CODE" )
- oW:AddColumn( 102, "Title", "TITLE" )
- oW:AddColumn( 103, "Price", "PRICE" )
- oW:AddColumn( 104, "", {|| ULink( "Add to cart", "?add=" + RTrim( FIELD->CODE ) ) }, .T. )
- oM:Add( oW )
- ELSEIF cMethod == "GET"
- IF HB_HHasKey( get, "add" )
- cCode := PadR( get[ "add" ], 16 )
- IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
- IF ! carts->( dbSeek( session[ "loggedin" ] + cCode ) )
- carts->( dbAppend() )
- carts->USER := session[ "loggedin" ]
- carts->CODE := cCode
- ENDIF
- carts->AMOUNT += 1
- carts->TOTAL += items->PRICE
- carts->( dbUnlock() )
- ENDIF
- URedirect( "shopping" )
- RETURN .T.
- ENDIF
- nT := 0
- carts->( dbEval( {|| nT += FIELD->TOTAL } ) )
- UGetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
- UWDefaultHandler( cMethod )
- ELSEIF cMethod == "EXIT"
- items->( dbCloseArea() )
- carts->( dbCloseArea() )
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_cart( cMethod )
-
- LOCAL oM, oW, nT, cCode
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
- ENDIF
- oM := UWMainNew()
- oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ):AddItem( "My account", "account" ):AddItem( "Logout", "logout" ) )
- oM:Add( UWSeparatorNew() )
- oM:Add( UWLabelNew( "", "cartsum" ) )
-
- dbUseArea( .T. , , "items", "items", .T. , .T. )
- OrdSetFocus( "code" )
- dbUseArea( .T. , , "carts", "carts", .T. , .F. )
- OrdSetFocus( "user" )
- ORDSCOPE( 0, session[ "loggedin" ] )
- ORDSCOPE( 1, session[ "loggedin" ] )
- oW := UWBrowseNew( "1" )
- oW:AddColumn( 101, "Item No.", "CODE" )
- oW:AddColumn( 102, "Title", {|| items->( dbSeek(carts->CODE, .F. ), FIELD->TITLE ) } )
- oW:AddColumn( 103, "Amount", "AMOUNT" )
- oW:AddColumn( 104, "Total", "TOTAL" )
- oW:AddColumn( 104, "", {|| ULink( "Delete", "?del=" + RTrim( FIELD->CODE ) ) }, .T. )
- oM:Add( oW )
- ELSEIF cMethod == "GET"
- IF HB_HHasKey( get, "del" )
- cCode := PadR( get[ "del" ], 16 )
- IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
- IF carts->( dbSeek( session[ "loggedin" ] + cCode ) )
- carts->( dbDelete() )
- carts->USER := ""
- carts->CODE := cCode
- ENDIF
- carts->( dbUnlock() )
- ENDIF
- URedirect( "cart" )
- RETURN .T.
- ENDIF
- nT := 0
- carts->( dbEval( {|| nT += FIELD->TOTAL } ) )
- UGetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
- UWDefaultHandler( cMethod )
- ELSEIF cMethod == "EXIT"
- items->( dbCloseArea() )
- carts->( dbCloseArea() )
- ENDIF
-
- RETURN .T.
-
-STATIC FUNCTION proc_logout( cMethod )
-
- LOCAL oM
-
- ? ProcName(), cMethod
- IF cMethod == "INIT"
- IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
- ENDIF
- oM := UWMainNew()
- oM:Add( UWMenuNew():AddItem( "Login", "login" ) )
- oM:Add( UWSeparatorNew() )
- oM:Add( UWLabelNew( "Your session is ended." ) )
- ELSEIF cMethod == "GET"
- UWDefaultHandler( cMethod )
- USessionDestroy()
- ENDIF
-
- RETURN .T.
diff --git a/harbour/contrib/hbhttpd/widgets.prg b/harbour/contrib/hbhttpd/widgets.prg
index 2c7ceccd06..e374b31450 100644
--- a/harbour/contrib/hbhttpd/widgets.prg
+++ b/harbour/contrib/hbhttpd/widgets.prg
@@ -336,29 +336,19 @@ METHOD Paint() CLASS UWMenu
CREATE CLASS UWBrowse
- VAR cID
VAR aColumns INIT {}
- VAR nArea
-
- VAR nRecno
- VAR lBof INIT .F.
- VAR lEof INIT .F.
+ VAR nPageSize INIT 0
+ VAR nPos INIT 0
METHOD AddColumn( nID, cTitle, cField, lRaw )
- METHOD Paint()
- METHOD PaintBody()
- METHOD Ajax( cAction )
- METHOD Skipper( nSkip )
+ METHOD Output()
ENDCLASS
-FUNCTION UWBrowseNew( cID )
+FUNC UWBrowseNew()
LOCAL oW := UWBrowse()
- SetWId( oW, cID )
- oW:nArea := Select()
-
RETURN oW
METHOD AddColumn( nID, cTitle, cField, lRaw ) CLASS UWBrowse
@@ -367,56 +357,29 @@ METHOD AddColumn( nID, cTitle, cField, lRaw ) CLASS UWBrowse
RETURN Self
-METHOD Paint() CLASS UWBrowse
+METHOD Output() CLASS UWBrowse
- UWrite( '
' )
- Self:PaintBody()
- UWrite( '
' )
+ LOCAL cRet := "", nI, xI, xField, nPos, cUrl, cI, lValidate
- RETURN Self
-
-METHOD PaintBody() CLASS UWBrowse
-
- LOCAL nI, nJ, xI, xField, nArea
-
- nArea := Select()
- dbSelectArea( Self:nArea )
- IF Self:nRecNo == NIL
- DBGOTOP()
- Self:nRecno := RecNo()
- Self:Skipper( 0 )
- ELSE
- dbGoto( Self:nRecno )
- Self:Skipper( 0 )
- Self:nRecno := RecNo()
- ENDIF
- IF ! Self:lBof
- UWrite( '< ' )
- ELSE
- UWrite( '< ' )
- ENDIF
- IF ! Self:lEof
- UWrite( '> ' )
- ELSE
- UWrite( '> ' )
- ENDIF
- UWrite( '' )
+ cRet += ''
// Header
- UWrite( ' ' )
+ cRet += ' '
FOR nI := 1 TO Len( Self:aColumns )
- UWrite( '' + UHtmlEncode( Self:aColumns[nI, 2] ) + ' ' )
+ cRet += '' + UHtmlEncode( Self:aColumns[nI, 2] ) + ' '
NEXT
- UWrite( ' ' )
+ cRet += ''
// Body
- dbGoto( Self:nRecno )
- FOR nI := 1 TO 20
- IF Eof(); EXIT
- ENDIF
- UWrite( '' )
- FOR nJ := 1 TO Len( Self:aColumns )
- xField := Self:aColumns[nJ, 3]
+ nPos := 0
+ DBGOTOP()
+ IF Self:nPageSize > 0 .AND. Self:nPos > 0
+ dbSkip( Self:nPos )
+ ENDIF
+ DO WHILE ! Eof()
+ cRet += ' '
+ FOR nI := 1 TO Len( Self:aColumns )
+ xField := Self:aColumns[nI, 3]
IF ValType( xField ) == "C"
xI := FieldGet( FieldPos( xField ) )
ELSEIF ValType( xField ) == "B"
@@ -427,59 +390,77 @@ METHOD PaintBody() CLASS UWBrowse
ELSEIF ValType( xI ) == "D"; xI := DToC( xI )
ELSE ; xI := "VALTYPE()==" + ValType( xI )
ENDIF
- IF ! Self:aColumns[nJ, 4]
+ IF ! Self:aColumns[nI, 4]
xI := UHtmlEncode( xI )
ENDIF
- UWrite( '' + xI + ' ' + xI + ' ' )
+ cRet += ''
dbSkip()
- NEXT
- UWrite( '
' )
- dbSelectArea( nArea )
-
- RETURN Self
-
-METHOD Ajax( cAction ) CLASS UWBrowse
-
- IF cAction == "nextpg"
- ( Self:nArea ) -> ( Self:Skipper( 20 ) )
- ELSEIF cAction == "prevpg"
- ( Self:nArea ) -> ( Self:Skipper( - 20 ) )
- ENDIF
- Self:PaintBody()
-
- RETURN Self
-
-METHOD Skipper( nSkip ) CLASS UWBrowse
-
- dbGoto( Self:nRecno )
- dbSkip( nSkip )
- Self:nRecno := RecNo()
- IF Eof()
- dbSkip( - 1 )
- Self:nRecno := RecNo()
- Self:lEof := Eof()
- ELSE
- dbSkip( 20 )
- Self:lEof := Eof()
- ENDIF
- dbGoto( Self:nRecno )
- IF Bof()
- Self:lBof := .T.
- ELSE
- dbSkip( - 1 )
- IF Bof()
- Self:lBof := .T.
- ELSE
- dbSkip( 1 )
- Self:lBof := .F.
+ IF ++ nPos >= Self:nPageSize
+ EXIT
+ ENDIF
+ ENDDO
+ cRet += '
'
+ IF ! Eof() .OR. Self:nPos > 0
+ cUrl := server["REQUEST_URI"]
+ IF ( nI := At( "?_ucs=", cUrl ) ) == 0
+ nI := At( "&_ucs=", cUrl )
+ ENDIF
+ IF ( lValidate := nI > 0 )
+ cUrl := Left( cUrl, nI - 1 )
+ ENDIF
+ IF ( nI := At( "?_pos=", cUrl ) ) == 0
+ nI := At( "&_pos=", cUrl )
+ ENDIF
+ IF nI > 0
+ cUrl := Left( cUrl, nI - 1 )
+ ENDIF
+ cUrl += iif( "?" $ cUrl, "&", "?" ) + "_pos="
+ cRet := '>> ' + cRet
+ ENDIF
+ IF Self:nPos > 0
+ cI := cUrl + hb_ntos( Max( 0, Self:nPos - Self:nPageSize ) )
+ cRet := '<< ' + cRet
ENDIF
ENDIF
- Self:nRecno := RecNo()
+
+ RETURN cRet
+
+//============================================================
+
+CREATE CLASS UWOption
+
+ VAR aOption INIT {}
+ VAR cValue
+
+ METHOD Add( cTitle, cCode, lRaw )
+ METHOD Output()
+
+ENDCLASS
+
+FUNC UWOptionNew()
+
+ LOCAL oW := UWOption()
+
+ RETURN oW
+
+METHOD Add( cTitle, cCode, lRaw ) CLASS UWOption
+
+ AAdd( Self:aOption, { iif( ! Empty(lRaw ), cTitle, UHtmlEncode(cTitle ) ), cCode } )
RETURN Self
+METHOD Output() CLASS UWOption
+
+ LOCAL cRet := ""
+
+ AEval( Self:aOption, {| X | cRet += HB_STRFORMAT( '%s ', UHtmlEncode(X[2] ), iif(X[2] == Self:cValue, " selected", "" ), X[1] ) } )
+
+ RETURN cRet
/********************************************************************
*
@@ -583,3 +564,36 @@ STATIC PROCEDURE SetWId( oW, cID )
FUNCTION UGetWidgetById( cID )
RETURN hb_HGetDef( session[ "_uthis", "idhash" ], cID )
+
+STATIC FUNCTION uhttpd_split( cSeparator, cString )
+
+ LOCAL aRet := {}
+ LOCAL nI
+
+ DO WHILE ( nI := At( cSeparator, cString ) ) > 0
+ AAdd( aRet, Left( cString, nI - 1 ) )
+ cString := SubStr( cString, nI + Len( cSeparator ) )
+ ENDDO
+ AAdd( aRet, cString )
+
+ RETURN aRet
+
+STATIC FUNCTION uhttpd_join( cSeparator, aData )
+
+ LOCAL cRet := ""
+ LOCAL 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 += hb_ntos( aData[ nI ] )
+ ELSEIF ValType( aData[ nI ] ) == "D" ; cRet += iif( Empty( aData[ nI ] ), "", DToC( aData[ nI ] ) )
+ ELSE
+ ENDIF
+ NEXT
+
+ RETURN cRet
diff --git a/harbour/contrib/hbplist b/harbour/contrib/hbplist
index c65d9271b5..ca25ffbaa7 100644
--- a/harbour/contrib/hbplist
+++ b/harbour/contrib/hbplist
@@ -24,6 +24,7 @@ hbgs/hbgs.hbp
hbgt/hbgt.hbp
hbhpdf/hbhpdf.hbp # uses: libhpdf (locally hosted)
hbhttpd/hbhttpd.hbp
+hbhttpd/hbhttpds.hbp
hbide/hbide.hbp
hblzf/hblzf.hbp # uses: liblzf (locally hosted)
hbmagic/hbmagic.hbp