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

2009-06-15 20:31 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
+ examples/uhttpd2
  + examples/uhttpd2/umain.prg
  + examples/uhttpd2/files
  + examples/uhttpd2/files/main.js
  + examples/uhttpd2/files/main.css
  + examples/uhttpd2/uhttpd2.hbp
  + examples/uhttpd2/uwidgets.prg
  + examples/uhttpd2/carts.dbf
  + examples/uhttpd2/uhbext.prg
  + examples/uhttpd2/app.prg
  + examples/uhttpd2/socket.c
  + examples/uhttpd2/items.dbf
  + examples/uhttpd2/readme.txt
  + examples/uhttpd2/users.dbf
    + Added contribution of Mindaugas Kavaliauskas:
      small-footprint multithreading http server with session model. 
      Read the whole description in readme.txt.

  + examples/httpsrv
  + examples/httpsrv/httpsrv.hbp
    + Somehow missed from prev.
This commit is contained in:
Viktor Szakats
2009-06-15 18:22:09 +00:00
parent 91bd1aee41
commit 7fec598cbd
22 changed files with 3072 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
harbour/ChangeLog
View File

@@ -17,6 +17,29 @@
past entries belonging to author(s): Viktor Szakats.
*/
2009-06-15 20:31 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
+ examples/uhttpd2
+ examples/uhttpd2/umain.prg
+ examples/uhttpd2/files
+ examples/uhttpd2/files/main.js
+ examples/uhttpd2/files/main.css
+ examples/uhttpd2/uhttpd2.hbp
+ examples/uhttpd2/uwidgets.prg
+ examples/uhttpd2/carts.dbf
+ examples/uhttpd2/uhbext.prg
+ examples/uhttpd2/app.prg
+ examples/uhttpd2/socket.c
+ examples/uhttpd2/items.dbf
+ examples/uhttpd2/readme.txt
+ examples/uhttpd2/users.dbf
+ Added contribution of Mindaugas Kavaliauskas:
small-footprint multithreading http server with session model.
Read the whole description in readme.txt.
+ examples/httpsrv
+ examples/httpsrv/httpsrv.hbp
+ Somehow missed from prev.
2009-06-15 18:47 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* utils/hbmk2/hbmk2.prg
- Deleted hb_DirBase() DJGPP hack after Przemek's fix.

3
harbour/examples/httpsrv/cgifunc.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* HTTPSRV (Micro HTTP server) cgi functions
* uHTTPD (Micro HTTP server) cgi functions
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
@@ -862,3 +862,4 @@ FUNCTION uhttpd_HGetValue( hHash, cKey )
ENDIF
//RETURN IIF( cKey IN hHash:Keys, hHash[ cKey ], NIL )
RETURN xVal

2
harbour/examples/httpsrv/cookie.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* HTTPSRV (Micro HTTP server) cookie functions
* uHTTPD (Micro HTTP server) cookie functions
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org

8
harbour/examples/httpsrv/httpsrv.hbp Normal file
View File

@@ -0,0 +1,8 @@
#
# $Id$
#
# Use -DUSE_HB_INET if you want to turn on Harbour internet socket.
# It's always on on non-Windows systems.
-mt -gui httpsrv.prg cgifunc.prg cookie.prg session.prg httpsrvc.c socket.c

12
harbour/examples/httpsrv/readme.txt
View File

