diff --git a/harbour/ChangeLog b/harbour/ChangeLog index bf68ab50f4..d59e71fb10 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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. diff --git a/harbour/examples/httpsrv/cgifunc.prg b/harbour/examples/httpsrv/cgifunc.prg index b1a2d4b5b4..5ddeed8710 100644 --- a/harbour/examples/httpsrv/cgifunc.prg +++ b/harbour/examples/httpsrv/cgifunc.prg @@ -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 * 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 + diff --git a/harbour/examples/httpsrv/cookie.prg b/harbour/examples/httpsrv/cookie.prg index 1d1973760f..301571622d 100644 --- a/harbour/examples/httpsrv/cookie.prg +++ b/harbour/examples/httpsrv/cookie.prg @@ -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 * www - http://www.harbour-project.org diff --git a/harbour/examples/httpsrv/httpsrv.hbp b/harbour/examples/httpsrv/httpsrv.hbp new file mode 100644 index 0000000000..97104adbd3 --- /dev/null +++ b/harbour/examples/httpsrv/httpsrv.hbp @@ -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 diff --git a/harbour/examples/httpsrv/readme.txt b/harbour/examples/httpsrv/readme.txt index f7b5756324..9f76b76ef4 100644 --- a/harbour/examples/httpsrv/readme.txt +++ b/harbour/examples/httpsrv/readme.txt @@ -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. diff --git a/harbour/examples/httpsrv/session.prg b/harbour/examples/httpsrv/session.prg index 4131d32a21..fa02e571dd 100644 --- a/harbour/examples/httpsrv/session.prg +++ b/harbour/examples/httpsrv/session.prg @@ -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 * www - http://www.harbour-project.org diff --git a/harbour/examples/httpsrv/httpsrv.ini b/harbour/examples/httpsrv/uhttpd.ini similarity index 95% rename from harbour/examples/httpsrv/httpsrv.ini rename to harbour/examples/httpsrv/uhttpd.ini index aa53cf7dd9..00eb8830fb 100644 --- a/harbour/examples/httpsrv/httpsrv.ini +++ b/harbour/examples/httpsrv/uhttpd.ini @@ -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 # 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 + diff --git a/harbour/examples/httpsrv/httpsrv.prg b/harbour/examples/httpsrv/uhttpd.prg similarity index 99% rename from harbour/examples/httpsrv/httpsrv.prg rename to harbour/examples/httpsrv/uhttpd.prg index 35de173b1a..5750e65f85 100644 --- a/harbour/examples/httpsrv/httpsrv.prg +++ b/harbour/examples/httpsrv/uhttpd.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * HTTPSRV (Micro HTTP server) + * uHTTPD (Micro HTTP server) * * Copyright 2009 Francesco Saverio Giudice * 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. diff --git a/harbour/examples/httpsrv/httpsrvc.c b/harbour/examples/httpsrv/uhttpdc.c similarity index 98% rename from harbour/examples/httpsrv/httpsrvc.c rename to harbour/examples/httpsrv/uhttpdc.c index b42a3f3f14..349186380d 100644 --- a/harbour/examples/httpsrv/httpsrvc.c +++ b/harbour/examples/httpsrv/uhttpdc.c @@ -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 * Copyright 2008 Mindaugas Kavaliauskas (dbtopas at dbtopas.lt) diff --git a/harbour/examples/httpsrv/httpsrvg.hbp b/harbour/examples/httpsrv/uhttpdgd.hbp similarity index 69% rename from harbour/examples/httpsrv/httpsrvg.hbp rename to harbour/examples/httpsrv/uhttpdgd.hbp index 327e13805c..8d9b592740 100644 --- a/harbour/examples/httpsrv/httpsrvg.hbp +++ b/harbour/examples/httpsrv/uhttpdgd.hbp @@ -2,9 +2,7 @@ # $Id$ # -# httpsrv with GD support - -@httpd.hbp +@uhttpd.hbp -DGD_SUPPORT -lhbgd -lhbct -lbgd{win} diff --git a/harbour/examples/uhttpd2/app.prg b/harbour/examples/uhttpd2/app.prg new file mode 100644 index 0000000000..a0e9310ba9 --- /dev/null +++ b/harbour/examples/uhttpd2/app.prg @@ -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. diff --git a/harbour/examples/uhttpd2/carts.dbf b/harbour/examples/uhttpd2/carts.dbf new file mode 100644 index 0000000000..bcf5a43bdb Binary files /dev/null and b/harbour/examples/uhttpd2/carts.dbf differ diff --git a/harbour/examples/uhttpd2/files/main.css b/harbour/examples/uhttpd2/files/main.css new file mode 100644 index 0000000000..fb9f2f99f2 --- /dev/null +++ b/harbour/examples/uhttpd2/files/main.css @@ -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; +} \ No newline at end of file diff --git a/harbour/examples/uhttpd2/files/main.js b/harbour/examples/uhttpd2/files/main.js new file mode 100644 index 0000000000..65d0965d3c --- /dev/null +++ b/harbour/examples/uhttpd2/files/main.js @@ -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); +} + diff --git a/harbour/examples/uhttpd2/items.dbf b/harbour/examples/uhttpd2/items.dbf new file mode 100644 index 0000000000..c85d5d1302 Binary files /dev/null and b/harbour/examples/uhttpd2/items.dbf differ diff --git a/harbour/examples/uhttpd2/readme.txt b/harbour/examples/uhttpd2/readme.txt new file mode 100644 index 0000000000..88798d6afe --- /dev/null +++ b/harbour/examples/uhttpd2/readme.txt @@ -0,0 +1,399 @@ +/* + * $Id$ + */ + +Date: Fri, 12 Jun 2009 19:47:37 +0300 +From: Mindaugas Kavaliauskas +To: "Harbour Project Main Developer List." +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('') + DO WHILE ! EOF() + UWrite('') + DBSKIP() + ENDDO + UWrite('
' + FIELD->NAME + '' + + STR(FIELD->AGE) + '
') + +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: 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. diff --git a/harbour/examples/uhttpd2/socket.c b/harbour/examples/uhttpd2/socket.c new file mode 100644 index 0000000000..b36fd64841 --- /dev/null +++ b/harbour/examples/uhttpd2/socket.c @@ -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 +#define socklen_t int +#define SHUT_RDWR SD_BOTH +#else +#include +#include +#include +#include +#include +#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 ); +} diff --git a/harbour/examples/uhttpd2/uhbext.prg b/harbour/examples/uhttpd2/uhbext.prg new file mode 100644 index 0000000000..8d56898e85 --- /dev/null +++ b/harbour/examples/uhttpd2/uhbext.prg @@ -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 diff --git a/harbour/examples/uhttpd2/uhttpd2.hbp b/harbour/examples/uhttpd2/uhttpd2.hbp new file mode 100644 index 0000000000..255bb60df8 --- /dev/null +++ b/harbour/examples/uhttpd2/uhttpd2.hbp @@ -0,0 +1,9 @@ +# +# $Id$ +# + +-ouhttpd2 +*.prg +*.c +-mt +-gui diff --git a/harbour/examples/uhttpd2/umain.prg b/harbour/examples/uhttpd2/umain.prg new file mode 100644 index 0000000000..806d4aa71a --- /dev/null +++ b/harbour/examples/uhttpd2/umain.prg @@ -0,0 +1,1047 @@ +/* + * $Id$ + */ + +#include "hbclass.ch" +#include "common.ch" +#include "fileio.ch" +#include "error.ch" + +#pragma -kM+ + +/* + Docs: + + RFC 1945 - Hypertext Transfer Protocol -- HTTP/1.0 + RFC 2616 - Hypertext Transfer Protocol -- HTTP/1.1 + HTTP Made Really Easy (http://www.jmarshall.com/easy/http/) +*/ + + +#define AF_INET 2 +#define THREAD_COUNT_PREALLOC 0 +#define THREAD_COUNT_MAX 50 +#define SESSION_TIMEOUT 600 + +#define CR_LF (CHR(13)+CHR(10)) + +THREAD STATIC s_cResult, s_nStatusCode, s_aHeader, s_lSessionDestroy + +MEMVAR server, get, post, cookie, session + + +INIT PROC SocketInit() + IF socket_init() != 0 + ? "socket_init() error" + ENDIF +RETURN + + +EXIT PROC Socketxit() + socket_exit() +RETURN + + +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 bIdle INIT {|| NIL} + DATA aMount INIT {=>} + + // Results + DATA cError INIT "" + + // Private + DATA hAccessLog + DATA hErrorLog + + DATA hmtxQueue + DATA hmtxLog + DATA hmtxSession + + DATA hListen + DATA aSession + + DATA lStop + + METHOD Run() + METHOD Stop() + + // Private + METHOD LogAccess() + METHOD LogError() +ENDCLASS + + +FUNC UHttpdNew() +RETURN UHttpd() + + +METHOD Run() CLASS UHttpd +LOCAL hSocket, aRemote, nI, aThreads, aI + + IF ! HB_MTVM() + Self:cError := "Multithread support required" + RETURN .F. + ENDIF + + IF Self:nPort < 1 .OR. Self:nPort > 65535 + Self:cError := "Invalid port number" + RETURN .F. + ENDIF + + IF (Self:hAccessLog := FOPEN(Self:cAccessLog, FO_CREAT + FO_WRITE)) == -1 + Self:cError := "Access log file open error " + LTRIM(STR(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 " + LTRIM(STR(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 (Self:hListen := socket_create()) == NIL + Self:cError := "Socket create error " + LTRIM(STR(socket_error())) + FCLOSE(Self:hErrorLog) + FCLOSE(Self:hAccessLog) + RETURN .F. + ENDIF + + IF socket_bind(Self:hListen, {AF_INET, Self:cBindAddress, Self:nPort}) == -1 + Self:cError := "Bind error " + LTRIM(STR(socket_error())) + socket_close(Self:hListen) + FCLOSE(Self:hErrorLog) + FCLOSE(Self:hAccessLog) + RETURN .F. + ENDIF + + IF socket_listen(Self:hListen) == -1 + Self:cError := "Listen error " + LTRIM(STR(socket_error())) + socket_close(Self:hListen) + FCLOSE(Self:hErrorLog) + FCLOSE(Self:hAccessLog) + RETURN .F. + ENDIF + + aThreads := {} + FOR nI := 1 TO THREAD_COUNT_PREALLOC + AADD(aThreads, hb_threadStart(@ProcessConnection(), Self)) + NEXT + + Self:lStop := .F. + Self:aSession := {=>} + + DO WHILE .T. + IF (nI := socket_select({Self:hListen},,, 1000)) > 0 + hSocket := socket_accept(Self:hListen) + IF hSocket == NIL + Self:LogError("[error] Accept error " + LTRIM(STR(socket_error()))) + ELSE + ? "New connection", hSocket + ? "Waiters:", hb_mutexWaitersCount(Self:hmtxQueue) + IF hb_mutexWaitersCount(Self:hmtxQueue) < 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)) + ENDIF + hb_mutexNotify(Self:hmtxQueue, {hSocket, ""}) + ENDIF + ELSE + EVAL(Self:bIdle, Self) + IF Self:lStop; EXIT + ENDIF + ENDIF + ENDDO + socket_close(Self:hListen) + + // End child threads + hb_mutexLock(Self:hmtxSession) + HB_HEVAL(Self:aSession, {|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)}) + + FCLOSE(Self:hErrorLog) + FCLOSE(Self:hAccessLog) +RETURN .T. + + +METHOD Stop() CLASS UHttpd + Self:lStop := .T. +RETURN NIL + + +METHOD LogError(cError) CLASS UHttpd + hb_mutexLock(Self:hmtxLog) + FWRITE(Self:hErrorLog, DTOS(DATE()) + " " + TIME() + " " + cError + " " + HB_OSNewLine()) + hb_mutexUnlock(Self:hmtxLog) +RETURN NIL + + +METHOD LogAccess() CLASS UHttpd +LOCAL cDate := DTOS(DATE()), cTime := TIME() + hb_mutexLock(Self:hmtxLog) + FWRITE(Self:hAccessLog, ; + 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"] + '" ' + ; + LTRIM(STR(s_nStatusCode)) + " " + LTRIM(STR(LEN(s_cResult))) + ; + ' "' + server["HTTP_REFERER"] + '" "' + server["HTTP_USER_AGENT"] + ; + '"' + HB_OSNewLine()) + hb_mutexUnlock(Self:hmtxLog) +RETURN NIL + + +STATIC FUNC ProcessConnection(oServer) +LOCAL hSocket, cRequest, cSend, aI, nLen, nI, nReqLen, cBuf + + PRIVATE server, get, post, cookie + + DO WHILE .T. + hb_mutexSubscribe(oServer:hmtxQueue,, @aI) + IF aI == NIL + EXIT + ENDIF + + hSocket := aI[1] + cRequest := aI[2] + + BEGIN SEQUENCE + + /* receive query header */ + cRequest := "" + nLen := 1 + DO WHILE AT(CR_LF + CR_LF, cRequest) == 0 .AND. nLen > 0 + IF (nI := socket_select({hSocket},,, 10000)) > 0 /* Timeout */ + nLen := socket_recv(hSocket, @cBuf) + cRequest += cBuf + ELSE + nLen := 0 + ? "recv() timeout", hSocket + ENDIF + ENDDO + + IF nLen == -1 + ? "recv() error:", socket_error() + ELSEIF nLen == 0 /* connection closed */ + ELSE + + // PRIVATE + server := {=>} + get := {=>} + post := {=>} + cookie := {=>} + + s_cResult := "" + s_aHeader := {} + s_nStatusCode := 200 + + IF socket_getpeername(hSocket, @aI) != -1 + server["REMOTE_ADDR"] := aI[2] + server["REMOTE_HOST"] := server["REMOTE_ADDR"] // no reverse DNS + server["REMOTE_PORT"] := aI[3] + ENDIF + + IF socket_getsockname(hSocket, @aI) != -1 + server["SERVER_ADDR"] := aI[2] + server["SERVER_PORT"] := aI[3] + ENDIF + + ? LEFT(cRequest, AT(CR_LF + CR_LF, cRequest) + 1) + + nReqLen := ParseRequestHeader(@cRequest) + IF nReqLen == NIL + USetStatusCode(400) + ELSE + + /* receive query body */ + DO WHILE LEN(cRequest) < nReqLen .AND. nLen > 0 + nLen := socket_recv(hSocket, @cBuf) + cRequest += cBuf + ENDDO + + IF nLen == -1 + ? "recv() error:", socket_error() + ELSEIF nLen == 0 /* connection closed */ + ELSE + ? 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 + ENDIF + ENDIF + + 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 + ? "Close connection1", hSocket + socket_shutdown(hSocket) + socket_close(hSocket) + END SEQUENCE + ENDDO + DBCLOSEALL() +RETURN 0 + + +STATIC FUNC ProcessRequest(oServer, hSocket, cBuffer) +LOCAL nI, cMount, cPath, cSID, hmtx, aData, bEval + + PRIVATE session + + // Search mounting table + cMount := server["SCRIPT_NAME"] + IF HB_HHasKey(oServer:aMount, cMount) + cPath := "" + ELSE + nI := LEN(cMount) + DO WHILE (nI := HB_RAT("/", cMount,, nI)) > 0 + IF HB_HHasKey(oServer:aMount, LEFT(cMount, nI) + "*") + cMount := LEFT(cMount, nI) + "*" + cPath := SUBSTR(server["SCRIPT_NAME"], nI + 1) + EXIT + ENDIF + nI-- + ENDDO + ENDIF + + IF cMount != NIL + bEval := oServer:aMount[cMount, 1] + + IF oServer:aMount[cMount, 2] + /* sessioned */ + IF HB_HHasKey(cookie, "SESSID"); cSID := cookie["SESSID"] + ENDIF + + hb_mutexLock(oServer:hmtxSession) + IF cSID == NIL .OR. ! HB_HHasKey(oServer:aSession, cSID) + + /* create new session */ + + cSID := HB_MD5(DTOS(DATE()) + TIME() + STR(HB_RANDOM(), 15, 12)) + hmtx := hb_mutexCreate() + oServer:aSession[cSID] := {hb_threadSelf(), hmtx, {=>}} + + // PRIVATE + session := oServer:aSession[cSID, 3] + + hb_mutexUnlock(oServer:hmtxSession) + + DO WHILE .T. + s_cResult := "" + s_aHeader := {} + s_nStatusCode := 200 + s_lSessionDestroy := .F. + BEGIN SEQUENCE WITH {|oErr| UErrorHandler(oErr, oServer)} + EVAL(bEval, cPath) + RECOVER + USetStatusCode(500) + END SEQUENCE + + IF s_lSessionDestroy + UAddHeader("Set-Cookie", "SESSID=" + cSID + "; path=/; Max-Age=0") + ELSE + UAddHeader("Set-Cookie", "SESSID=" + cSID + "; path=/") + ENDIF + + 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) + + IF s_lSessionDestroy + /* Destroy session before closing socket, since graceful close requires some time */ + hb_mutexLock(oServer:hmtxSession) + HB_HDel(oServer:aSession, cSID) + hb_mutexUnlock(oServer:hmtxSession) + ENDIF + + IF LOWER(UGetHeader("Connection")) == "close" .OR. server["SERVER_PROTOCOL"] == "HTTP/1.0" + ? "Close connection2", hSocket + socket_shutdown(hSocket) + socket_close(hSocket) + ELSE + /* pass connection to common queue */ + hb_mutexNotify(oServer:hmtxQueue, {hSocket, cBuffer}) + ENDIF + + IF s_lSessionDestroy + EXIT + ENDIF + + IF ! hb_mutexSubscribe(hmtx, SESSION_TIMEOUT, @aData) .OR. aData == NIL + ? "Session exit" + hb_mutexLock(oServer:hmtxSession) + HB_HDel(oServer:aSession, 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 */ + ? "session pries", server["SCRIPT_NAME"] + hb_mutexNotify(oServer:aSession[cSID, 2], {hSocket, cBuffer, oServer:aMount[cMount, 1], cPath, server, get, post, cookie, oServer:aSession[cSID, 3]}) + hb_mutexUnlock(oServer:hmtxSession) + ENDIF + + RETURN .F. + ELSE + /* not sessioned */ + BEGIN SEQUENCE WITH {|oErr| UErrorHandler(oErr, oServer)} + EVAL(bEval, cPath) + RECOVER + USetStatusCode(500) + END SEQUENCE + ENDIF + ELSE + USetStatusCode(404) + ENDIF +RETURN .T. + + +STATIC FUNC ParseRequestHeader(cRequest) +LOCAL aRequest, aLine, nI, nJ, cI, nK, nContentLength := 0 + + aRequest := split(CR_LF, cRequest) + aLine := split(" ", 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 + ENDIF + + // Fix invalid queries: bind to root + 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) + ELSE + server["SCRIPT_NAME"] := server["REQUEST_URI"] + server["QUERY_STRING"] := "" + ENDIF + + server["HTTP_ACCEPT"] := "" + server["HTTP_ACCEPT_CHARSET"] := "" + server["HTTP_ACCEPT_ENCODING"] := "" + server["HTTP_ACCEPT_LANGUAGE"] := "" + server["HTTP_CONNECTION"] := "" + server["HTTP_HOST"] := "" + server["HTTP_KEEP_ALIVE"] := "" + server["HTTP_REFERER"] := "" + server["HTTP_USER_AGENT"] := "" + server["HTTP_CONTENT_TYPE"] := "" + + FOR nI := 2 TO LEN(aRequest) + IF aRequest[nI] == ""; EXIT + ELSEIF (nJ := AT(":", aRequest[nI])) > 0 + cI := ALLTRIM(SUBSTR(aRequest[nI], nJ + 1)) + SWITCH UPPER(LEFT(aRequest[nI], nJ - 1)) + CASE "COOKIE" + IF (nK := AT(";", cI)) == 0 + nK := LEN(TRIM(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) + ENDIF + EXIT + CASE "CONTENT-LENGTH" + nContentLength := VAL(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 split("&", server["QUERY_STRING"]) + IF (nI := AT("=", cI)) > 0 + get[UUrlDecode(LEFT(cI, nI - 1))] := UUrlDecode(SUBSTR(cI, nI + 1)) + ELSE + get[UUrlDecode(cI)] := NIL + ENDIF + NEXT + ENDIF + cRequest := SUBSTR(cRequest, AT(CR_LF + CR_LF, cRequest) + 4) +RETURN nContentLength + + +STATIC FUNC ParseRequestBody(cRequest) +LOCAL nI, cPart + + IF server["HTTP_CONTENT_TYPE"] == "application/x-www-form-urlencoded" + FOR EACH cPart IN split("&", 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 +RETURN NIL + + +STATIC FUNC MakeResponse() +LOCAL cRet + + 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 ") + SWITCH s_nStatusCode + CASE 200 + cRet += "200 OK" + EXIT + CASE 301 + cRet += "301 Moved Permanently" + s_cResult := "

