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

2010-11-24 10:11 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* contrib/hbhttpd/hbhttpd.hbp
  + contrib/hbhttpd/log.prg
    + Added simple logger class.

  * contrib/hbhttpd/core.prg
  * contrib/hbhttpd/tests/webapp.prg
    + Changed logging. Now core provides callbacks for
      logging and doesn't do any logging on its own.

  * contrib/hbhttpd/widgets.prg
  * contrib/hbhttpd/tests/webapp.prg
    * Renamed one public function to have 'U' prefix.
This commit is contained in:
Viktor Szakats
2010-11-24 09:11:46 +00:00
parent 84920588c1
commit ef67dce3a8
6 changed files with 174 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -16,6 +16,20 @@
The license applies to all entries newer than 2009-04-28.
*/
2010-11-24 10:11 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbhttpd/hbhttpd.hbp
+ contrib/hbhttpd/log.prg
+ Added simple logger class.
* contrib/hbhttpd/core.prg
* contrib/hbhttpd/tests/webapp.prg
+ Changed logging. Now core provides callbacks for
logging and doesn't do any logging on its own.
* contrib/hbhttpd/widgets.prg
* contrib/hbhttpd/tests/webapp.prg
* Renamed one public function to have 'U' prefix.
2010-11-24 01:58 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
- contrib/hbhttpd/umain.prg
+ contrib/hbhttpd/core.prg

40
harbour/contrib/hbhttpd/core.prg
View File

@@ -4,7 +4,6 @@
#include "hbclass.ch"
#include "common.ch"
#include "fileio.ch"
#include "error.ch"
#include "hbsocket.ch"
@@ -24,7 +23,7 @@
#define THREAD_COUNT_MAX 50
#define SESSION_TIMEOUT 600
#define CR_LF (CHR(13)+CHR(10))
#define CR_LF ( Chr( 13 ) + Chr( 10 ) )
THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_lSessionDestroy
@@ -35,8 +34,8 @@ CREATE CLASS UHttpd
/* Settings */
DATA nPort INIT 80
DATA cBindAddress INIT "0.0.0.0"
DATA cAccessLog INIT "uhttpd_access.log"
DATA cErrorLog INIT "uhttpd_error.log"
DATA bLogAccess INIT {|| NIL }
DATA bLogError INIT {|| NIL }
DATA bIdle INIT {|| NIL }
DATA aMount INIT { => }
@@ -44,9 +43,6 @@ CREATE CLASS UHttpd
DATA cError INIT ""
/* Private */
DATA hAccessLog
DATA hErrorLog
DATA hmtxQueue
DATA hmtxLog
DATA hmtxSession
@@ -84,43 +80,24 @@ METHOD RUN() CLASS UHttpd
RETURN .F.
ENDIF
IF ( Self:hAccessLog := FOpen( Self:cAccessLog, FO_CREAT + FO_WRITE ) ) == - 1
Self:cError := "Access log file open error " + hb_ntos( FError() )
RETURN .F.
ENDIF
FSeek( Self:hAccessLog, 0, FS_END )
IF ( Self:hErrorLog := FOpen( Self:cErrorLog, FO_CREAT + FO_WRITE ) ) == - 1
Self:cError := "Error log file open error " + hb_ntos( FError() )
FClose( Self:hAccessLog )
RETURN .F.
ENDIF
FSeek( Self:hErrorLog, 0, FS_END )
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() )
FClose( Self:hErrorLog )
FClose( Self:hAccessLog )
RETURN .F.
ENDIF
IF !hb_socketBind( Self:hListen, { HB_SOCKET_AF_INET, Self:cBindAddress, Self:nPort } )
Self:cError := "Bind error " + hb_ntos( hb_socketGetError() )
hb_socketClose( Self:hListen )
FClose( Self:hErrorLog )
FClose( Self:hAccessLog )
RETURN .F.
ENDIF
IF !hb_socketListen( Self:hListen )
Self:cError := "Listen error " + hb_ntos( hb_socketGetError() )
hb_socketClose( Self:hListen )
FClose( Self:hErrorLog )
FClose( Self:hAccessLog )
RETURN .F.
ENDIF
@@ -167,9 +144,6 @@ METHOD RUN() CLASS UHttpd
AEval( aThreads, {|| hb_mutexNotify( Self:hmtxQueue, NIL ) } )
AEval( aThreads, {|h| hb_threadJoin( h ) } )
FClose( Self:hErrorLog )
FClose( Self:hAccessLog )
RETURN .T.
METHOD Stop() CLASS UHttpd
@@ -181,7 +155,7 @@ METHOD Stop() CLASS UHttpd
METHOD LogError( cError ) CLASS UHttpd
hb_mutexLock( Self:hmtxLog )
FWrite( Self:hErrorLog, DToS( Date() ) + " " + Time() + " " + cError + " " + hb_eol() )
Eval( Self:bLogError, DToS( Date() ) + " " + Time() + " " + cError )
hb_mutexUnlock( Self:hmtxLog )
RETURN NIL
@@ -191,13 +165,13 @@ METHOD LogAccess() CLASS UHttpd
LOCAL cDate := DToS( Date() ), cTime := Time()
hb_mutexLock( Self:hmtxLog )
FWrite( Self:hAccessLog, ;
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"] + '" ' + ;
hb_ntos( t_nStatusCode ) + " " + hb_ntos( Len( t_cResult ) ) + ;
' "' + server["HTTP_REFERER"] + '" "' + server["HTTP_USER_AGENT"] + ;
'"' + hb_eol() )
'"' )
hb_mutexUnlock( Self:hmtxLog )
RETURN NIL
@@ -966,7 +940,7 @@ PROCEDURE UProcFiles( cFileName, lIndex )
CASE "wav"; cI := "audio/x-wav"; EXIT
CASE "qt"; CASE "mov"; cI := "video/quicktime"; EXIT
CASE "avi"; cI := "video/x-msvideo"; EXIT
OTHERWISE
OTHERWISE
cI := "application/octet-stream"
ENDSWITCH
ELSE