@@ -2,22 +2,22 @@
* $Id$
*/
HTTPSRV micro web server
uHTTPD micro web server
Build it without GD: hbmk2 httpsrv.hbp
Build it with GD: hbmk2 httpsrvd.hbp
Build it without GD: hbmk2 uhttpd.hbp
Build it with GD: hbmk2 uhttpdgd.hbp
[ This one needs bgd.dll. Please download it from:
http://www.libgd.org/releases/gd-latest-win32.zip ]
Add -DUSE_HB_INET to command line if you want to use Harbour's
built-in socket functions.
To see accepted parameters run: httpsrv -?
Parameters can also be defined using httpsrv.ini file.
To see accepted parameters run: uhttpd -?
Parameters can also be defined using uhttpd.ini file.
Before starting please build modules using: hbmk2 modules.hbp
Once started connect to httpsrv using:
Once started connect to uhttpd using:
http://localhost:8082
to see default index page.

2
harbour/examples/httpsrv/session.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* HTTPSRV (Micro HTTP server) session functions
* uHTTPD (Micro HTTP server) session functions
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org

5
harbour/examples/httpsrv/httpsrv.ini → harbour/examples/httpsrv/uhttpd.ini
View File

@@ -3,13 +3,13 @@
#
# ------------------------------------
# Harbour Project source code:
# HTTPSRV (Micro HTTP server) ini file
# uHTTPD (Micro HTTP server) ini file
#
# Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
# www - http://www.harbour-project.org
# ------------------------------------
#
# HTTPSRV ini file (defaults are commented)
# uHTTPD ini file (defaults are commented)
#
# ------------------------------------
@@ -73,3 +73,4 @@ start_num = 10
#/images = $(APP_DIR)/images
# end

8
harbour/examples/httpsrv/httpsrv.prg → harbour/examples/httpsrv/uhttpd.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* HTTPSRV (Micro HTTP server)
* uHTTPD (Micro HTTP server)
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* Copyright 2008 Mindaugas Kavaliauskas (dbtopas at dbtopas.lt)
@@ -134,7 +134,7 @@
#stdout "Dynamic # of threads"
#endif
#define APP_NAME "httpsrv"
#define APP_NAME "uhttpd"
#define APP_VER_NUM "0.4.4"
#define APP_VERSION APP_VER_NUM + APP_GD_SUPPORT + APP_INET_SUPPORT + APP_DT_SUPPORT
@@ -150,7 +150,7 @@
#define LISTEN_PORT 8082 // differs from standard 80 port for tests in case
// anyone has a apache/IIS installed
#define FILE_STOP ".httpsrv.stop"
#define FILE_STOP ".uhttpd.stop"
#define FILE_ACCESS_LOG "logs" + HB_OSPathSeparator() + "access.log"
#define FILE_ERROR_LOG "logs" + HB_OSPathSeparator() + "error.log"
#define DIRECTORYINDEX_ARRAY { "index.html", "index.htm" }
@@ -1348,7 +1348,7 @@ STATIC FUNCTION ParseRequest( cRequest )
// After defined all SERVER vars we can define a session
// SESSION - sessions ID is stored as a cookie value, normally as SESSIONID var name (this can be user defined)
t_oSession := uhttpd_SessionNew( "HTTPSRV-SESSION", s_cSessionPath )
t_oSession := uhttpd_SessionNew( "UHTTPD-SESSION", s_cSessionPath )
t_oSession:Start()
RETURN .T.

2
harbour/examples/httpsrv/httpsrvc.c → harbour/examples/httpsrv/uhttpdc.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* HTTPSRV (Micro HTTP server) [C helper functions]
* uHTTPD (Micro HTTP server) [C helper functions]
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* Copyright 2008 Mindaugas Kavaliauskas (dbtopas at dbtopas.lt)

4
harbour/examples/httpsrv/httpsrvg.hbp → harbour/examples/httpsrv/uhttpdgd.hbp
View File

@@ -2,9 +2,7 @@
# $Id$
#
# httpsrv with GD support
@httpd.hbp
@uhttpd.hbp
-DGD_SUPPORT
-lhbgd -lhbct
-lbgd{win}

411
harbour/examples/uhttpd2/app.prg Normal file
View File

@@ -0,0 +1,411 @@
/*
* $Id$
*/
#include "hbclass.ch"
#include "common.ch"
#include "fileio.ch"
#define CR_LF (CHR(13)+CHR(10))
REQUEST DBFCDX
MEMVAR server, get, post, cookie, session
STATIC s_aMap
FIELD USER, NAME, PASSWORD, CODE, PRICE, TOTAL, TITLE
FUNC main()
LOCAL oServer
IF HB_ARGCHECK("help")
? "Usage: app [options]"
? "Options:"
? " //help Print help"
? " //stop Stop running server"
RETURN 0
ENDIF
IF HB_ARGCHECK("stop")
HB_MEMOWRIT(".uhttpd.stop", "")
RETURN 0
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
oServer := UHttpdNew()
oServer:nPort := 8002
oServer:bIdle := {|o| IIF(HB_FILEEXISTS(".uhttpd.stop"), (FERASE(".uhttpd.stop"), o:Stop()), NIL)}
s_aMap := {"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:aMount := ;
{"/hello" => {{|| UWrite("Hello!")}, .F.}, ;
"/info" => {{|| UProcInfo()}, .F.}, ;
"/files/*"=> {{|x| UProcFiles( hb_dirBase() + "files/" + X, .F.)}, .F.}, ;
"/app/*" => {{|x| UProcWidgets(x, s_aMap)}, .T.}, ;
"/*" => {{|| URedirect("/app/login")}, .F.}}
IF ! oServer:Run()
? "Server error:", oServer:cError
RETURN 1
ENDIF
RETURN 0
STATIC FUNC 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(HGetDef(post, "user", ""), 16)
IF !EMPTY(cUser) .AND. DBSEEK(cUser, .F.) .AND. ! DELETED() .AND. ;
PADR(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")
GetWidgetById("errtxt"):cText := "Invalid username or password!"
ENDIF
UWDefaultHandler(cMethod)
USessionDestroy()
ENDIF
RETURN .T.
STATIC FUNC 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 := HGetDef(post, "user", "")
cName := HGetDef(post, "name", "")
cPassword := HGetDef(post, "password", "")
cPassword2 := HGetDef(post, "password2", "")
GetWidgetById("user"):cValue := cUser
GetWidgetById("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()
USER := cUser
NAME := cName
PASSWORD := cPassword
DBUNLOCK()
session["loggedin"] := cUser
URedirect("main")
ENDIF
DBCLOSEAREA()
ELSEIF cMethod == "GET"
IF HB_HHasKey(get, "err")
IF get["err"] == "1"
GetWidgetById("errtxt"):cText := "All fields are required!"
ELSEIF get["err"] == "2"
GetWidgetById("errtxt"):cText := "Passwords does not match!"
ELSEIF get["err"] == "3"
GetWidgetById("errtxt"):cText := "This user already exists!"
ENDIF
ENDIF
UWDefaultHandler(cMethod)
ENDIF
RETURN .T.
STATIC FUNC proc_account(cMethod)
LOCAL cUser, cName, 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(NAME), 2, 2 )
oM:Add( UWHtmlNew(ULink("Edit", "account/edit")) )
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
users->(DBCLOSEAREA())
ENDIF
RETURN .T.
STATIC FUNC 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", TRIM(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 := HGetDef(post, "name", "")
cPassword := HGetDef(post, "password", "")
cPassword2 := HGetDef(post, "password2", "")
GetWidgetById("name"):cValue := TRIM(cName)
IF EMPTY(cName)
URedirect("?err=1")
ELSEIF (! EMPTY(cPassword) .OR. ! EMPTY(cPassword2)) .AND. ! (cPassword == cPassword2)
URedirect("?err=2")
ELSE
FLOCK()
NAME := cName
QOUT("PO DBAPPEND", ALIAS(), RECNO(), cName)
IF ! EMPTY(cPassword)
PASSWORD := cPassword
ENDIF
DBUNLOCK()
URedirect("../account")
ENDIF
ELSEIF cMethod == "GET"
IF HB_HHasKey(get, "err")
IF get["err"] == "1"
GetWidgetById("errtxt"):cText := "All fields are required!"
ELSEIF get["err"] == "2"
GetWidgetById("errtxt"):cText := "Passwords does not match!"
ENDIF
ENDIF
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
ENDIF
RETURN .T.
STATIC FUNC 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 FUNC 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=" + TRIM(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 += TOTAL}))
GetWidgetById("cartsum"):cText := "Your cart is worth: " + LTRIM(STR(nT))
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
items->(DBCLOSEAREA())
carts->(DBCLOSEAREA())
ENDIF
RETURN .T.
STATIC FUNC 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.), TITLE)})
oW:AddColumn(103, "Amount", "AMOUNT")
oW:AddColumn(104, "Total", "TOTAL")
oW:AddColumn(104, "", {|| ULink("Delete", "?del=" + TRIM(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 += TOTAL}))
GetWidgetById("cartsum"):cText := "Your cart is worth: " + LTRIM(STR(nT))
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
items->(DBCLOSEAREA())
carts->(DBCLOSEAREA())
ENDIF
RETURN .T.
STATIC FUNC 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.

BIN
harbour/examples/uhttpd2/carts.dbf Normal file
View File

Binary file not shown.

35
harbour/examples/uhttpd2/files/main.css Normal file
View File

@@ -0,0 +1,35 @@
body, td {
font-family: Arial, sans-serif;
font-size: 13px;
}
table.ubr {
font-family: Arial, sans-serif;
font-size: 13px;
border-width: 1px;
}
table.ubr th {
padding: 0px 4px 0px 4px;
background-color: #C0C0C0;
}
table.ubr tr {
background-color: #F0F0F0;
}
table.ubr tr:hover {
background-color: #D0D0FF;
}
tr.ubrr div {
width: auto;
white-space: nowrap;
overflow: hidden;
}
ulnk {
text-color:blue;
text-decoration:underline;
}

39
harbour/examples/uhttpd2/files/main.js Normal file
View File

@@ -0,0 +1,39 @@
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);
}