301 Moved Permanently

" + EXIT + CASE 302 + cRet += "302 Found" + s_cResult := "

302 Found

" + EXIT + CASE 303 + cRet += "303 See Other" + s_cResult := "

303 See Other

" + EXIT + CASE 304 + cRet += "304 Not Modified" + s_cResult := "

304 Not Modified

" + EXIT + CASE 400 + cRet += "400 Bad Request" + s_cResult := "

400 Bad Request

" + UAddHeader("Connection", "close") + EXIT + CASE 401 + cRet += "401 Unauthorized" + s_cResult := "

401 Unauthorized

" + EXIT + CASE 402 + cRet += "402 Payment Required" + s_cResult := "

402 Payment Required

" + EXIT + CASE 403 + cRet += "403 Forbidden" + s_cResult := "

403 Forbidden

" + EXIT + CASE 404 + cRet += "404 Not Found" + s_cResult := "

404 Not Found

" + EXIT + CASE 412 + cRet += "412 Precondition Failed" + s_cResult := "

412 Precondition Failed

" + EXIT + CASE 500 + cRet += "500 Internal Server Error" + s_cResult := "

500 Internal Server Error

" + EXIT + CASE 501 + cRet += "501 Not Implemented" + s_cResult := "

501 Not Implemented

" + UAddHeader("Connection", "close") + EXIT + OTHERWISE + cRet += "500 Internal Server Error" + s_cResult := "