1
harbour/contrib/hbhttpd/hbhttpd.hbp
View File

@@ -11,3 +11,4 @@
core.prg
widgets.prg
log.prg

110
harbour/contrib/hbhttpd/log.prg Normal file
View File

@@ -0,0 +1,110 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Simple logger class
*
* Copyright 2010 Viktor Szakats (harbour.01 syenar.hu)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbclass.ch"
#include "fileio.ch"
CREATE CLASS UHttpdLog
METHOD New( cFileName )
METHOD Add( cMsg )
METHOD Close()
PROTECTED:
VAR cFileName
VAR fhnd
ENDCLASS
METHOD New( cFileName ) CLASS UHttpdLog
LOCAL cExt
IF ! hb_isString( cFileName )
cFileName := "hbhttpd"
ENDIF
IF Set( _SET_DEFEXTENSIONS )
hb_FNameSplit( cFileName, NIL, NIL, @cExt )
IF Empty( cExt )
cFileName += ".log"
ENDIF
ENDIF
::cFileName := cFileName
RETURN Self
METHOD Add( cMsg ) CLASS UHttpdLog
IF Empty( ::fhnd ) .OR. ::fhnd == F_ERROR
::fhnd := hb_FCreate( ::cFileName, FC_NORMAL, FO_WRITE + FO_DENYNONE )
ELSE
FSeek( ::fhnd, 0, FS_END )
ENDIF
RETURN ! Empty( ::fhnd ) .AND. ;
::fhnd != F_ERROR .AND. ;
FWrite( ::fhnd, cMsg ) == Len( cMsg )
METHOD Close() CLASS UHttpdLog
LOCAL lRetVal
IF ! Empty( ::fhnd ) .AND. ::fhnd != F_ERROR
lRetVal := FClose( ::fhnd )
::fhnd := NIL
ELSE
lRetVal := .F.
ENDIF
RETURN lRetVal

50
harbour/contrib/hbhttpd/tests/webapp.prg
View File