BIN
harbour/examples/uhttpd2/items.dbf Normal file
View File

Binary file not shown.

399
harbour/examples/uhttpd2/readme.txt Normal file
View File

@@ -0,0 +1,399 @@
/*
* $Id$
*/
Date: Fri, 12 Jun 2009 19:47:37 +0300
From: Mindaugas Kavaliauskas <dbtopas@dbtopas.lt>
To: "Harbour Project Main Developer List." <harbour@harbour-project.org>
Subject: uhttpd v0.2
Hello,
I want to share some more ideas (and code) about uhttpd development.
All pro and cons, and any brainstorming is very welcome.
Sources can be obtained from:
http://www.dbtopas.lt/hrb/uhttpd-0.2.zip
You can test running demo application at (I'll try to keep it running
for some time): http://www.dbtopas.lt:8001/
I also want to add answer about one question. uhttpd support and
upload into Harbour SVN. I expected and wrote some time before:
------
I just have some ideas how to extend it, but I'm not sure if these
ideas will be similar to SVN changes by other people. It can happen,
that after some time I will propose something completely different
and incompatible from SVN.
------
I see many backward incompatible changes in my uhttpd, and I'm going
to do development in this incompatible way. I'm just experimenting
with my simple applications, and I want to find a best web application
architecture solution. I'm not interested in showcounter sample,
or uhttp_cookie object, so, I do not want to do any changes to SVN
uhttpd sample. Feel free to pick the features you like and put it
into SVN.
Regards,
Mindaugas
The main idea
=============
I've implemented sessions for uhttpd. This session model is different
from other WWW servers. In database oriented web applications, server
has to open database file read/write some data, generate html output,
close database, send response to client. This requires database
opening/closing for each request. The goal of this implementation was
to avoid this opening/closing and other per request initialization/
exit operations. This could be done by keeping a separate thread for
each session. Every request of some session is processed by the same
thread and this thread keeps databases open.
This approach makes web server a little similar to terminal server:
each application has "its own" thread in web server (just like each
application has its own process in case remote terminal). Some remote
terminal protocol is used to send keyboard data to and receive screen
image from terminal server, here we use HTTP protocol for this
purpose.
Sessions
========
Main thread waits for connections. Accept connections are put into
common request queue. This queue is processed by some threads. These
threads reads http request from socket and analyzes session
information. If request corresponds to some session and session
information is required to handle particular request, the request is
redirected to sessioned request queue of corresponding session. These
sessioned requests are processed by sessioned threads. Each active
session has one sessioned thread to handle request. This thread keeps
databases open. Some request (for example, .css file request) does not
requires session data even if client has active session with server,
these request may be processed by threads of common request queue.
If keep-alive connections are used, after sessioned request is
processed, connection is put into common request queue. This helps to
move receiving of request and processing of static content responses
to common queue threads, thus leaving sessioned threads available for
generation of dynamic content for another keep-alive connection of the
same session.
Common keep-alive conn.
+----------------------+
Accepted | |
+-------------+ connection V Common queue |
| Main thread | -----------+-------------> ################### |
+-------------+ ^ V |
| +------+ +------+ +------+ |
| |Thread| |Thread| |Thread| ---+
| +------+ +------+ +------+ |
| |
Keep-alive| |
connections| Sessioned request queues |
| |
| #### <---------------------------+
| V |
| +------+ |
+---- |Thread| |
| +------+ |
| |
| Sessioned request |
| #### <---------------------------+
| V
| +------+
+---- |Thread|
+------+
Thread circulation
==================
The figure above shows connection/request circulation. Thread
circulation is done in very similar way. All children threads are
created by main thread. These child threads wait for connections in
common request queue. If sessioned request is received, thread finds
the corresponding sessioned thread, passes request to it, and starts
to wait for new request. If sessioned thread is not found (the first
session request is received), this thread initializes session data
and becomes a sessioned thread. After processing of the first session
request, it does not return to common request queue, but waits for
requests of this session only. After session is destroyed, this
thread returns to common request queue.
Mounting table
==============
Traditional web servers exposes directory tree (DocumentRoot) to the
clients. Server side scripts are a regular files having executable
attribute or some kind of extension (ex., .php) inside directory
tree (or some aliased directory). uhttpd is oriented to be a single
compiled application and dynamic web pages are generated not by
external files (thought, we can add such possibility using .hrb or
.prg files), but generated by function linked into final executable.
Thus some "table" is needed to convert requested URL to server script.
This table is called mounting table in my uhttpd implementation. It
allows to mount a single URL or URL subtree to a particular handler
(function or codeblock).
Mounting table is hash, having this structure:
oServer:aMount := { url => { handler, sessioned }, ... }
URL can a single URL path, or path containing '*' wildchar in the end.
Example:
/app/login - single URL match http://host/app/login
/files/* - the whole URL subtree from http://host/files/
/* - the whole URL tree http://host/
NOTE: '*' should be placed after '/' symbol to match URL subtree.
Usage of '/files*' is invalid and do not match '/files1', '/filesa'
or '/files/x'. The requested URL path is checked by deleting last
slashed part until URL is found in mounting table. If no URL found
in mounting table, 404 Not Found error is returned.
Example 1. If '/files/folder/aaa' is requested, '/files/folder/aaa',
'/files/folder/*', '/files/*', and '/*' will be checked before 404
error is returned.
Example 2. If '/files/folder/' is requested, '/files/folder/',
'/files/folder/*', '/files/*', and '/*' will be checked before 404
error is returned.
NOTE 2: if you want to use a slash-less URL address as a synonym for
the folder you may need an extra redirection rule. Ex.,
"/files" => {{|| URedirect("/files/")}, .F.}
"/files/*" => {{|x| UProcFiles(DocumentRoot + x)}, .F.}
Widgets
=======
The implementation described above can be used to develop web
applications with a power comparable to plain php, but we will need
some framework/toolkit on top of basic uhttp server to allow a quick
application development. UWidgets is used for this purpose. It allows
to use some objects (browse, etc.) instead of plain:
UWrite('<table>')
DO WHILE ! EOF()
UWrite('<tr><td>' + FIELD->NAME + '</td><td align="right">' +
STR(FIELD->AGE) + '</td></tr>')
DBSKIP()
ENDDO
UWrite('</table>')
To use UWigets under some URL subtree, you should add an entry to
server mounting table specifying standard widgets handler:
"app/*" => {{|x| UProcWidgets(x, s_aMap)}, .T.}
You can see UWidgets handler requires requests to be sessioned.
s_aMap is one more table similar to server mounting table. Actually,
these two tables can be merged is widgets are implemented inside
server itself, but I want to keep widgets implementation separate,
thus, allowing an alternative implementations. s_aMap is hash
containing the mapping of URL subtree into handler functions. Ex.,
s_aMap := { "login" => @proc_login(), ;
"main" => @proc_main(), ;
"account" => @proc_account(), ;
"items" => @proc_items(), ;
"items/edit" => @proc_items_edit(), ;
"logout" => @proc_logout()}
Page handler functions receives a parameter indicating received
event/method. Handler has a structure:
STATIC FUNC proc_handler(cMethod)
IF cMethod == "INIT"
// This code is executed on entering URL (first call to this URL)
// Here we open databases used to process queries
ELSEIF cMethod == "POST"
// Process HTTP POST request
ELSEIF cMethod == "GET"
// Process HTTP GET request
ELSEIF cMethod == "EXIT"
// This code is executed on leaving URL (before first call to
// another URL)
// Here we close databases opened in INIT method, etc.
ENDIF
RETURN .T.
As you can see this handler reminds the structure of traditional GUI
based application message/event handler, for example in windows, we
have:
STATIC FUNC WndProc(hWnd, uMsg, wParam, lParam)
IF uMsg == WM_CREATE
ELSEIF uMsg == WM_PAINT
ELSEIF uMsg == WM_DESTROY
ENDIF
RETURN ...
I hope this similarity will help to develop (or convert) event based
GUI applications to web easier.
The widgets are created on INIT method. The main widget is UWMain
object. Creation of widgets is done using a function following
Clipper convention: <object_name>New(). So,
oM := UWMainNew()
creates a main widget of web page. This main widget acts as a
layout/container in for example, GTK+ library. It has :Add() method
and other widgets can be included inside of it. Ex.,
oM := UWMainNew()
oM:Add( UWLabelNew("Hello, Widgets World!") )
UWidgets keeps main widget (and its children) inside session variable
and produces html output for it upon GET (or POST) requests. Main
widget "renders" all its child widgets, until the whole web page
content is generated. This html "rendering" is performed by
UWDefaultHandler().
POST method is usually used to perform some action on user data. I use
URedirect() function to do "redirect after post" and solve the problem
of from resubmitting, etc.
Modal page handlers
===================
Page handler has INIT, GET/POST, and EXIT messages. INIT and EXIT
methods are called only after you request of new page.
Ex.,
GET request "items" executes:
page_items("INIT")
page_items("GET")
Next GET request "items" executes:
page_items("GET")
If you issue a GET "account" request, it will execute:
page_items("EXIT")
page_account("INIT")
page_account("GET")
A tree structure of URL is transfered into page handles INIT, EXIT
logic. It helps make some feeling of modal structure of handler. I call
it "modal" because of idea how event are processed in event handlers of
modal dialogs. Let's have event handler function items_handler() for
items dialog, and items_edit_handler() function for item_edit dialog.
PROC items_handler()
...
IF event = "edit button pressed"
dialog := create_new_modal_dialog() // create items_edit dialog
dialog:handler := @items_edit_handler()
process_event_loop() // until dialog is closed
destroy_dialog(dialog)
ENDIF
...
RETURN
during process_event_loop() events are processed inside
items_edit_handler() function, and this event handler can access
workareas opened in a parent dialog (item dialog), private variables
of item_hadler(), etc.
The similar effect was tried to reach in page hadlers. Let's continue our
sample (last query was "account").
GET request for "items" executes:
page_account("EXIT")
page_items("INIT")
page_items("GET")
GET request for "items/edit" executes:
page_items_edit("INIT") // no page_items("EXIT") !!!
page_items_edit("GET")
GET request for "account" executes:
page_items_edit("EXIT")
page_items("EXIT")
page_account("INIT")
page_account("GET")
GET request for "account/edit" executes:
page_account_edit("INIT")
page_account_edit("GET")
etc...
Other major changes
===================
- dropped underscore and changed style to lower case for "global"
memvars: server, get, post, cookie, session. These variables are
accessed very often, and it is not some kind of internals marked by
underscore. Code looked very UPPERCASE SCREAMING before;
- uhttpd rewritten to be an object. Server does not occupies main()
function any more, and can be included into any application (or even
a few servers in one application);
- implemented missing HTTP/1.1 headers;
- implemented keep-alive connections to reduce TCP handshake overhead;
- implemented HTTP/1.1 Last-Modified and co., to avoid resend of
unmodified static content;
- session expiration;
- socket.c module supports linux (thanks Przemek for detailed
instructions);
- socket.c is more multithread GC friendly (using hb_vm[Un]Lock());
- error handling. Runtime errors in "user" code does not cause server
crash;
Pro and Cons
============
One thread per session
----------------------
Pro:
* OK, if there is a limited number of clients actively using web
application
Cons:
* not scalable solution for sites with thousands low activity
users (will keep a large number of inactive threads)
The implementation of sessioned threads was started from idea: it's
nice to have a prepared open aliases, positioned records, etc, on
request processing instead of opening, positioning and closing it
on every request. Some alias caching or another data model can solve
this problem.
Sessioned threads
-----------------
Pro:
* Keeps alias state unchanged
* Solves race condition problem for accessing session vartiables
Cons:
* A little complicated and not standard architecture
* Request should be divided into sessioned and non-sessioned
Modal page handlers
-------------------
Pro:
* helps to have aliases opened in parent (as in modal application)
Cons:
* disables to handle request for a few unrelated parts of web
application. For example, if unrelated part having a different
URL branch is opened in popup window. The old page handler
receives EXIT message and state (aliases, etc) is lost.
Widgets and layouts
--------------------
Pro:
* It's OK for compilated AJAX widgets, like browse
Cons:
* For simple widgets (ex., UWHTML,. UWLabel, UWInput) is much easier
to write a plain HTML code, than widget creation code
Roadmap
=======
I'm not sure if I will not delete the whole sessioned threads, modal
page handlers, and widgets in next version of uhttpd. But there are
a few things I know I will implement:
* Templates
Perhaps this can change widgets a lot. Only complicated widgets
will remain. Simple widgets and layouts will move to templates.

488
harbour/examples/uhttpd2/socket.c Normal file
View File

@@ -0,0 +1,488 @@
/*
* $Id$
*/
/*
Function naming:
The intention of this library is to be as close as possible to the original
socket implementation. This supposed to be valid for function names also,
but some of the names are very platform dependent, ex., WSA*() functions.
select() function name is reserved for standard Harbour's function, so,
socket_*() prefix was used:
socket_init() - WSAStartup()
socket_exit() - WSACleanup()
socket_error() - WSALastError()
socket_select() - select()
Finally I renamed all functions to have socket_*() prefix to be more "prefix
compatible" and not to occupy a general function names like send(), bind(),
accept(), listen(), etc.:
socket_create() - socket()
socket_close() - closesocket()
socket_shutdown() - shutdown()
socket_bind() - bind()
socket_listen() - listen()
socket_accept() - accept()
socket_send() - send()
socket_recv() - recv()
socket_recv() - recv()
socket_getsockname() - getsockname()
socket_getpeername() - getpeername()
Types mapping:
SOCKET
UINT_PTR in Windows, let's map it to pointer type, and INVALID_SOCKET value to NIL
struct sockaddr
It is not only IP addresses, also can be IPX, etc. All network-host byte order
conversion should be hidden from Harbour API. So, let's map to:
{ adress_familly, ... }
AF_INET: { AF_INET, cAddr, nPort }
other: { AF_?, cAddressDump }
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbvm.h"
#ifdef HB_OS_WIN
#include <windows.h>
#define socklen_t int
#define SHUT_RDWR SD_BOTH
#else
#include <unistd.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <arpa/inet.h>
#include <netdb.h>
#define INVALID_SOCKET (-1)
typedef int SOCKET;
#endif
#ifdef hb_parnidef
#undef hb_parnidef
#endif
static int hb_parnidef( int iParam, int iValue )
{
return ISNUM( iParam ) ? hb_parni( iParam ) : iValue;
}
static SOCKET hb_parsocket( int iParam )
{
return ISPOINTER( iParam ) ? ( SOCKET ) hb_parptr( 1 ) : INVALID_SOCKET;
}
static void hb_retsocket( SOCKET hSocket )
{
if( hSocket == INVALID_SOCKET )
hb_ret();
else
hb_retptr( ( void* ) hSocket );
}
static SOCKET hb_itemGetSocket( PHB_ITEM pItem )
{
return HB_IS_POINTER( pItem ) ? ( SOCKET ) hb_itemGetPtr( pItem ) : INVALID_SOCKET;
}
static PHB_ITEM hb_itemPutSocket( PHB_ITEM pItem, SOCKET hSocket )
{
if( ! pItem )
pItem = hb_itemNew( NULL );
if( hSocket == INVALID_SOCKET )
hb_itemClear( pItem );
else
hb_itemPutPtr( pItem, ( void* ) hSocket );
return pItem;
}
static void hb_itemGetSockaddr( PHB_ITEM pItem, struct sockaddr* sa )
{
memset( sa, 0, sizeof( struct sockaddr ) );
if( HB_IS_ARRAY( pItem ) )
{
sa->sa_family = hb_arrayGetNI( pItem, 1 );
if( sa->sa_family == AF_INET )
{
( ( struct sockaddr_in* ) sa)->sin_addr.s_addr = inet_addr( hb_arrayGetCPtr( pItem, 2 ) );
( ( struct sockaddr_in* ) sa)->sin_port = htons( hb_arrayGetNI( pItem, 3 ) );
}
else
{
ULONG ulLen = hb_arrayGetCLen( pItem, 2 );
if( ulLen > sizeof( sa->sa_data ) )
ulLen = sizeof( sa->sa_data );
memcpy( sa->sa_data, hb_arrayGetCPtr( pItem, 2 ), ulLen );
}
}
}
static PHB_ITEM hb_itemPutSockaddr( PHB_ITEM pItem, const struct sockaddr* saddr )
{
pItem = hb_itemNew( pItem );
if( saddr->sa_family == AF_INET )
{
hb_arrayNew( pItem, 3 );
hb_arraySetNI( pItem, 1, saddr->sa_family );
hb_arraySetC( pItem, 2, inet_ntoa( ( ( struct sockaddr_in* ) saddr )->sin_addr ) );
hb_arraySetNI( pItem, 3, ntohs( ( ( struct sockaddr_in* ) saddr )->sin_port ) );
}
else
{
hb_arrayNew( pItem, 2 );
hb_arraySetNI( pItem, 1, saddr->sa_family );
hb_arraySetCL( pItem, 2, saddr->sa_data, sizeof( saddr->sa_data ) );
}
return pItem;
}
HB_FUNC ( SOCKET_INIT )
{
#ifdef HB_OS_WIN
WSADATA wsad;
hb_retni( WSAStartup( hb_parnidef( 1, 257 ), &wsad ) );
hb_storclen( (char*) &wsad, sizeof( WSADATA ), 2 );
#else
hb_retni( 0 );
#endif
}
HB_FUNC ( SOCKET_EXIT )
{
#ifdef HB_OS_WIN
hb_retni( WSACleanup() );
#else
hb_retni( 0 );
#endif
}
HB_FUNC ( SOCKET_ERROR )
{
#ifdef HB_OS_WIN
hb_retni( WSAGetLastError() );
#else
hb_retni( h_errno );
#endif
}
HB_FUNC ( SOCKET_CREATE )
{
hb_retsocket( socket( hb_parnidef( 1, PF_INET ),
hb_parnidef( 2, SOCK_STREAM ),
hb_parnidef( 3, IPPROTO_TCP ) ) );
}
HB_FUNC ( SOCKET_CLOSE )
{
#ifdef HB_OS_WIN
hb_retni( closesocket( hb_parsocket( 1 ) ) );
#else
hb_retni( close( hb_parsocket( 1 ) ) );
#endif
}
HB_FUNC ( SOCKET_BIND )
{
struct sockaddr sa;
hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa );
hb_retni( bind( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) );
}
HB_FUNC ( SOCKET_LISTEN )
{
hb_retni( listen( hb_parsocket( 1 ), hb_parnidef( 2, 10 ) ) );
}
HB_FUNC ( SOCKET_ACCEPT )
{
PHB_ITEM pItem;
SOCKET socket = hb_parsocket( 1 );
struct sockaddr saddr;
socklen_t iSize = sizeof( struct sockaddr );
hb_vmUnlock();
socket = accept( socket, &saddr, &iSize );
hb_vmLock();
hb_retsocket( socket );
if( ISBYREF( 2 ) )
{
pItem = hb_itemPutSockaddr( NULL, &saddr );
hb_itemParamStoreForward( 2, pItem );
hb_itemRelease( pItem );
}
}
HB_FUNC ( SOCKET_SHUTDOWN )
{
SOCKET socket = hb_parsocket( 1 );
int i = hb_parnidef( 2, SHUT_RDWR );
hb_vmUnlock();
i = shutdown( socket, i );
hb_vmLock();
hb_retni( i );
}
HB_FUNC ( SOCKET_RECV )
{
SOCKET socket = hb_parsocket( 1 );
int iLen, iRet, iFlags = hb_parnidef( 4, 0 );
char* pBuf;
iLen = hb_parni( 3 );
if( iLen > 65536 || iLen <= 0 )
iLen = 4096;
pBuf = ( char* ) hb_xgrab( ( ULONG ) iLen );
hb_vmUnlock();
iRet = recv( socket, pBuf, iLen, iFlags );
hb_vmLock();
hb_retni( iRet );
hb_storclen( pBuf, iRet > 0 ? iRet : 0, 2 );
hb_xfree( pBuf );
}
HB_FUNC ( SOCKET_SEND )
{
SOCKET socket = hb_parsocket( 1 );
char* pBuf = hb_parc( 2 );
ULONG ulLen = hb_parclen( 2 );
int iRet, iFlags = hb_parni( 3, 0 );
hb_vmUnlock();
iRet = send( socket, pBuf, ulLen, iFlags );
hb_vmLock();
hb_retni( iRet );
}
HB_FUNC ( SOCKET_SELECT )
{
fd_set setread, setwrite, seterror;
BOOL bRead = 0, bWrite = 0, bError = 0;
struct timeval tv;
SOCKET socket, maxsocket;
PHB_ITEM pArray, pItem;
ULONG ulLen, ulIndex, ulCount;
LONG lTimeout;
int iRet;
FD_ZERO( &setread );
FD_ZERO( &setwrite );
FD_ZERO( &seterror );
maxsocket = (SOCKET) 0;
pArray = hb_param( 1, HB_IT_ARRAY );
if( pArray )
{
ulLen = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
bRead = 1;
FD_SET( socket, &setread );
if( socket > maxsocket )
maxsocket = socket;
}
}
}
pArray = hb_param( 2, HB_IT_ARRAY );
if( pArray )
{
ulLen = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
bWrite = 1;
FD_SET( socket, &setwrite );
if( socket > maxsocket )
maxsocket = socket;
}
}
}
pArray = hb_param( 3, HB_IT_ARRAY );
if( pArray )
{
ulLen = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
bError = 1;
FD_SET( socket, &seterror );
if( socket > maxsocket )
maxsocket = socket;
}
}
}
/* Default forever */
lTimeout = ISNUM( 4 ) ? hb_parnl( 4 ) : -1;
hb_vmUnlock();
if( lTimeout == -1 )
{
iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL,
bError ? &seterror : NULL, NULL );
}
else
{
tv.tv_sec = lTimeout / 1000;
tv.tv_usec = ( lTimeout % 1000 ) * 1000;
iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL,
bError ? &seterror : NULL, &tv );
}
hb_vmLock();
pArray = hb_param( 1, HB_IT_ARRAY );
if( pArray && ISBYREF( 1 ) )
{
ulLen = hb_arrayLen( pArray );
pItem = hb_itemNew( NULL );
hb_arrayNew( pItem, ulLen );
ulCount = 0;
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
if( FD_ISSET( socket, &setread ) )
{
hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) );
}
}
}
hb_itemParamStoreForward( 1, pItem );
}
pArray = hb_param( 2, HB_IT_ARRAY );
if( pArray && ISBYREF( 2 ) )
{
ulLen = hb_arrayLen( pArray );
pItem = hb_itemNew( NULL );
hb_arrayNew( pItem, ulLen );
ulCount = 0;
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
if( FD_ISSET( socket, &setwrite ) )
{
hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) );
}
}
}
hb_itemParamStoreForward( 2, pItem );
}
pArray = hb_param( 3, HB_IT_ARRAY );
if( pArray && ISBYREF( 3 ) )
{
ulLen = hb_arrayLen( pArray );
pItem = hb_itemNew( NULL );
hb_arrayNew( pItem, ulLen );
ulCount = 0;
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
if( FD_ISSET( socket, &seterror ) )
{
hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) );
}
}
}
hb_itemParamStoreForward( 3, pItem );
}
hb_retni( iRet );
}
HB_FUNC ( SOCKET_GETSOCKNAME )
{
PHB_ITEM pItem;
struct sockaddr saddr;
socklen_t iSize = sizeof( struct sockaddr );
hb_retni( getsockname( hb_parsocket( 1 ), &saddr, &iSize ) );
if( ISBYREF( 2 ) )
{
pItem = hb_itemPutSockaddr( NULL, &saddr );
hb_itemParamStoreForward( 2, pItem );
hb_itemRelease( pItem );
}
}
HB_FUNC ( SOCKET_GETPEERNAME )
{
PHB_ITEM pItem;
struct sockaddr saddr;
socklen_t iSize = sizeof( struct sockaddr );
hb_retni( getpeername( hb_parsocket( 1 ), &saddr, &iSize ) );
if( ISBYREF( 2 ) )
{
pItem = hb_itemPutSockaddr( NULL, &saddr );
hb_itemParamStoreForward( 2, pItem );
hb_itemRelease( pItem );
}
}
HB_FUNC ( SOCKET_CONNECT )
{
SOCKET socket = hb_parsocket( 1 );
struct sockaddr sa;
int iRet;
hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa );
hb_vmUnlock();
iRet = connect( socket, &sa, sizeof( struct sockaddr ) );
hb_vmLock();
hb_retni( iRet );
}