500 Internal Server Error

" + UAddHeader("Connection", "close") + ENDSWITCH + cRet += CR_LF + UAddHeader("Content-Length", LTRIM(STR(LEN(s_cResult)))) + AEVAL(s_aHeader, {|x| cRet += x[1] + ": " + x[2] + CR_LF}) + cRet += CR_LF + ? cRet + cRet += s_cResult +RETURN cRet + + +STATIC PROC SendResponse(oServer, hSocket) +LOCAL cSend, nLen, cBuf + cSend := MakeResponse() + +// ? cSend + + DO WHILE LEN(cSend) > 0 + IF (nLen := socket_send(hSocket, cSend)) == -1 + ? "send() error:", socket_error(), hSocket + EXIT + ELSEIF nLen > 0 + cSend := SUBSTR(cSend, nLen + 1) + ENDIF + ENDDO + oServer:LogAccess() +RETURN + + +STATIC FUNC HttpDateFormat(tDate) +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 + + +STATIC FUNC HttpDateUnformat(cDate, tDate) +LOCAL nMonth + // 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) + ENDIF + ENDIF +RETURN .F. + + +STATIC FUNC UErrorHandler(oErr, oServer) + IF oErr:genCode == EG_ZERODIV; RETURN 0 + ELSEIF oErr:genCode == EG_LOCK; RETURN .T. + ELSEIF (oErr:genCode == EG_OPEN .AND. oErr:osCode == 32 .OR. ; + oErr:genCode == EG_APPENDLOCK) .AND. oErr:canDefault + NETERR(.T.) + RETURN .F. + ENDIF + oServer:LogError(GetErrorDesc(oErr)) + BREAK(oErr) +RETURN NIL + + +STATIC FUNC GetErrorDesc(oErr) +LOCAL cRet, nI + cRet := "ERRORLOG ============================================================" + HB_OSNewLine() + ; + "Error: " + oErr:subsystem + "/" + ErrDescCode(oErr:genCode) + "(" + LTRIM(STR(oErr:genCode)) + ") " + ; + LTRIM(STR(oErr:subcode)) + HB_OSNewLine() + IF !EMPTY(oErr:filename); cRet += "File: " + oErr:filename + HB_OSNewLine() + ENDIF + IF !EMPTY(oErr:description); cRet += "Description: " + oErr:description + HB_OSNewLine() + ENDIF + IF !EMPTY(oErr:operation); cRet += "Operacija: " + oErr:operation + HB_OSNewLine() + ENDIF + IF !EMPTY(oErr:osCode); cRet += "OS error: " + LTRIM(STR(oErr:osCode)) + HB_OSNewLine() + ENDIF + IF VALTYPE(oErr:args) == "A" + cRet += "Arguments:" + HB_OSNewLine() + AEVAL(oErr:args, {|X, Y| cRet += STR(Y, 5) + ": " + HB_CStr(X) + HB_OSNewLine()}) + ENDIF + cRet += HB_OSNewLine() + + cRet += "Stack:" + HB_OSNewLine() + nI := 2 + DO WHILE ! EMPTY(PROCNAME(++nI)) + cRet += " " + PROCNAME(nI) + "(" + LTRIM(STR(PROCLINE(nI))) + ")" + HB_OSNewLine() + ENDDO + cRet += HB_OSNewLine() + + cRet += "Executable: " + HB_PROGNAME() + HB_OSNewLine() + cRet += "Versions:" + HB_OSNewLine() + cRet += " OS: " + OS() + HB_OSNewLine() + cRet += " Harbour: " + VERSION() + ", " + HB_BUILDDATE() + HB_OSNewLine() + cRet += HB_OSNewLine() + + IF oErr:genCode != EG_MEM + cRet += "Database areas:" + HB_OSNewLine() + cRet += " Current: " + LTRIM(STR(SELECT())) + " " + ALIAS() + HB_OSNewLine() + + BEGIN SEQUENCE WITH {|o| BREAK(o)} + IF !EMPTY(ALIAS()) + cRet += " Filter: " + DBFILTER() + HB_OSNewLine() + cRet += " Relation: " + DBRELATION() + HB_OSNewLine() + cRet += " Index expression: " + ORDKEY(ORDSETFOCUS()) + HB_OSNewLine() + cRet += HB_OSNewLine() + BEGIN SEQUENCE WITH {|o| BREAK(o)} + FOR nI := 1 to FCOUNT() + cRet += STR(nI, 6) + " " + PADR(FIELDNAME(nI), 14) + ": " + HB_VALTOEXP(FIELDGET(nI)) + HB_OSNewLine() + NEXT + RECOVER + cRet += "!!! Error reading database fields !!!" + HB_OSNewLine() + END SEQUENCE + cRet += HB_OSNewLine() + ENDIF + RECOVER + cRet += "!!! Error accessing current workarea !!!" + HB_OSNewLine() + END SEQUENCE + + FOR nI := 1 to 250 + BEGIN SEQUENCE WITH {|o| BREAK(o)} + IF ! EMPTY(ALIAS(nI)) + DBSELECTAREA(nI) + cRet += STR(nI, 6) + " " + RDDNAME() + " " + PADR(ALIAS(), 15) + ; + STR(RECNO()) + "/" + STR(LASTREC()) + ; + IIF(EMPTY(ORDSETFOCUS()), "", " Index " + ORDSETFOCUS() + "(" + LTRIM(STR(ORDNUMBER())) + ")") + HB_OSNewLine() + DBCLOSEAREA() + ENDIF + RECOVER + cRet += "!!! Error accessing workarea number: " + STR(nI, 4) + "!!!" + HB_OSNewLine() + END SEQUENCE + NEXT + cRet += HB_OSNewLine() + ENDIF +RETURN cRet + + +STATIC FUNC 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 + ENDIF +RETURN IF(cI == NIL, "", "EG_" + cI) + + +/******************************************************************** + Public functions +********************************************************************/ +PROC USetStatusCode(nStatusCode) + s_nStatusCode := nStatusCode +RETURN + + +FUNC UGetHeader(cType) +LOCAL nI + + IF (nI := ASCAN(s_aHeader, {|x| UPPER(x[1]) == UPPER(cType)})) > 0 + RETURN s_aHeader[nI, 2] + ENDIF +RETURN NIL + + +PROC UAddHeader(cType, cValue) +LOCAL nI + + IF (nI := ASCAN(s_aHeader, {|x| UPPER(x[1]) == UPPER(cType)})) > 0 + s_aHeader[nI, 2] := cValue + ELSE + AADD(s_aHeader, {cType, cValue}) + ENDIF +RETURN + + +PROC URedirect(cURL, nCode) + IF nCode == NIL; nCode := 303 + ENDIF + USetStatusCode(nCode) + UAddHeader("Location", cURL) +RETURN + + +PROC USessionDestroy() + s_lSessionDestroy := .T. +RETURN + + +PROC UWrite(cString) + s_cResult += cString +RETURN + + +FUNC UOsFileName(cFileName) + IF HB_OSPathSeparator() != "/" + RETURN STRTRAN(cFileName, "/", HB_OSPathSeparator()) + ENDIF +RETURN cFileName + + +FUNC UHtmlEncode(cString) +LOCAL nI, cI, cRet := "" + + FOR nI := 1 TO LEN(cString) + cI := SUBSTR(cString, nI, 1) + IF cI == "<" + cRet += "<" + ELSEIF cI == ">" + cRet += ">" + ELSEIF cI == "&" + cRet += "&" + ELSEIF cI == '"' + cRet += """ + ELSE + cRet += cI + ENDIF + NEXT +RETURN cRet + + +FUNC UUrlEncode(cString) +LOCAL nI, cI, cRet := "" + + FOR nI := 1 TO LEN(cString) + cI := SUBSTR(cString, nI, 1) + IF cI == " " + cRet += "+" + ELSEIF ASC(cI) >= 127 .OR. ASC(cI) <= 31 .OR. cI $ '=&%+' + cRet += "%" + HB_StrToHex(cI) + ELSE + cRet += cI + ENDIF + NEXT +RETURN cRet + + +FUNC UUrlDecode(cString) +LOCAL nI + cString := STRTRAN(cString, "+", " ") + nI := 1 + DO WHILE nI <= LEN(cString) + nI := HB_AT("%", cString, nI) + IF nI == 0; EXIT + ENDIF + IF UPPER(SUBSTR(cString, nI + 1, 1)) $ "0123456789ABCDEF" .AND. ; + UPPER(SUBSTR(cString, nI + 2, 1)) $ "0123456789ABCDEF" + cString := STUFF(cString, nI, 3, HB_HexToStr(SUBSTR(cString, nI + 1, 2))) + ENDIF + nI++ + ENDDO +RETURN cString + + +FUNC ULink(cText, cURL) +RETURN '' + UHtmlEncode(cText) + '' + + +PROC UProcFiles(cFileName, lIndex) +LOCAL aDir, aF, nI, cI, tDate, tHDate + + IF lIndex == NIL; lIndex := .F. + ENDIF + + cFileName := STRTRAN(cFileName, "//", "/") + + // Security + IF "/../" $ cFileName + USetStatusCode(403) + RETURN + ENDIF + + IF HB_FileExists(uOSFileName(cFileName)) + 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 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) + ELSE + IF (nI := RAT(".", cFileName)) > 0 + SWITCH LOWER(SUBSTR(cFileName, nI + 1)) + CASE "css"; cI := "text/css"; EXIT + CASE "htm"; CASE "html"; cI := "text/html"; EXIT + CASE "txt"; CASE "text"; CASE "asc" + CASE "c"; CASE "h"; CASE "cpp" + CASE "hpp"; CASE "log"; cI := "text/plain"; EXIT + CASE "rtf"; cI := "text/rtf"; EXIT + CASE "xml"; cI := "text/xml"; EXIT + CASE "bmp"; cI := "image/bmp"; EXIT + CASE "gif"; cI := "image/gif"; EXIT + CASE "jpg"; CASE "jpe"; CASE "jpeg"; cI := "image/jpeg"; EXIT + CASE "png"; cI := "image/png"; EXIT + CASE "tif"; CASE "tiff"; cI := "image/tiff"; EXIT + CASE "djv"; CASE "djvu"; cI := "image/vnd.djvu"; EXIT + CASE "ico"; cI := "image/x-icon"; EXIT + CASE "xls"; cI := "application/excel"; EXIT + CASE "doc"; cI := "application/msword"; EXIT + CASE "pdf"; cI := "application/pdf"; EXIT + CASE "ps"; CASE "eps"; cI := "application/postscript"; EXIT + CASE "ppt"; cI := "application/powerpoint"; EXIT + CASE "bz2"; cI := "application/x-bzip2"; EXIT + CASE "gz"; cI := "application/x-gzip"; EXIT + CASE "tgz"; cI := "application/x-gtar"; EXIT + CASE "js"; cI := "application/x-javascript"; EXIT + CASE "tar"; cI := "application/x-tar"; EXIT + CASE "tex"; cI := "application/x-tex"; EXIT + CASE "zip"; cI := "application/zip"; EXIT + CASE "midi"; cI := "audio/midi"; EXIT + CASE "mp3"; cI := "audio/mpeg"; EXIT + CASE "wav"; cI := "audio/x-wav"; EXIT + CASE "qt"; CASE "mov"; cI := "video/quicktime"; EXIT + CASE "avi"; cI := "video/x-msvideo"; EXIT + OTHERWISE + cI := "application/octet-stream" + ENDSWITCH + ELSE + cI := "application/octet-stream" + ENDIF + UAddHeader("Content-Type", cI) + + IF HB_FGETDATETIME(UOsFileName(cFileName), @tDate) + UAddHeader("Last-Modified", HttpDateFormat(tDate)) + ENDIF + + UWrite(HB_MEMOREAD(UOsFileName(cFileName))) + ENDIF + ELSEIF HB_DirExists(UOsFileName(cFileName)) + IF RIGHT(cFileName, 1) != "/" + URedirect("http://" + server["HTTP_HOST"] + server["SCRIPT_NAME"] + "/") + RETURN + ENDIF + IF (nI := ASCAN({"index.html", "index.htm"}, ; + {|x| IIF(HB_FileExists(UOSFileName(cFileName + X)), (cFileName += X, .T.), .F.)})) > 0 + UAddHeader("Content-Type", "text/html") + UWrite(HB_MEMOREAD(UOsFileName(cFileName))) + RETURN + ENDIF + IF ! lIndex + USetStatusCode(403) + RETURN + ENDIF + + UAddHeader("Content-Type", "text/html") + + aDir := DIRECTORY(UOsFileName(cFileName), "D") + IF HB_HHasKey(get, "s") + IF get["s"] == "s" + ASORT(aDir,,, {|X,Y| IF(X[5] == "D", IF(Y[5] == "D", X[1] < Y[1], .T.), ; + IF(Y[5] == "D", .F., X[2] < Y[2]))}) + ELSEIF get["s"] == "m" + ASORT(aDir,,, {|X,Y| IF(X[5] == "D", IF(Y[5] == "D", X[1] < Y[1], .T.), ; + IF(Y[5] == "D", .F., DTOS(X[3]) + X[4] < DTOS(Y[3]) + Y[4]))}) + ELSE + ASORT(aDir,,, {|X,Y| IF(X[5] == "D", IF(Y[5] == "D", X[1] < Y[1], .T.), ; + IF(Y[5] == "D", .F., X[1] < Y[1]))}) + ENDIF + ELSE + ASORT(aDir,,, {|X,Y| IF(X[5] == "D", IF(Y[5] == "D", X[1] < Y[1], .T.), ; + IF(Y[5] == "D", .F., X[1] < Y[1]))}) + ENDIF + + UWrite('

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

      ')