@@ -20,6 +20,9 @@ FUNCTION Main()
LOCAL oServer
LOCAL oLogAccess
LOCAL oLogError
IF HB_ARGCHECK( "help" )
? "Usage: app [options]"
? "Options:"
@@ -71,8 +74,28 @@ FUNCTION Main()
dbCloseArea()
ENDIF
oLogAccess := UHttpdLog():New( "webapp_access.log" )
IF ! oLogAccess:Add( "" )
oLogAccess:Close()
? "Access log file open error " + hb_ntos( FError() )
RETURN 0
ENDIF
oLogError := UHttpdLog():New( "webapp_error.log" )
IF ! oLogError:Add( "" )
oLogError:Close()
oLogAccess:Close()
? "Error log file open error " + hb_ntos( FError() )
RETURN 0
ENDIF
oServer := UHttpdNew()
oServer:bLogAccess := {| m | oLogAccess:Add( m + hb_eol() ) }
oServer:bLogError := {| m | oLogError:Add( m + hb_eol() ) }
oServer:nPort := 8002
oServer:bIdle := { |o| iif( HB_FILEEXISTS( ".uhttpd.stop" ), ( FErase(".uhttpd.stop" ), o:Stop() ), NIL ) }
@@ -97,10 +120,15 @@ FUNCTION Main()
? "Listening on port:", oServer:nPort
IF ! oServer:Run()
oLogError:Close()
oLogAccess:Close()
? "Server error:", oServer:cError
RETURN 1
ENDIF
oLogError:Close()
oLogAccess:Close()
RETURN 0
STATIC FUNCTION proc_login( cMethod )
@@ -134,7 +162,7 @@ STATIC FUNCTION proc_login( cMethod )
dbCloseArea()
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
GetWidgetById( "errtxt" ):cText := "Invalid username or password!"
UGetWidgetById( "errtxt" ):cText := "Invalid username or password!"
ENDIF
UWDefaultHandler( cMethod )
USessionDestroy()
@@ -168,8 +196,8 @@ STATIC FUNCTION proc_register( cMethod )
cName := hb_HGetDef( post, "name", "" )
cPassword := hb_HGetDef( post, "password", "" )
cPassword2 := hb_HGetDef( post, "password2", "" )
GetWidgetById( "user" ):cValue := cUser
GetWidgetById( "name" ):cValue := cName
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 )
@@ -190,11 +218,11 @@ STATIC FUNCTION proc_register( cMethod )
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
IF get[ "err" ] == "1"
GetWidgetById( "errtxt" ):cText := "All fields are required!"
UGetWidgetById( "errtxt" ):cText := "All fields are required!"
ELSEIF get[ "err" ] == "2"
GetWidgetById( "errtxt" ):cText := "Passwords does not match!"
UGetWidgetById( "errtxt" ):cText := "Passwords does not match!"
ELSEIF get[ "err" ] == "3"
GetWidgetById( "errtxt" ):cText := "This user already exists!"
UGetWidgetById( "errtxt" ):cText := "This user already exists!"
ENDIF
ENDIF
UWDefaultHandler( cMethod )
@@ -258,7 +286,7 @@ STATIC FUNCTION proc_account_edit( cMethod )
cName := hb_HGetDef( post, "name", "" )
cPassword := hb_HGetDef( post, "password", "" )
cPassword2 := hb_HGetDef( post, "password2", "" )
GetWidgetById( "name" ):cValue := RTrim( cName )
UGetWidgetById( "name" ):cValue := RTrim( cName )
IF Empty( cName )
URedirect( "?err=1" )
ELSEIF ( ! Empty( cPassword ) .OR. ! Empty( cPassword2 ) ) .AND. ! ( cPassword == cPassword2 )
@@ -276,9 +304,9 @@ STATIC FUNCTION proc_account_edit( cMethod )
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
IF get[ "err" ] == "1"
GetWidgetById( "errtxt" ):cText := "All fields are required!"
UGetWidgetById( "errtxt" ):cText := "All fields are required!"
ELSEIF get[ "err" ] == "2"
GetWidgetById( "errtxt" ):cText := "Passwords does not match!"
UGetWidgetById( "errtxt" ):cText := "Passwords does not match!"
ENDIF
ENDIF
UWDefaultHandler( cMethod )
@@ -351,7 +379,7 @@ STATIC FUNCTION proc_shopping( cMethod )
ENDIF
nT := 0
carts->( dbEval( {|| nT += TOTAL } ) )
GetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
UGetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
UWDefaultHandler( cMethod )
ELSEIF cMethod == "EXIT"
items->( dbCloseArea() )
@@ -402,7 +430,7 @@ STATIC FUNCTION proc_cart( cMethod )
ENDIF
nT := 0
carts->( dbEval( {|| nT += TOTAL } ) )
GetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
UGetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
UWDefaultHandler( cMethod )
ELSEIF cMethod == "EXIT"
items->( dbCloseArea() )

6
harbour/contrib/hbhttpd/widgets.prg
View File

@@ -564,7 +564,7 @@ PROCEDURE UWDefaultHandler( cMethod )
IF ( cID := hb_HGetDef( get, "ajax" ) ) == NIL
session["_uthis", "main"]:Paint()
ELSE
IF ( oW := GetWidgetById( cID ) ) != NIL
IF ( oW := UGetWidgetById( cID ) ) != NIL
UAddHeader( "Content-type", "text/html; charset=windows-1257" )
oW:Ajax( hb_HGetDef( get, "action" ) )
ENDIF
@@ -573,7 +573,7 @@ PROCEDURE UWDefaultHandler( cMethod )
RETURN
STATIC PROC SetWId( oW, cID )
STATIC PROCEDURE SetWId( oW, cID )
IF cID != NIL
oW:cID := cID
@@ -582,5 +582,5 @@ STATIC PROC SetWId( oW, cID )
RETURN
FUNCTION GetWidgetById( cID )
FUNCTION UGetWidgetById( cID )
RETURN hb_HGetDef( session["_uthis", "idhash"], cID )