74
harbour/examples/uhttpd2/uhbext.prg Normal file
View File

@@ -0,0 +1,74 @@
/*
* $Id$
*/
/************************************************************
*
* Functions candidates to be a part of Harbour's core or RTL
*
*************************************************************/
FUNC HGetDef(aHash, xKey, xDefault)
RETURN IIF(HB_HHasKey(aHash, xKey), aHash[ xKey ], xDefault)
FUNC split(cSeparator, cString)
LOCAL aRet := {}, 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
FUNC join(cSeparator, aData)
LOCAL cRet := "", nI
FOR nI := 1 TO LEN(aData)
IF nI > 1; cRet += cSeparator
ENDIF
IF VALTYPE(aData[nI]) $ "CM"; cRet += aData[nI]
ELSEIF VALTYPE(aData[nI]) == "N"; cRet += LTRIM(STR(aData[nI]))
ELSEIF VALTYPE(aData[nI]) == "D"; cRet += IF(!EMPTY(aData[nI]), DTOC(aData[nI]), "")
ELSE
ENDIF
NEXT
RETURN cRet
#pragma begindump
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbthread.h"
typedef struct _HB_MUTEX
{
int lock_count;
int lockers;
int waiters;
PHB_ITEM events;
HB_THREAD_ID owner;
HB_RAWCRITICAL_T mutex;
HB_RAWCOND_T cond_l;
HB_RAWCOND_T cond_w;
BOOL fSync;
struct _HB_MUTEX * pNext;
struct _HB_MUTEX * pPrev;
}
HB_MUTEX, * PHB_MUTEX;
HB_FUNC( HB_MUTEXWAITERSCOUNT )
{
PHB_MUTEX pItem = ( PHB_MUTEX ) hb_param( 1, HB_IT_POINTER );
if( pItem )
hb_retni( ( ( PHB_MUTEX ) hb_itemGetPtr( pItem ) )->waiters );
else
hb_ret();
}
#pragma enddump