+    UWrite('Name                                                  ')
+    UWrite('Modified             ')
+    UWrite('Size' + CR_LF + '
')
+    FOR EACH aF IN aDir
+      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)
+      ENDIF
+    NEXT
+    UWrite("
") + ELSE + USetStatusCode(404) + ENDIF +RETURN + + +PROC UProcInfo() + UWrite('

Info

') + + UWrite('

Platform

') + UWrite('') + UWrite('') + UWrite('') + UWrite('') + UWrite('') + UWrite('
OS' + UHtmlEncode(OS()) + '
Harbour' + UHtmlEncode(VERSION()) + '
Build date' + UHtmlEncode(HB_BUILDDATE()) + '
Compiler' + UHtmlEncode(HB_COMPILER()) + '
') + + UWrite('

Capabilities

') + UWrite('') + UWrite('') + UWrite('
RDD' + UHtmlEncode(join(", ", RDDLIST())) + '
') + + UWrite('

Variables

') + + UWrite('

server

') + UWrite('') + HB_HEval(server, {|k,v| UWrite('')}) + UWrite('
' + k + '' + UHtmlEncode(HB_CStr(v)) + '
') + + IF !EMPTY(get) + UWrite('

get

') + UWrite('') + HB_HEval(get, {|k,v| UWrite('')}) + UWrite('
' + k + '' + UHtmlEncode(HB_CStr(v)) + '
') + ENDIF + + IF !EMPTY(post) + UWrite('

post

') + UWrite('') + HB_HEval(post, {|k,v| UWrite('')}) + UWrite('
' + k + '' + UHtmlEncode(HB_CStr(v)) + '
') + ENDIF +RETURN diff --git a/harbour/examples/uhttpd2/users.dbf b/harbour/examples/uhttpd2/users.dbf new file mode 100644 index 0000000000..3c17bc3dc7 Binary files /dev/null and b/harbour/examples/uhttpd2/users.dbf differ diff --git a/harbour/examples/uhttpd2/uwidgets.prg b/harbour/examples/uhttpd2/uwidgets.prg new file mode 100644 index 0000000000..f35a14017e --- /dev/null +++ b/harbour/examples/uhttpd2/uwidgets.prg @@ -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('') + UWrite('') + UWrite('') + UWrite('') + AEVAL(Self:aChilds, {|x| X:Paint()}) + UWrite('') +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('') + FOR EACH aRow IN Self:aChilds + UWrite('') + FOR EACH aCell IN aRow + UWrite('') + NEXT + UWrite('') + NEXT + UWrite('
') + AEVAL(aCell, {|o| o:Paint()}) + UWrite('
') +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('' + ; + UHtmlEncode(Self:cText) + '') +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('
') + AEVAL(Self:aChilds, {|x| X:Paint()}) + UWrite('
') +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('') +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('') +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('') +RETURN Self + + +//============================================================ +CLASS UWSeparator + METHOD Paint() +ENDCLASS + + +FUNC UWSeparatorNew() +LOCAL oW := UWSeparator() +RETURN oW + + +METHOD Paint() CLASS UWSeparator + UWrite('
') +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('
') + FOR nI := 1 TO LEN(Self:aItems) + IF nI != 1 + UWrite(' | ') + ENDIF + UWrite('' + UHtmlEncode(Self:aItems[nI, 1]) + '') + NEXT + UWrite('
') +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('
') + Self:PaintBody() + UWrite('
') +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('') + + // Header + UWrite('') + FOR nI := 1 TO LEN(Self:aColumns) + UWrite('') + NEXT + UWrite('') + + // 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] + 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('') + NEXT + UWrite('') + DBSKIP() + NEXT + UWrite('
' + UHtmlEncode(Self:aColumns[nI, 2]) + '
' + xI + '
') + 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)