9
harbour/examples/uhttpd2/uhttpd2.hbp Normal file
View File

@@ -0,0 +1,9 @@
#
# $Id$
#
-ouhttpd2
*.prg
*.c
-mt
-gui

1047
harbour/examples/uhttpd2/umain.prg Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
harbour/examples/uhttpd2/users.dbf Normal file
View File

Binary file not shown.

520
harbour/examples/uhttpd2/uwidgets.prg Normal file
View File

@@ -0,0 +1,520 @@
/*
* $Id$
*/
#include "hbclass.ch"
#pragma -kM+
MEMVAR session, server, get, post
//============================================================
CLASS UWMain
DATA aChilds INIT {}
METHOD Add()
METHOD Paint()
ENDCLASS
FUNC UWMainNew()
LOCAL oW := UWMain()
session["_uthis", "main"] := oW
RETURN oW
METHOD Paint() CLASS UWMain
UWrite('<html><link href="/files/main.css" type=text/css rel=stylesheet>')
UWrite('<meta http-equiv="content-type" content="text/html; charset=windows-1257">')
UWrite('<script language="javascript" src="/files/main.js"></script>')
UWrite('<body>')
AEVAL(Self:aChilds, {|x| X:Paint()})
UWrite('</body></html>')
RETURN Self
METHOD Add(oWidget) CLASS UWMain
AADD(Self:aChilds, oWidget)
RETURN Self
//============================================================
CLASS UWLayoutGrid
DATA aChilds INIT {{{}}} // {{{}}, {{}}} ; {{{}, {}}}
METHOD Add()
METHOD Paint()
ENDCLASS
FUNC UWLayoutGridNew()
LOCAL oW := UWLayoutGrid()
RETURN oW
METHOD Paint() CLASS UWLayoutGrid
LOCAL aRow, aCell
UWrite('<table>')
FOR EACH aRow IN Self:aChilds
UWrite('<tr>')
FOR EACH aCell IN aRow
UWrite('<td>')
AEVAL(aCell, {|o| o:Paint()})
UWrite('</td>')
NEXT
UWrite('</tr>')
NEXT
UWrite('</table>')
RETURN Self
METHOD Add(oWidget, nRow, nCol) CLASS UWLayoutGrid
LOCAL nI, nJ, aI
IF nRow > LEN(Self:aChilds)
FOR nI := LEN(Self:aChilds) + 1 TO nRow
aI := ARRAY(LEN(Self:aChilds[1]))
FOR nJ := 1 TO LEN(Self:aChilds[1])
aI[nJ] := {}
NEXT
AADD(Self:aChilds, aI)
NEXT
ENDIF
IF nCol > LEN(Self:aChilds[1])
FOR nI := LEN(Self:aChilds[1]) + 1 TO nCol
AEVAL(Self:aChilds, {|x| AADD(x, {})})
NEXT
ENDIF
AADD(Self:aChilds[nRow, nCol], oWidget)
RETURN Self
//============================================================
CLASS UWHtml
DATA cText
METHOD Paint()
ENDCLASS
FUNC UWHtmlNew(cText)
LOCAL oW := UWHtml()
oW:cText := cText
RETURN oW
METHOD Paint() CLASS UWHtml
UWrite(Self:cText)
RETURN Self
//============================================================
CLASS UWLabel
DATA cText
DATA cID
DATA cStyle
METHOD Paint()
ENDCLASS
FUNC UWLabelNew(cText, cID, cStyle)
LOCAL oW := UWLabel()
oW:cText := cText
SetWId(oW, cID)
oW:cStyle := cStyle
RETURN oW
METHOD Paint() CLASS UWLabel
UWrite('<div' + IIF(Self:cID != NIL, ' id="' + Self:cID + '"', "") + ;
IIF(Self:cStyle != NIL, ' style="' + Self:cStyle + '"', "") + '>' + ;
UHtmlEncode(Self:cText) + '</span>')
RETURN Self
//============================================================
CLASS UWForm
DATA cAction
DATA cMethod INIT "POST"
DATA aChilds INIT {}
METHOD Add()
METHOD Paint()
ENDCLASS
FUNC UWFormNew(cAction)
LOCAL oW := UWForm()
oW:cAction := cAction
RETURN oW
METHOD Add(oWidget) CLASS UWForm
AADD(Self:aChilds, oWidget)
RETURN Self
METHOD Paint() CLASS UWForm
UWrite('<form action="' + Self:cAction + '" method="' + Self:cMethod + '">')
AEVAL(Self:aChilds, {|x| X:Paint()})
UWrite('</form>')
RETURN Self
//============================================================
CLASS UWInput
DATA cName
DATA cValue
DATA cID
DATA cStyle
METHOD Paint()
ENDCLASS
FUNC UWInputNew(cName, cValue, cID, cStyle)
LOCAL oW := UWInput()
oW:cName := cName
oW:cValue := cValue
SetWId(oW, cID)
oW:cStyle := cStyle
RETURN oW
METHOD Paint() CLASS UWInput
UWrite('<input type="text" name="' + IIF(Self:cName != NIL, Self:cName, "") + ;
'" value="' + IIF(Self:cValue != NIL, UHtmlEncode(Self:cValue), "") + '">')
RETURN Self
//============================================================
CLASS UWPassword
DATA cName
DATA cValue
METHOD Paint()
ENDCLASS
FUNC UWPasswordNew(cName)
LOCAL oW := UWPassword()
oW:cName := cName
RETURN oW
METHOD Paint() CLASS UWPassword
UWrite('<input type="password" name="' + IIF(Self:cName != NIL, Self:cName, "") + ;
'" value="' + IIF(Self:cValue != NIL, Self:cValue, "") + '">')
RETURN Self
//============================================================
CLASS UWSubmit
DATA cName
DATA cValue
METHOD Paint()
ENDCLASS
FUNC UWSubmitNew(cName, cValue)
LOCAL oW := UWSubmit()
oW:cName := cName
oW:cValue := cValue
RETURN oW
METHOD Paint() CLASS UWSubmit
UWrite('<input type="submit" name="' + IIF(Self:cName != NIL, Self:cName, "") + ;
'" value="' + IIF(Self:cValue != NIL, UHtmlEncode(Self:cValue), "") + '">')
RETURN Self
//============================================================
CLASS UWSeparator
METHOD Paint()
ENDCLASS
FUNC UWSeparatorNew()
LOCAL oW := UWSeparator()
RETURN oW
METHOD Paint() CLASS UWSeparator
UWrite('<hr>')
RETURN Self
//============================================================
CLASS UWMenu
DATA aItems INIT {}
METHOD AddItem()
METHOD Paint()
ENDCLASS
FUNC UWMenuNew()
LOCAL oB := UWMenu()
RETURN oB
METHOD AddItem(cTitle, cLink) CLASS UWMenu
AADD(Self:aItems, {cTitle, cLink})
RETURN Self
METHOD Paint() CLASS UWMenu
LOCAL nI
UWrite('<div>')
FOR nI := 1 TO LEN(Self:aItems)
IF nI != 1
UWrite('&nbsp;|&nbsp;')
ENDIF
UWrite('<a href="' + Self:aItems[nI, 2] + '">' + UHtmlEncode(Self:aItems[nI, 1]) + '</a>')
NEXT
UWrite('</div>')
RETURN Self
//============================================================
CLASS UWBrowse
DATA cID
DATA aColumns INIT {}
DATA nArea
DATA nRecno
DATA lBof INIT .F.
DATA lEof INIT .F.
METHOD AddColumn()
METHOD Paint()
METHOD PaintBody()
METHOD Ajax()
METHOD Skipper()
ENDCLASS
FUNC UWBrowseNew(cID)
LOCAL oW := UWBrowse()
SetWId(oW, cID)
oW:nArea := SELECT()
RETURN oW
METHOD AddColumn(nID, cTitle, cField, lRaw) CLASS UWBrowse
AADD(Self:aColumns, {nID, cTitle, cField, !EMPTY(lRaw)})
RETURN Self
METHOD Paint() CLASS UWBrowse
UWrite('<div id="' + Self:cID + '">')
Self:PaintBody()
UWrite('</div>')
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('<a href="" onclick="ubrcall(' + "'" + Self:cID + "','action=prevpg');return false;" + '">&lt;</a> ')
ELSE
UWrite('&lt; ')
ENDIF
IF ! Self:lEof
UWrite('<a href="" onclick="ubrcall(' + "'" + Self:cID + "','action=nextpg');return false;" + '">&gt;</a> ')
ELSE
UWrite('&gt; ')
ENDIF
UWrite('<table class="ubr"><tr>')
// Header
UWrite('<tr>')
FOR nI := 1 TO LEN(Self:aColumns)
UWrite('<th>' + UHtmlEncode(Self:aColumns[nI, 2]) + '</th>')
NEXT
UWrite('</tr>')
// Body
DBGOTO(Self:nRecno)
FOR nI := 1 TO 20
IF EOF(); EXIT
ENDIF
UWrite('<tr>')
FOR nJ := 1 TO LEN(Self:aColumns)
xField := Self:aColumns[nJ, 3]
IF VALTYPE(xField) == "C"
xI := FIELDGET(FIELDPOS(xField))
ELSEIF VALTYPE(xField) == "B"
xI := EVAL(xField)
ENDIF
IF VALTYPE(xI) == "C"; xI := TRIM(xI)
ELSEIF VALTYPE(xI) == "N"; xI := STR(xI)
ELSEIF VALTYPE(xI) == "D"; xI := DTOC(xI)
ELSE ; xI := "VALTYPE()==" + VALTYPE(xI)
ENDIF
IF ! Self:aColumns[nJ, 4]
xI := UHtmlEncode(xI)
ENDIF
UWrite('<td><nobr>' + xI + '</nobr></td>')
NEXT
UWrite('</tr>')
DBSKIP()
NEXT
UWrite('</table>')
DBSELECTAREA(nArea)
RETURN Self
METHOD Ajax(cAction) CLASS UWBrowse
LOCAL nI, nJ, aI, aJ, xI
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.
ENDIF
ENDIF
Self:nRecno := RECNO()
RETURN Self
/********************************************************************
*
* Default procedure handlers
*
********************************************************************/
PROC UProcWidgets(cURL, aMap)
LOCAL aStack, aURL, aFrame, cI, nI, nL, lRet
? "cURL:", cURL
IF HB_HHasKey(aMap, cURL)
// aStack[i] = {url_part, function, variables}
IF (aStack := HGetDef(session, "_ustack")) == NIL
session["_ustack"] := aStack := {}
ENDIF
aURL := split("/", cURL)
nI := 1
nL := MIN(LEN(aURL), LEN(aStack))
DO WHILE nI <= nL
IF aStack[nI, 1] == aURL[nI]
nI++
ELSE
EXIT
ENDIF
ENDDO
// Exit procedures
DO WHILE nI <= LEN(aStack)
aFrame := ATAIL(aStack)
IF aFrame[2] != NIL
session["_uthis"] := aFrame[3]
EVAL(aFrame[2], "EXIT")
session["_uthis"] := NIL
ENDIF
ASIZE(aStack, LEN(aStack) - 1)
ENDDO
aFrame := NIL
lRet := .T.
// Enter procedures
DO WHILE nI <= LEN(aURL)
cI := join("/", ASIZE(ACLONE(aURL), nI))
IF HB_HHasKey(aMap, cI)
session["_uthis"] := {"idhash"=>{=>}}
IF (lRet := EVAL(aMap[cI], "INIT")) == .T.
AADD(aStack, {aURL[nI], aMap[cI], session["_uthis"]})
session["_uthis"] := NIL
ELSE
session["_uthis"] := NIL
EXIT
ENDIF
ELSE
AADD(aStack, {aURL[nI], NIL, NIL})
ENDIF
nI++
ENDDO
IF lRet
session["_uthis"] := ATAIL(aStack)[3]
IF server["REQUEST_METHOD"] == "GET"
EVAL(ATAIL(aStack)[2], "GET")
ELSEIF server["REQUEST_METHOD"] == "POST"
EVAL(ATAIL(aStack)[2], "POST")
ENDIF
ATAIL(aStack)[3] := session["_uthis"]
session["_uthis"] := NIL
ENDIF
ELSE
USetStatusCode(404)
ENDIF
RETURN
PROC UWDefaultHandler(cMethod)
LOCAL cID, oW
IF cMethod == "GET"
IF (cID := HGetDef(get, "ajax")) == NIL
session["_uthis", "main"]:Paint()
ELSE
IF (oW := GetWidgetById(cID)) != NIL
UAddHeader("Content-type", "text/html; charset=windows-1257")
oW:Ajax(HGetDef(get, "action"))
ENDIF
ENDIF
ENDIF
RETURN
STATIC PROC SetWId(oW, cID)
IF cID != NIL
oW:cID := cID
session["_uthis", "idhash", cID] := oW
ENDIF
RETURN
FUNC GetWidgetById(cID)
RETURN HGetDef(session["_uthis", "idhash"], cID)