From afa82f20e176a0cfd975cafbdba8fcedddca037c Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 24 Nov 2010 00:09:54 +0000 Subject: [PATCH] 2010-11-24 01:09 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * examples/uhttpd2/uhttpd2.hbp * Converted uhttpd2 core to a lib. + examples/uhttpd2/uhttpd2.hbc + Added .hbc file. * examples/uhttpd2/umain.prg * examples/uhttpd2/uwidgets.prg * examples/uhttpd2/uhbext.prg * examples/uhttpd2/app.prg * Formatted (with hbformat for the most part) * Minor cleanups. ! Fixed all -w3 warnings. + examples/uhttpd2/tests + examples/uhttpd2/tests/hbmk.hbm - examples/uhttpd2/carts.dbf - examples/uhttpd2/items.dbf - examples/uhttpd2/users.dbf + examples/uhttpd2/tests/carts.dbf + examples/uhttpd2/tests/items.dbf + examples/uhttpd2/tests/users.dbf - examples/uhttpd2/files + examples/uhttpd2/tests/files - examples/uhttpd2/app.prg + examples/uhttpd2/tests/webapp.prg + Added tests dir and moved app specific files there. --- harbour/ChangeLog | 29 + harbour/examples/uhttpd2/app.prg | 413 ---- .../examples/uhttpd2/{ => tests}/carts.dbf | Bin .../uhttpd2/{ => tests}/files/main.css | 0 .../uhttpd2/{ => tests}/files/main.js | 0 harbour/examples/uhttpd2/tests/hbmk.hbm | 7 + .../examples/uhttpd2/{ => tests}/items.dbf | Bin .../examples/uhttpd2/{ => tests}/users.dbf | Bin harbour/examples/uhttpd2/tests/webapp.prg | 431 +++++ harbour/examples/uhttpd2/uhbext.prg | 47 +- harbour/examples/uhttpd2/uhttpd2.hbc | 10 + harbour/examples/uhttpd2/uhttpd2.hbp | 10 +- harbour/examples/uhttpd2/umain.prg | 1718 +++++++++-------- harbour/examples/uhttpd2/uwidgets.prg | 780 ++++---- 14 files changed, 1810 insertions(+), 1635 deletions(-) delete mode 100644 harbour/examples/uhttpd2/app.prg rename harbour/examples/uhttpd2/{ => tests}/carts.dbf (100%) rename harbour/examples/uhttpd2/{ => tests}/files/main.css (100%) rename harbour/examples/uhttpd2/{ => tests}/files/main.js (100%) create mode 100644 harbour/examples/uhttpd2/tests/hbmk.hbm rename harbour/examples/uhttpd2/{ => tests}/items.dbf (100%) rename harbour/examples/uhttpd2/{ => tests}/users.dbf (100%) create mode 100644 harbour/examples/uhttpd2/tests/webapp.prg create mode 100644 harbour/examples/uhttpd2/uhttpd2.hbc diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ac1a0d9448..4767dc1ce6 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,35 @@ The license applies to all entries newer than 2009-04-28. */ +2010-11-24 01:09 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * examples/uhttpd2/uhttpd2.hbp + * Converted uhttpd2 core to a lib. + + + examples/uhttpd2/uhttpd2.hbc + + Added .hbc file. + + * examples/uhttpd2/umain.prg + * examples/uhttpd2/uwidgets.prg + * examples/uhttpd2/uhbext.prg + * examples/uhttpd2/app.prg + * Formatted (with hbformat for the most part) + * Minor cleanups. + ! Fixed all -w3 warnings. + + + examples/uhttpd2/tests + + examples/uhttpd2/tests/hbmk.hbm + - examples/uhttpd2/carts.dbf + - examples/uhttpd2/items.dbf + - examples/uhttpd2/users.dbf + + examples/uhttpd2/tests/carts.dbf + + examples/uhttpd2/tests/items.dbf + + examples/uhttpd2/tests/users.dbf + - examples/uhttpd2/files + + examples/uhttpd2/tests/files + - examples/uhttpd2/app.prg + + examples/uhttpd2/tests/webapp.prg + + Added tests dir and moved app specific files there. + 2010-11-23 23:58 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + contrib/hbposix/tests + contrib/hbposix/tests/hbmk.hbm diff --git a/harbour/examples/uhttpd2/app.prg b/harbour/examples/uhttpd2/app.prg deleted file mode 100644 index d0a383b753..0000000000 --- a/harbour/examples/uhttpd2/app.prg +++ /dev/null @@ -1,413 +0,0 @@ -/* - * $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.}} - - ? "Listening on port:", oServer:nPort - - 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(hb_HGetDef(post, "user", ""), 16) - IF !EMPTY(cUser) .AND. DBSEEK(cUser, .F.) .AND. ! DELETED() .AND. ; - PADR(hb_HGetDef(post, "password", ""), 16) == FIELD->PASSWORD - session["loggedin"] := cUser - URedirect("main") - ELSE - URedirect("login?err") - USessionDestroy() - ENDIF - DBCLOSEAREA() - ELSEIF cMethod == "GET" - IF HB_HHasKey(get, "err") - 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 := hb_HGetDef(post, "user", "") - cName := hb_HGetDef(post, "name", "") - cPassword := hb_HGetDef(post, "password", "") - cPassword2 := hb_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 := hb_HGetDef(post, "name", "") - cPassword := hb_HGetDef(post, "password", "") - cPassword2 := hb_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/tests/carts.dbf similarity index 100% rename from harbour/examples/uhttpd2/carts.dbf rename to harbour/examples/uhttpd2/tests/carts.dbf diff --git a/harbour/examples/uhttpd2/files/main.css b/harbour/examples/uhttpd2/tests/files/main.css similarity index 100% rename from harbour/examples/uhttpd2/files/main.css rename to harbour/examples/uhttpd2/tests/files/main.css diff --git a/harbour/examples/uhttpd2/files/main.js b/harbour/examples/uhttpd2/tests/files/main.js similarity index 100% rename from harbour/examples/uhttpd2/files/main.js rename to harbour/examples/uhttpd2/tests/files/main.js diff --git a/harbour/examples/uhttpd2/tests/hbmk.hbm b/harbour/examples/uhttpd2/tests/hbmk.hbm new file mode 100644 index 0000000000..f8d5f25cfb --- /dev/null +++ b/harbour/examples/uhttpd2/tests/hbmk.hbm @@ -0,0 +1,7 @@ +# +# $Id$ +# + +../uhttpd2.hbc + +-w3 -es2 diff --git a/harbour/examples/uhttpd2/items.dbf b/harbour/examples/uhttpd2/tests/items.dbf similarity index 100% rename from harbour/examples/uhttpd2/items.dbf rename to harbour/examples/uhttpd2/tests/items.dbf diff --git a/harbour/examples/uhttpd2/users.dbf b/harbour/examples/uhttpd2/tests/users.dbf similarity index 100% rename from harbour/examples/uhttpd2/users.dbf rename to harbour/examples/uhttpd2/tests/users.dbf diff --git a/harbour/examples/uhttpd2/tests/webapp.prg b/harbour/examples/uhttpd2/tests/webapp.prg new file mode 100644 index 0000000000..1c34e75f65 --- /dev/null +++ b/harbour/examples/uhttpd2/tests/webapp.prg @@ -0,0 +1,431 @@ +/* + * $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 + +FUNCTION 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. } } + + ? "Listening on port:", oServer:nPort + + IF ! oServer:Run() + ? "Server error:", oServer:cError + RETURN 1 + ENDIF + + RETURN 0 + +STATIC FUNCTION proc_login( cMethod ) + + LOCAL cUser, oM, oF, oG + + ? ProcName(), cMethod + IF cMethod == "INIT" + oM := UWMainNew() + oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) ) + oM:Add( oF := UWFormNew( "" ) ) + oF:Add( oG := UWLayoutGridNew() ) + oG:Add( UWHtmlNew( "User" ), 1, 1 ) + oG:Add( UWInputNew( "user" ), 1, 2 ) + oG:Add( UWHtmlNew( "Password" ), 2, 1 ) + oG:Add( UWPasswordNew( "password" ), 2, 2 ) + oG:Add( UWSubmitNew( "submit", "Login" ), 3, 2 ) + oM:Add( UWHtmlNew( ULink("Register", "register" ) ) ) + ELSEIF cMethod == "POST" + dbUseArea( .T. , , "users", "users", .T. , .T. ) + OrdSetFocus( "user" ) + cUser := PadR( hb_HGetDef( post, "user", "" ), 16 ) + IF !Empty( cUser ) .AND. dbSeek( cUser, .F. ) .AND. ! Deleted() .AND. ; + PadR( hb_HGetDef( post, "password", "" ), 16 ) == FIELD->PASSWORD + session[ "loggedin" ] := cUser + URedirect( "main" ) + ELSE + URedirect( "login?err" ) + USessionDestroy() + ENDIF + dbCloseArea() + ELSEIF cMethod == "GET" + IF HB_HHasKey( get, "err" ) + GetWidgetById( "errtxt" ):cText := "Invalid username or password!" + ENDIF + UWDefaultHandler( cMethod ) + USessionDestroy() + ENDIF + + RETURN .T. + +STATIC FUNCTION proc_register( cMethod ) + + LOCAL cUser, cName, cPassword, cPassword2, oM, oF, oG + + ? ProcName(), cMethod + IF cMethod == "INIT" + oM := UWMainNew() + oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) ) + oM:Add( oF := UWFormNew( "" ) ) + oF:Add( oG := UWLayoutGridNew() ) + oG:Add( UWHtmlNew( "User name" ), 1, 1 ) + oG:Add( UWInputNew( "user",, "user" ), 1, 2 ) + oG:Add( UWHtmlNew( "Name" ), 2, 1 ) + oG:Add( UWInputNew( "name",, "name" ), 2, 2 ) + oG:Add( UWHtmlNew( "Password" ), 3, 1 ) + oG:Add( UWPasswordNew( "password" ), 3, 2 ) + oG:Add( UWHtmlNew( "Password again" ), 4, 1 ) + oG:Add( UWPasswordNew( "password2" ), 4, 2 ) + oG:Add( UWSubmitNew( "register", "Register" ), 5, 2 ) + ELSEIF cMethod == "POST" + dbUseArea( .T. , , "users", "users", .T. , .F. ) + OrdSetFocus( "user" ) + cUser := hb_HGetDef( post, "user", "" ) + cName := hb_HGetDef( post, "name", "" ) + cPassword := hb_HGetDef( post, "password", "" ) + cPassword2 := hb_HGetDef( post, "password2", "" ) + 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 FUNCTION proc_account( cMethod ) + + LOCAL oM, oG + + ? ProcName(), cMethod + IF cMethod == "INIT" + IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F. + ENDIF + dbUseArea( .T. , , "users", "users", .T. , .F. ) + OrdSetFocus( "user" ) + ELSEIF cMethod == "GET" + dbSeek( session[ "loggedin" ], .F. ) + /* Create object here because user name can be changed in account/edit */ + oM := UWMainNew() + oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ):AddItem( "Cart", "cart" ):AddItem( "Logout", "logout" ) ) + oM:Add( UWSeparatorNew() ) + oM:Add( oG := UWLayoutGridNew() ) + oG:Add( UWHtmlNew( "User name:" ), 1, 1 ) + oG:Add( UWHtmlNew( session[ "loggedin" ] ), 1, 2 ) + oG:Add( UWHtmlNew( "Name:" ), 2, 1 ) + oG:Add( UWHtmlNew( NAME ), 2, 2 ) + oM:Add( UWHtmlNew( ULink("Edit", "account/edit" ) ) ) + UWDefaultHandler( cMethod ) + ELSEIF cMethod == "EXIT" + users->( dbCloseArea() ) + ENDIF + + RETURN .T. + +STATIC FUNCTION proc_account_edit( cMethod ) + + LOCAL cName, cPassword, cPassword2, oM, oG, oF + + ? ProcName(), cMethod + IF cMethod == "INIT" + IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F. + ENDIF + dbSeek( session[ "loggedin" ], .F. ) + oM := UWMainNew() + oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) ) + oM:Add( oF := UWFormNew( "" ) ) + oF:Add( oG := UWLayoutGridNew() ) + oG:Add( UWHtmlNew( "User name" ), 1, 1 ) + oG:Add( UWHtmlNew( session[ "loggedin" ] ), 1, 2 ) + oG:Add( UWHtmlNew( "Name" ), 2, 1 ) + oG:Add( UWInputNew( "name", RTrim( NAME ), "name" ), 2, 2 ) + oG:Add( UWHtmlNew( "Password" ), 3, 1 ) + oG:Add( UWPasswordNew( "password" ), 3, 2 ) + oG:Add( UWHtmlNew( "Password again" ), 4, 1 ) + oG:Add( UWPasswordNew( "password2" ), 4, 2 ) + oG:Add( UWSubmitNew( "save", "Save" ), 5, 2 ) + ELSEIF cMethod == "POST" + dbSeek( session[ "loggedin" ], .F. ) + cName := hb_HGetDef( post, "name", "" ) + cPassword := hb_HGetDef( post, "password", "" ) + cPassword2 := hb_HGetDef( post, "password2", "" ) + GetWidgetById( "name" ):cValue := RTrim( 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 FUNCTION proc_main( cMethod ) + + LOCAL oM + + ? ProcName(), cMethod + IF cMethod == "INIT" + IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F. + ENDIF + oM := UWMainNew() + oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ); + :AddItem( "Cart", "cart" ); + :AddItem( "My account", "account" ); + :AddItem( "Logout", "logout" ) ) + oM:Add( UWSeparatorNew() ) + oM:Add( UWLabelNew( "You can do shopping, or edit your cart using menu links above" ) ) + ELSEIF cMethod == "GET" + UWDefaultHandler( cMethod ) + ENDIF + + RETURN .T. + +STATIC FUNCTION proc_shopping( cMethod ) + + LOCAL oM, oW, nT, cCode + + ? ProcName(), cMethod + IF cMethod == "INIT" + IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F. + ENDIF + oM := UWMainNew() + oM:Add( UWMenuNew():AddItem( "Cart", "cart" ):AddItem( "My account", "account" ):AddItem( "Logout", "logout" ) ) + oM:Add( UWSeparatorNew() ) + oM:Add( UWLabelNew( "", "cartsum" ) ) + + dbUseArea( .T. , , "carts", "carts", .T. , .F. ) + OrdSetFocus( "user" ) + ORDSCOPE( 0, session[ "loggedin" ] ) + ORDSCOPE( 1, session[ "loggedin" ] ) + dbUseArea( .T. , , "items", "items", .T. , .T. ) + OrdSetFocus( "code" ) + oW := UWBrowseNew( "1" ) + oW:AddColumn( 101, "Item No.", "CODE" ) + oW:AddColumn( 102, "Title", "TITLE" ) + oW:AddColumn( 103, "Price", "PRICE" ) + oW:AddColumn( 104, "", {|| ULink( "Add to cart", "?add=" + RTrim( 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: " + hb_ntos( nT ) + UWDefaultHandler( cMethod ) + ELSEIF cMethod == "EXIT" + items->( dbCloseArea() ) + carts->( dbCloseArea() ) + ENDIF + + RETURN .T. + +STATIC FUNCTION proc_cart( cMethod ) + + LOCAL oM, oW, nT, cCode + + ? ProcName(), cMethod + IF cMethod == "INIT" + IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F. + ENDIF + oM := UWMainNew() + oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ):AddItem( "My account", "account" ):AddItem( "Logout", "logout" ) ) + oM:Add( UWSeparatorNew() ) + oM:Add( UWLabelNew( "", "cartsum" ) ) + + dbUseArea( .T. , , "items", "items", .T. , .T. ) + OrdSetFocus( "code" ) + dbUseArea( .T. , , "carts", "carts", .T. , .F. ) + OrdSetFocus( "user" ) + ORDSCOPE( 0, session[ "loggedin" ] ) + ORDSCOPE( 1, session[ "loggedin" ] ) + oW := UWBrowseNew( "1" ) + oW:AddColumn( 101, "Item No.", "CODE" ) + oW:AddColumn( 102, "Title", {|| items->( dbSeek(carts->CODE, .F. ), TITLE ) } ) + oW:AddColumn( 103, "Amount", "AMOUNT" ) + oW:AddColumn( 104, "Total", "TOTAL" ) + oW:AddColumn( 104, "", {|| ULink( "Delete", "?del=" + RTrim( 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: " + hb_ntos( nT ) + UWDefaultHandler( cMethod ) + ELSEIF cMethod == "EXIT" + items->( dbCloseArea() ) + carts->( dbCloseArea() ) + ENDIF + + RETURN .T. + +STATIC FUNCTION proc_logout( cMethod ) + + LOCAL oM + + ? ProcName(), cMethod + IF cMethod == "INIT" + IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F. + ENDIF + oM := UWMainNew() + oM:Add( UWMenuNew():AddItem( "Login", "login" ) ) + oM:Add( UWSeparatorNew() ) + oM:Add( UWLabelNew( "Your session is ended." ) ) + ELSEIF cMethod == "GET" + UWDefaultHandler( cMethod ) + USessionDestroy() + ENDIF + + RETURN .T. diff --git a/harbour/examples/uhttpd2/uhbext.prg b/harbour/examples/uhttpd2/uhbext.prg index 775eac1380..c53df98c26 100644 --- a/harbour/examples/uhttpd2/uhbext.prg +++ b/harbour/examples/uhttpd2/uhbext.prg @@ -8,28 +8,35 @@ * *************************************************************/ +FUNCTION split( cSeparator, cString ) -FUNC split(cSeparator, cString) -LOCAL aRet := {}, nI + LOCAL aRet := {} + LOCAL nI - DO WHILE (nI := AT(cSeparator, cString)) > 0 - AADD(aRet, LEFT(cString, nI - 1)) - cString := SUBSTR(cString, nI + LEN(cSeparator)) - ENDDO - AADD(aRet, cString) -RETURN aRet + 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 +FUNCTION join( cSeparator, aData ) - 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 + LOCAL cRet := "" + LOCAL nI + + FOR nI := 1 TO Len( aData ) + + IF nI > 1 + cRet += cSeparator + ENDIF + + IF ValType( aData[ nI ] ) $ "CM" ; cRet += aData[ nI ] + ELSEIF ValType( aData[ nI ] ) == "N" ; cRet += hb_ntos( aData[ nI ] ) + ELSEIF ValType( aData[ nI ] ) == "D" ; cRet += iif( ! Empty( aData[ nI ] ), DToC( aData[ nI ] ), "" ) + ELSE + ENDIF + NEXT + + RETURN cRet diff --git a/harbour/examples/uhttpd2/uhttpd2.hbc b/harbour/examples/uhttpd2/uhttpd2.hbc new file mode 100644 index 0000000000..9ad69b2139 --- /dev/null +++ b/harbour/examples/uhttpd2/uhttpd2.hbc @@ -0,0 +1,10 @@ +# +# $Id$ +# + +incpaths=. +libpaths=. + +libs=${hb_name}${__HB_DYN__} + +mt=yes diff --git a/harbour/examples/uhttpd2/uhttpd2.hbp b/harbour/examples/uhttpd2/uhttpd2.hbp index 10a74b24bb..754ce8ef33 100644 --- a/harbour/examples/uhttpd2/uhttpd2.hbp +++ b/harbour/examples/uhttpd2/uhttpd2.hbp @@ -2,11 +2,13 @@ # $Id$ # --ouhttpd2 +-hblib +-inc + +-o${hb_name} + +-w3 -es2 -app.prg uhbext.prg umain.prg uwidgets.prg - --mt diff --git a/harbour/examples/uhttpd2/umain.prg b/harbour/examples/uhttpd2/umain.prg index 95ed5c7195..13c12abba9 100644 --- a/harbour/examples/uhttpd2/umain.prg +++ b/harbour/examples/uhttpd2/umain.prg @@ -9,7 +9,7 @@ #include "hbsocket.ch" -#pragma -kM+ +#pragma -km+ /* Docs: @@ -26,1016 +26,1052 @@ #define CR_LF (CHR(13)+CHR(10)) -THREAD STATIC s_cResult, s_nStatusCode, s_aHeader, s_lSessionDestroy +THREAD STATIC t_cResult, t_nStatusCode, t_aHeader, t_lSessionDestroy MEMVAR server, get, post, cookie, session -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 {=>} +CREATE CLASS UHttpd + // Settings + DATA nPort INIT 80 + DATA cBindAddress INIT "0.0.0.0" + DATA cAccessLog INIT "uhttpd_access.log" + DATA cErrorLog INIT "uhttpd_error.log" + DATA bIdle INIT { || NIL } + DATA aMount INIT { => } - // Results - DATA cError INIT "" + // Results + DATA cError INIT "" - // Private - DATA hAccessLog - DATA hErrorLog + // Private + DATA hAccessLog + DATA hErrorLog - DATA hmtxQueue - DATA hmtxLog - DATA hmtxSession + DATA hmtxQueue + DATA hmtxLog + DATA hmtxSession - DATA hListen - DATA aSession + DATA hListen + DATA aSession - DATA lStop + DATA lStop - METHOD Run() - METHOD Stop() + METHOD RUN() + METHOD Stop() + + // Private + METHOD LogAccess() + METHOD LogError( cError ) - // Private - METHOD LogAccess() - METHOD LogError() ENDCLASS +FUNCTION UHttpdNew() -FUNC UHttpdNew() -RETURN UHttpd() + RETURN UHttpd() +METHOD RUN() CLASS UHttpd -METHOD Run() CLASS UHttpd -LOCAL hSocket, aRemote, nI, aThreads, aI -LOCAL nWaiters + LOCAL hSocket, nI, aThreads + LOCAL nWaiters - IF ! HB_MTVM() - Self:cError := "Multithread support required" - RETURN .F. - ENDIF + 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: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:hAccessLog := FOpen( Self:cAccessLog, FO_CREAT + FO_WRITE ) ) == - 1 + Self:cError := "Access log file open error " + hb_ntos( FError() ) + RETURN .F. + ENDIF + FSeek( Self:hAccessLog, 0, FS_END ) - IF (Self:hErrorLog := FOPEN(Self:cErrorLog, FO_CREAT + FO_WRITE)) == -1 - Self:cError := "Error log file open error " + LTRIM(STR(FERROR())) - FCLOSE(Self:hAccessLog) - RETURN .F. - ENDIF - FSEEK(Self:hErrorLog, 0, FS_END) + IF ( Self:hErrorLog := FOpen( Self:cErrorLog, FO_CREAT + FO_WRITE ) ) == - 1 + Self:cError := "Error log file open error " + hb_ntos( FError() ) + FClose( Self:hAccessLog ) + RETURN .F. + ENDIF + FSeek( Self:hErrorLog, 0, FS_END ) - Self:hmtxQueue := hb_mutexCreate() - Self:hmtxLog := hb_mutexCreate() - Self:hmtxSession := hb_mutexCreate() + Self:hmtxQueue := hb_mutexCreate() + Self:hmtxLog := hb_mutexCreate() + Self:hmtxSession := hb_mutexCreate() - IF Empty(Self:hListen := hb_socketOpen()) - Self:cError := "Socket create error " + LTRIM(STR(hb_socketGetError())) - FCLOSE(Self:hErrorLog) - FCLOSE(Self:hAccessLog) - RETURN .F. - ENDIF + IF Empty( Self:hListen := hb_socketOpen() ) + Self:cError := "Socket create error " + hb_ntos( hb_socketGetError() ) + FClose( Self:hErrorLog ) + FClose( Self:hAccessLog ) + RETURN .F. + ENDIF - IF !hb_socketBind(Self:hListen, {HB_SOCKET_AF_INET, Self:cBindAddress, Self:nPort}) - Self:cError := "Bind error " + LTRIM(STR(hb_socketGetError())) - hb_socketClose(Self:hListen) - FCLOSE(Self:hErrorLog) - FCLOSE(Self:hAccessLog) - RETURN .F. - ENDIF + IF !hb_socketBind( Self:hListen, { HB_SOCKET_AF_INET, Self:cBindAddress, Self:nPort } ) + Self:cError := "Bind error " + hb_ntos( hb_socketGetError() ) + hb_socketClose( Self:hListen ) + FClose( Self:hErrorLog ) + FClose( Self:hAccessLog ) + RETURN .F. + ENDIF - IF !hb_socketListen(Self:hListen) - Self:cError := "Listen error " + LTRIM(STR(hb_socketGetError())) - hb_socketClose(Self:hListen) - FCLOSE(Self:hErrorLog) - FCLOSE(Self:hAccessLog) - RETURN .F. - ENDIF + IF !hb_socketListen( Self:hListen ) + Self:cError := "Listen error " + hb_ntos( hb_socketGetError() ) + hb_socketClose( Self:hListen ) + FClose( Self:hErrorLog ) + FClose( Self:hAccessLog ) + RETURN .F. + ENDIF - aThreads := {} - FOR nI := 1 TO THREAD_COUNT_PREALLOC - AADD(aThreads, hb_threadStart(@ProcessConnection(), Self)) - NEXT + aThreads := {} + FOR nI := 1 TO THREAD_COUNT_PREALLOC + AAdd( aThreads, hb_threadStart( @ProcessConnection(), Self ) ) + NEXT - Self:lStop := .F. - Self:aSession := {=>} + Self:lStop := .F. + Self:aSession := { => } - DO WHILE .T. - IF EMPTY( hSocket := hb_socketAccept(Self:hListen,, 1000) ) - IF hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT - EVAL(Self:bIdle, Self) - IF Self:lStop; EXIT - ENDIF + DO WHILE .T. + IF Empty( hSocket := hb_socketAccept( Self:hListen,, 1000 ) ) + IF hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT + Eval( Self:bIdle, Self ) + IF Self:lStop; EXIT + ENDIF + ELSE + Self:LogError( "[error] Accept error " + hb_ntos( hb_socketGetError() ) ) + ENDIF ELSE - Self:LogError("[error] Accept error " + LTRIM(STR(hb_socketGetError()))) - ENDIF - ELSE - hb_mutexQueueInfo( Self:hmtxQueue, @nWaiters ) - ? "New connection", hSocket - ? "Waiters:", nWaiters - IF nWaiters < 2 .AND. LEN(aThreads) < THREAD_COUNT_MAX + hb_mutexQueueInfo( Self:hmtxQueue, @nWaiters ) + ? "New connection", hSocket + ? "Waiters:", nWaiters + IF nWaiters < 2 .AND. Len( aThreads ) < THREAD_COUNT_MAX /* We need two threads in worst case. If first thread becomes a sessioned thread, the second one will continue to serve sessionless requests for the same connection. We create two threads here to avoid free thread count check (and aThreads variable sync) in ProcessRequest(). */ - AADD(aThreads, hb_threadStart(@ProcessConnection(), Self)) - AADD(aThreads, hb_threadStart(@ProcessConnection(), Self)) + AAdd( aThreads, hb_threadStart( @ProcessConnection(), Self ) ) + AAdd( aThreads, hb_threadStart( @ProcessConnection(), Self ) ) + ENDIF + hb_mutexNotify( Self:hmtxQueue, { hSocket, "" } ) ENDIF - hb_mutexNotify(Self:hmtxQueue, {hSocket, ""}) - ENDIF - ENDDO - hb_socketClose(Self:hListen) + ENDDO + hb_socketClose( 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)}) + // 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. + FClose( Self:hErrorLog ) + FClose( Self:hAccessLog ) + RETURN .T. METHOD Stop() CLASS UHttpd - Self:lStop := .T. -RETURN NIL + Self:lStop := .T. -METHOD LogError(cError) CLASS UHttpd - hb_mutexLock(Self:hmtxLog) - FWRITE(Self:hErrorLog, DTOS(DATE()) + " " + TIME() + " " + cError + " " + hb_eol()) - hb_mutexUnlock(Self:hmtxLog) -RETURN NIL + RETURN NIL +METHOD LogError( cError ) CLASS UHttpd + + hb_mutexLock( Self:hmtxLog ) + FWrite( Self:hErrorLog, DToS( Date() ) + " " + Time() + " " + cError + " " + hb_eol() ) + 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_eol()) - hb_mutexUnlock(Self:hmtxLog) -RETURN NIL + LOCAL cDate := DToS( Date() ), cTime := Time() -STATIC FUNC ProcessConnection(oServer) -LOCAL hSocket, cRequest, cSend, aI, nLen, nI, nReqLen, cBuf + 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"] + '" ' + ; + hb_ntos( t_nStatusCode ) + " " + hb_ntos( Len( t_cResult ) ) + ; + ' "' + server["HTTP_REFERER"] + '" "' + server["HTTP_USER_AGENT"] + ; + '"' + hb_eol() ) + hb_mutexUnlock( Self:hmtxLog ) - PRIVATE server, get, post, cookie + RETURN NIL - DO WHILE .T. - hb_mutexSubscribe(oServer:hmtxQueue,, @aI) - IF aI == NIL - EXIT - ENDIF +STATIC FUNCTION ProcessConnection( oServer ) - hSocket := aI[1] - cRequest := aI[2] + LOCAL hSocket, cRequest, aI, nLen, nReqLen, cBuf - BEGIN SEQUENCE + PRIVATE server, get, post, cookie - /* receive query header */ - cRequest := "" - nLen := 1 - DO WHILE AT(CR_LF + CR_LF, cRequest) == 0 .AND. nLen > 0 - cBuf := Space( 4096 ) - IF (nLen := hb_socketRecv(hSocket, @cBuf,,, 10000)) > 0 /* Timeout */ - cRequest += LEFT(cBuf, nLen) - ELSE - IF nLen == -1 .AND. hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT - nLen := 0 - ? "recv() timeout", hSocket - ENDIF - ENDIF - ENDDO + DO WHILE .T. + hb_mutexSubscribe( oServer:hmtxQueue, , @aI ) + IF aI == NIL + EXIT + ENDIF - IF nLen == -1 - ? "recv() error:", hb_socketGetError() - ELSEIF nLen == 0 /* connection closed */ - ELSE + hSocket := aI[1] + cRequest := aI[2] - // PRIVATE - server := {=>} - get := {=>} - post := {=>} - cookie := {=>} + BEGIN SEQUENCE - s_cResult := "" - s_aHeader := {} - s_nStatusCode := 200 - - IF !Empty( aI := hb_socketGetPeerName(hSocket)) - server["REMOTE_ADDR"] := aI[HB_SOCKET_ADINFO_ADDRESS] - server["REMOTE_HOST"] := server["REMOTE_ADDR"] // no reverse DNS - server["REMOTE_PORT"] := aI[HB_SOCKET_ADINFO_PORT] - ENDIF - - IF !Empty( aI := hb_socketGetSockName(hSocket)) - server["SERVER_ADDR"] := aI[HB_SOCKET_ADINFO_ADDRESS] - server["SERVER_PORT"] := aI[HB_SOCKET_ADINFO_PORT] - 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 + /* receive query header */ + cRequest := "" + nLen := 1 + DO WHILE At( CR_LF + CR_LF, cRequest ) == 0 .AND. nLen > 0 cBuf := Space( 4096 ) - IF (nLen := hb_socketRecv(hSocket, @cBuf,,, 500)) > 0 - cRequest += LEFT( cBuf, nLen ) - ENDIF - ENDDO - - IF nLen == -1 - ? "recv() error:", hb_socketGetError() - 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 - hb_socketShutdown(hSocket) - hb_socketClose(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") + IF ( nLen := hb_socketRecv( hSocket, @cBuf,,, 10000 ) ) > 0 /* Timeout */ + cRequest += Left( cBuf, nLen ) ELSE - UAddHeader("Connection", "keep-alive") + IF nLen == - 1 .AND. hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT + nLen := 0 + ? "recv() timeout", hSocket + ENDIF ENDIF - ENDIF + ENDDO - SendResponse(oServer, hSocket) + IF nLen == - 1 + ? "recv() error:", hb_socketGetError() + ELSEIF nLen == 0 /* connection closed */ + ELSE - 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 + // PRIVATE + server := { => } + get := { => } + post := { => } + cookie := { => } - IF LOWER(UGetHeader("Connection")) == "close" .OR. server["SERVER_PROTOCOL"] == "HTTP/1.0" - ? "Close connection2", hSocket - hb_socketShutdown(hSocket) - hb_socketClose(hSocket) - ELSE - /* pass connection to common queue */ - hb_mutexNotify(oServer:hmtxQueue, {hSocket, cBuffer}) - ENDIF + t_cResult := "" + t_aHeader := {} + t_nStatusCode := 200 - IF s_lSessionDestroy - EXIT - ENDIF + IF !Empty( aI := hb_socketGetPeerName( hSocket ) ) + server["REMOTE_ADDR"] := aI[HB_SOCKET_ADINFO_ADDRESS] + server["REMOTE_HOST"] := server["REMOTE_ADDR"] // no reverse DNS + server["REMOTE_PORT"] := aI[HB_SOCKET_ADINFO_PORT] + ENDIF - 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 + IF !Empty( aI := hb_socketGetSockName( hSocket ) ) + server["SERVER_ADDR"] := aI[HB_SOCKET_ADINFO_ADDRESS] + server["SERVER_PORT"] := aI[HB_SOCKET_ADINFO_PORT] + ENDIF - /* 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 + ? Left( cRequest, At( CR_LF + CR_LF, cRequest ) + 1 ) - RETURN .F. - ELSE - /* not sessioned */ - BEGIN SEQUENCE WITH {|oErr| UErrorHandler(oErr, oServer)} - EVAL(bEval, cPath) - RECOVER - USetStatusCode(500) + nReqLen := ParseRequestHeader( @cRequest ) + IF nReqLen == NIL + USetStatusCode( 400 ) + ELSE + + /* receive query body */ + DO WHILE Len( cRequest ) < nReqLen .AND. nLen > 0 + cBuf := Space( 4096 ) + IF ( nLen := hb_socketRecv( hSocket, @cBuf,,, 500 ) ) > 0 + cRequest += Left( cBuf, nLen ) + ENDIF + ENDDO + + IF nLen == - 1 + ? "recv() error:", hb_socketGetError() + 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 + hb_socketShutdown( hSocket ) + hb_socketClose( hSocket ) END SEQUENCE - ENDIF - ELSE - USetStatusCode(404) - ENDIF -RETURN .T. + ENDDO + dbCloseAll() + RETURN 0 -STATIC FUNC ParseRequestHeader(cRequest) -LOCAL aRequest, aLine, nI, nJ, cI, nK, nContentLength := 0 +STATIC FUNCTION ProcessRequest( oServer, hSocket, cBuffer ) - aRequest := split(CR_LF, cRequest) - aLine := split(" ", aRequest[1]) + LOCAL nI, cMount, cPath, cSID, hmtx, aData, bEval - 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 + PRIVATE session - // Fix invalid queries: bind to root - IF ! (LEFT(server["REQUEST_URI"], 1) == "/") - server["REQUEST_URI"] := "/" + server["REQUEST_URI"] - ENDIF + // 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 (nI := AT("?", server["REQUEST_URI"])) > 0 - server["SCRIPT_NAME"] := LEFT(server["REQUEST_URI"], nI - 1) - server["QUERY_STRING"] := SUBSTR(server["REQUEST_URI"], nI + 1) - ELSE - server["SCRIPT_NAME"] := server["REQUEST_URI"] - server["QUERY_STRING"] := "" - ENDIF + IF cMount != NIL + bEval := oServer:aMount[cMount, 1] - 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"] := "" + IF oServer:aMount[cMount, 2] + /* sessioned */ + IF HB_HHasKey( cookie, "SESSID" ); cSID := cookie["SESSID"] + ENDIF - 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)) + 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. + t_cResult := "" + t_aHeader := {} + t_nStatusCode := 200 + t_lSessionDestroy := .F. + BEGIN SEQUENCE WITH { |oErr| UErrorHandler( oErr, oServer ) } + Eval( bEval, cPath ) + RECOVER + USetStatusCode( 500 ) + END SEQUENCE + + IF t_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 t_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 + hb_socketShutdown( hSocket ) + hb_socketClose( hSocket ) + ELSE + /* pass connection to common queue */ + hb_mutexNotify( oServer:hmtxQueue, { hSocket, cBuffer } ) + ENDIF + + IF t_lSessionDestroy + EXIT + ENDIF + + IF ! hb_mutexSubscribe( hmtx, SESSION_TIMEOUT, @aData ) .OR. aData == NIL + ? "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 - get[UUrlDecode(cI)] := NIL + /* not sessioned */ + BEGIN SEQUENCE WITH { |oErr| UErrorHandler( oErr, oServer ) } + Eval( bEval, cPath ) + RECOVER + USetStatusCode( 500 ) + END SEQUENCE ENDIF - NEXT - ENDIF - cRequest := SUBSTR(cRequest, AT(CR_LF + CR_LF, cRequest) + 4) -RETURN nContentLength + ELSE + USetStatusCode( 404 ) + ENDIF + RETURN .T. -STATIC FUNC ParseRequestBody(cRequest) -LOCAL nI, cPart +STATIC FUNCTION ParseRequestHeader( cRequest ) - 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 + 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 - ENDIF -RETURN NIL + 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 MakeResponse() -LOCAL cRet +STATIC FUNCTION ParseRequestBody( cRequest ) - IF UGetHeader("Content-Type") == NIL - UAddHeader("Content-Type", "text/html") - ENDIF - UAddHeader("Date", HttpDateFormat(HB_DATETIME())) + LOCAL nI, cPart - cRet := IIF(server["SERVER_PROTOCOL"] == "HTTP/1.0", "HTTP/1.0 ", "HTTP/1.1 ") - SWITCH s_nStatusCode - CASE 200 + 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 FUNCTION 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 t_nStatusCode + CASE 200 cRet += "200 OK" EXIT - CASE 301 + CASE 301 cRet += "301 Moved Permanently" - s_cResult := "

301 Moved Permanently

" + t_cResult := "

301 Moved Permanently

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

302 Found

" + t_cResult := "

302 Found

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

303 See Other

" + t_cResult := "

303 See Other

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

304 Not Modified

" + t_cResult := "

304 Not Modified

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

400 Bad Request

" - UAddHeader("Connection", "close") + t_cResult := "

400 Bad Request

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

401 Unauthorized

" + t_cResult := "

401 Unauthorized

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

402 Payment Required

" + t_cResult := "

402 Payment Required

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

403 Forbidden

" + t_cResult := "

403 Forbidden

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

404 Not Found

" + t_cResult := "

404 Not Found

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

412 Precondition Failed

" + t_cResult := "

412 Precondition Failed

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

500 Internal Server Error

" + t_cResult := "

500 Internal Server Error

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

501 Not Implemented

" - UAddHeader("Connection", "close") + t_cResult := "

501 Not Implemented

" + UAddHeader( "Connection", "close" ) EXIT - OTHERWISE + 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 + t_cResult := "

500 Internal Server Error

" + UAddHeader( "Connection", "close" ) + ENDSWITCH + cRet += CR_LF + UAddHeader( "Content-Length", hb_ntos( Len( t_cResult ) ) ) + AEval( t_aHeader, { |x| cRet += x[1] + ": " + x[2] + CR_LF } ) + cRet += CR_LF + ? cRet + cRet += t_cResult + RETURN cRet -STATIC PROC SendResponse(oServer, hSocket) -LOCAL cSend, nLen, cBuf - cSend := MakeResponse() +STATIC PROCEDURE SendResponse( oServer, hSocket ) -// ? cSend + LOCAL cSend, nLen - DO WHILE LEN(cSend) > 0 - IF (nLen := hb_socketSend(hSocket, cSend)) == -1 - ? "send() error:", hb_socketGetError(), hSocket - EXIT - ELSEIF nLen > 0 - cSend := SUBSTR(cSend, nLen + 1) - ENDIF - ENDDO - oServer:LogAccess() -RETURN + cSend := MakeResponse() + // ? cSend -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_eol() + ; - "Error: " + oErr:subsystem + "/" + ErrDescCode(oErr:genCode) + "(" + LTRIM(STR(oErr:genCode)) + ") " + ; - LTRIM(STR(oErr:subcode)) + hb_eol() - IF !EMPTY(oErr:filename); cRet += "File: " + oErr:filename + hb_eol() - ENDIF - IF !EMPTY(oErr:description); cRet += "Description: " + oErr:description + hb_eol() - ENDIF - IF !EMPTY(oErr:operation); cRet += "Operacija: " + oErr:operation + hb_eol() - ENDIF - IF !EMPTY(oErr:osCode); cRet += "OS error: " + LTRIM(STR(oErr:osCode)) + hb_eol() - ENDIF - IF VALTYPE(oErr:args) == "A" - cRet += "Arguments:" + hb_eol() - AEVAL(oErr:args, {|X, Y| cRet += STR(Y, 5) + ": " + HB_CStr(X) + hb_eol()}) - ENDIF - cRet += hb_eol() - - cRet += "Stack:" + hb_eol() - nI := 2 - DO WHILE ! EMPTY(PROCNAME(++nI)) - cRet += " " + PROCNAME(nI) + "(" + LTRIM(STR(PROCLINE(nI))) + ")" + hb_eol() - ENDDO - cRet += hb_eol() - - cRet += "Executable: " + HB_PROGNAME() + hb_eol() - cRet += "Versions:" + hb_eol() - cRet += " OS: " + OS() + hb_eol() - cRet += " Harbour: " + VERSION() + ", " + HB_BUILDDATE() + hb_eol() - cRet += hb_eol() - - IF oErr:genCode != EG_MEM - cRet += "Database areas:" + hb_eol() - cRet += " Current: " + LTRIM(STR(SELECT())) + " " + ALIAS() + hb_eol() - - BEGIN SEQUENCE WITH {|o| BREAK(o)} - IF !EMPTY(ALIAS()) - cRet += " Filter: " + DBFILTER() + hb_eol() - cRet += " Relation: " + DBRELATION() + hb_eol() - cRet += " Index expression: " + ORDKEY(ORDSETFOCUS()) + hb_eol() - cRet += hb_eol() - BEGIN SEQUENCE WITH {|o| BREAK(o)} - FOR nI := 1 to FCOUNT() - cRet += STR(nI, 6) + " " + PADR(FIELDNAME(nI), 14) + ": " + HB_VALTOEXP(FIELDGET(nI)) + hb_eol() - NEXT - RECOVER - cRet += "!!! Error reading database fields !!!" + hb_eol() - END SEQUENCE - cRet += hb_eol() + DO WHILE Len( cSend ) > 0 + IF ( nLen := hb_socketSend( hSocket, cSend ) ) == - 1 + ? "send() error:", hb_socketGetError(), hSocket + EXIT + ELSEIF nLen > 0 + cSend := SubStr( cSend, nLen + 1 ) ENDIF - RECOVER - cRet += "!!! Error accessing current workarea !!!" + hb_eol() - END SEQUENCE + ENDDO + oServer:LogAccess() - 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_eol() - DBCLOSEAREA() - ENDIF + RETURN + +STATIC FUNCTION 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 FUNCTION 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 FUNCTION 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 FUNCTION GetErrorDesc( oErr ) + + LOCAL cRet, nI + + cRet := "ERRORLOG ============================================================" + hb_eol() + ; + "Error: " + oErr:subsystem + "/" + ErrDescCode( oErr:genCode ) + "(" + hb_ntos( oErr:genCode ) + ") " + ; + hb_ntos( oErr:subcode ) + hb_eol() + IF !Empty( oErr:filename ); cRet += "File: " + oErr:filename + hb_eol() + ENDIF + IF !Empty( oErr:description ); cRet += "Description: " + oErr:description + hb_eol() + ENDIF + IF !Empty( oErr:operation ); cRet += "Operacija: " + oErr:operation + hb_eol() + ENDIF + IF !Empty( oErr:osCode ); cRet += "OS error: " + hb_ntos( oErr:osCode ) + hb_eol() + ENDIF + IF ValType( oErr:args ) == "A" + cRet += "Arguments:" + hb_eol() + AEval( oErr:args, { |X, Y| cRet += Str( Y, 5 ) + ": " + HB_CStr( X ) + hb_eol() } ) + ENDIF + cRet += hb_eol() + + cRet += "Stack:" + hb_eol() + nI := 2 + DO WHILE ! Empty( ProcName( ++ nI ) ) + cRet += " " + ProcName( nI ) + "(" + hb_ntos( ProcLine( nI ) ) + ")" + hb_eol() + ENDDO + cRet += hb_eol() + + cRet += "Executable: " + HB_PROGNAME() + hb_eol() + cRet += "Versions:" + hb_eol() + cRet += " OS: " + OS() + hb_eol() + cRet += " Harbour: " + Version() + ", " + HB_BUILDDATE() + hb_eol() + cRet += hb_eol() + + IF oErr:genCode != EG_MEM + cRet += "Database areas:" + hb_eol() + cRet += " Current: " + hb_ntos( Select() ) + " " + Alias() + hb_eol() + + BEGIN SEQUENCE WITH { |o| BREAK( o ) } + IF !Empty( Alias() ) + cRet += " Filter: " + dbFilter() + hb_eol() + cRet += " Relation: " + dbRelation() + hb_eol() + cRet += " Index expression: " + OrdKey( OrdSetFocus() ) + hb_eol() + cRet += hb_eol() + BEGIN SEQUENCE WITH { |o| BREAK( o ) } + FOR nI := 1 TO FCount() + cRet += Str( nI, 6 ) + " " + PadR( FieldName( nI ), 14 ) + ": " + HB_VALTOEXP( FieldGet( nI ) ) + hb_eol() + NEXT + RECOVER + cRet += "!!! Error reading database fields !!!" + hb_eol() + END SEQUENCE + cRet += hb_eol() + ENDIF RECOVER - cRet += "!!! Error accessing workarea number: " + STR(nI, 4) + "!!!" + hb_eol() + cRet += "!!! Error accessing current workarea !!!" + hb_eol() END SEQUENCE - NEXT - cRet += hb_eol() - ENDIF -RETURN cRet + 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() + "(" + hb_ntos( OrdNumber() ) + ")" ) + hb_eol() + dbCloseArea() + ENDIF + RECOVER + cRet += "!!! Error accessing workarea number: " + Str( nI, 4 ) + "!!!" + hb_eol() + END SEQUENCE + NEXT + cRet += hb_eol() + ENDIF -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) + RETURN cRet + +STATIC FUNCTION ErrDescCode( nCode ) + + LOCAL cI := NIL + + IF nCode > 0 .AND. nCode <= 41 + cI := {; + "ARG" , "BOUND" , "STROVERFLOW", "NUMOVERFLOW", "ZERODIV" , "NUMERR" , "SYNTAX" , "COMPLEXITY" , ; // 1, 2, 3, 4, 5, 6, 7, 8 + NIL , NIL , "MEM" , "NOFUNC" , "NOMETHOD", "NOVAR" , "NOALIAS" , "NOVARMETHOD", ; // 9, 10, 11, 12, 13, 14, 15, 16 + "BADALIAS", "DUPALIAS" , NIL , "CREATE" , "OPEN" , "CLOSE" , "READ" , "WRITE" , ; // 17, 18, 19, 20, 21, 22, 23, 24 + "PRINT" , NIL , NIL , NIL , NIL , "UNSUPPORTED", "LIMIT" , "CORRUPTION" , ; // 25, 26 - 29, 30, 31, 32 + "DATATYPE", "DATAWIDTH", "NOTABLE" , "NOORDER" , "SHARED" , "UNLOCKED" , "READONLY", "APPENDLOCK" , ; // 33, 34, 35, 36, 37, 38, 39, 40 + "LOCK" }[nCode] // 41 + ENDIF + + RETURN iif( cI == NIL, "", "EG_" + cI ) /******************************************************************** Public functions ********************************************************************/ -PROC USetStatusCode(nStatusCode) - s_nStatusCode := nStatusCode -RETURN +PROCEDURE USetStatusCode( nStatusCode ) -FUNC UGetHeader(cType) -LOCAL nI + t_nStatusCode := nStatusCode - IF (nI := ASCAN(s_aHeader, {|x| UPPER(x[1]) == UPPER(cType)})) > 0 - RETURN s_aHeader[nI, 2] - ENDIF -RETURN NIL + RETURN +FUNCTION UGetHeader( cType ) -PROC UAddHeader(cType, cValue) -LOCAL nI + 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 + IF ( nI := ASCAN( t_aHeader, { |x| Upper(x[1] ) == Upper(cType ) } ) ) > 0 + RETURN t_aHeader[nI, 2] + ENDIF + RETURN NIL -PROC URedirect(cURL, nCode) - IF nCode == NIL; nCode := 303 - ENDIF - USetStatusCode(nCode) - UAddHeader("Location", cURL) -RETURN +PROCEDURE UAddHeader( cType, cValue ) + LOCAL nI -PROC USessionDestroy() - s_lSessionDestroy := .T. -RETURN + IF ( nI := ASCAN( t_aHeader, { |x| Upper(x[1] ) == Upper(cType ) } ) ) > 0 + t_aHeader[nI, 2] := cValue + ELSE + AAdd( t_aHeader, { cType, cValue } ) + ENDIF + RETURN -PROC UWrite(cString) - s_cResult += cString -RETURN +PROCEDURE URedirect( cURL, nCode ) + IF nCode == NIL; nCode := 303 + ENDIF + USetStatusCode( nCode ) + UAddHeader( "Location", cURL ) -FUNC UOsFileName(cFileName) - IF hb_ps() != "/" - RETURN STRTRAN(cFileName, "/", hb_ps()) - ENDIF -RETURN cFileName + RETURN +PROCEDURE USessionDestroy() -FUNC UHtmlEncode(cString) -LOCAL nI, cI, cRet := "" + t_lSessionDestroy := .T. - 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 + RETURN +PROCEDURE UWrite( cString ) -FUNC UUrlEncode(cString) -LOCAL nI, cI, cRet := "" + t_cResult += cString - 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 + RETURN +FUNCTION UOsFileName( cFileName ) -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 + IF hb_ps() != "/" + RETURN StrTran( cFileName, "/", hb_ps() ) + ENDIF + RETURN cFileName -FUNC ULink(cText, cURL) -RETURN '' + UHtmlEncode(cText) + '' +FUNCTION UHtmlEncode( cString ) + LOCAL nI, cI, cRet := "" -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 + FOR nI := 1 TO Len( cString ) + cI := SubStr( cString, nI, 1 ) + IF cI == "<" + cRet += "<" + ELSEIF cI == ">" + cRet += ">" + ELSEIF cI == "&" + cRet += "&" + ELSEIF cI == '"' + cRet += """ ELSE - cI := "application/octet-stream" + cRet += cI ENDIF - UAddHeader("Content-Type", cI) + NEXT - IF HB_FGETDATETIME(UOsFileName(cFileName), @tDate) - UAddHeader("Last-Modified", HttpDateFormat(tDate)) + RETURN cRet + +FUNCTION 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 - 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 cRet + +FUNCTION 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 + +FUNCTION ULink( cText, cURL ) + + RETURN '' + UHtmlEncode( cText ) + '' + +PROCEDURE UProcFiles( cFileName, lIndex ) + + LOCAL aDir, aF, nI, cI, tDate, tHDate + + DEFAULT lIndex TO .F. + + cFileName := StrTran( cFileName, "//", "/" ) + + // Security + IF "/../" $ cFileName + USetStatusCode( 403 ) RETURN - ENDIF - IF ! lIndex - USetStatusCode(403) - RETURN - ENDIF + 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]))}) + 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 - 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 + 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 ) - 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)
+         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 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| iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+               iif( Y[5] == "D", .F. , X[2] < Y[2] ) ) } )
+         ELSEIF get["s"] == "m"
+            ASort( aDir, , , { |X, Y| iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+               iif( Y[5] == "D", .F. , DToS( X[3] ) + X[4] < DToS( Y[3] ) + Y[4] ) ) } )
+         ELSE
+            ASort( aDir, , , { |X, Y| iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+               iif( Y[5] == "D", .F. , X[1] < Y[1] ) ) } )
+         ENDIF
       ELSE
-        UWrite('      '+ aF[1] + '' + SPACE(50 - LEN(aF[1])) + ;
-               DTOC(aF[3]) + ' ' + aF[4] + STR(aF[2], 12) + CR_LF)
+         ASort( aDir, , , { |X, Y| iif( X[5] == "D", iif(Y[5] == "D", X[1] < Y[1], .T. ), ;
+            iif( Y[5] == "D", .F. , X[1] < Y[1] ) ) } )
       ENDIF
-    NEXT
-    UWrite("
") - ELSE - USetStatusCode(404) - ENDIF -RETURN + 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 -PROC UProcInfo() - UWrite('

Info

') + RETURN - UWrite('

Platform

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

Capabilities

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

Info

' ) - UWrite('

Variables

') + UWrite( '

Platform

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

server

') - UWrite('') - HB_HEval(server, {|k,v| UWrite('')}) - UWrite('
' + k + '' + UHtmlEncode(HB_CStr(v)) + '
') + UWrite( '

Capabilities

' ) + UWrite( '' ) + UWrite( '' ) + UWrite( '
RDD' + UHtmlEncode( join(", ", rddList() ) ) + '
' ) - IF !EMPTY(get) - UWrite('

get

') - UWrite('') - HB_HEval(get, {|k,v| UWrite('')}) - UWrite('
' + k + '' + UHtmlEncode(HB_CStr(v)) + '
') - ENDIF + UWrite( '

Variables

' ) - IF !EMPTY(post) - UWrite('

post

') - UWrite('') - HB_HEval(post, {|k,v| UWrite('')}) - UWrite('
' + k + '' + UHtmlEncode(HB_CStr(v)) + '
') - ENDIF -RETURN + 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/uwidgets.prg b/harbour/examples/uhttpd2/uwidgets.prg index 86f7fdb287..fda9d36e0a 100644 --- a/harbour/examples/uhttpd2/uwidgets.prg +++ b/harbour/examples/uhttpd2/uwidgets.prg @@ -4,419 +4,481 @@ #include "hbclass.ch" -#pragma -kM+ +#pragma -km+ MEMVAR session, server, get, post //============================================================ -CLASS UWMain - DATA aChilds INIT {} - METHOD Add() - METHOD Paint() +CREATE CLASS UWMain + + DATA aChilds INIT {} + + METHOD Add( oWidget ) + METHOD Paint() + ENDCLASS +FUNCTION UWMainNew() -FUNC UWMainNew() -LOCAL oW := UWMain() - session["_uthis", "main"] := oW -RETURN oW + 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 + UWrite( '' ) + UWrite( '' ) + UWrite( '' ) + UWrite( '' ) + AEval( Self:aChilds, { |x| X:Paint() } ) + UWrite( '' ) -METHOD Add(oWidget) CLASS UWMain - AADD(Self:aChilds, oWidget) -RETURN Self + RETURN Self +METHOD Add( oWidget ) CLASS UWMain + + AAdd( Self:aChilds, oWidget ) + + RETURN Self //============================================================ -CLASS UWLayoutGrid - DATA aChilds INIT {{{}}} // {{{}}, {{}}} ; {{{}, {}}} - METHOD Add() - METHOD Paint() +CREATE CLASS UWLayoutGrid + + DATA aChilds INIT { { {} } } // {{{}}, {{}}} ; {{{}, {}}} + + METHOD Add( oWidget, nRow, nCol ) + METHOD Paint() + ENDCLASS +FUNCTION UWLayoutGridNew() -FUNC UWLayoutGridNew() -LOCAL oW := UWLayoutGrid() -RETURN oW + 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 + LOCAL aRow, aCell -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] := {} + UWrite( '' ) + FOR EACH aRow IN Self:aChilds + UWrite( '' ) + FOR EACH aCell IN aRow + UWrite( '' ) 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 + 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() +CREATE CLASS UWHtml + + DATA cText + + METHOD Paint() + ENDCLASS +FUNCTION UWHtmlNew( cText ) -FUNC UWHtmlNew(cText) -LOCAL oW := UWHtml() - oW:cText := cText -RETURN oW + LOCAL oW := UWHtml() + oW:cText := cText + + RETURN oW METHOD Paint() CLASS UWHtml - UWrite(Self:cText) -RETURN Self + UWrite( Self:cText ) + + RETURN Self //============================================================ -CLASS UWLabel - DATA cText - DATA cID - DATA cStyle - METHOD Paint() +CREATE CLASS UWLabel + + DATA cText + DATA cID + DATA cStyle + + METHOD Paint() + ENDCLASS +FUNCTION UWLabelNew( cText, cID, cStyle ) -FUNC UWLabelNew(cText, cID, cStyle) -LOCAL oW := UWLabel() - oW:cText := cText - SetWId(oW, cID) - oW:cStyle := cStyle -RETURN oW + LOCAL oW := UWLabel() + oW:cText := cText + SetWId( oW, cID ) + oW:cStyle := cStyle + + RETURN oW METHOD Paint() CLASS UWLabel - UWrite('' + ; - UHtmlEncode(Self:cText) + '') -RETURN Self + UWrite( '' + ; + UHtmlEncode( Self:cText ) + '' ) + + RETURN Self //============================================================ -CLASS UWForm - DATA cAction - DATA cMethod INIT "POST" - DATA aChilds INIT {} - METHOD Add() - METHOD Paint() +CREATE CLASS UWForm + + DATA cAction + DATA cMethod INIT "POST" + DATA aChilds INIT {} + + METHOD Add( oWidget ) + METHOD Paint() + ENDCLASS +FUNCTION UWFormNew( cAction ) -FUNC UWFormNew(cAction) -LOCAL oW := UWForm() - oW:cAction := cAction -RETURN oW + LOCAL oW := UWForm() + oW:cAction := cAction -METHOD Add(oWidget) CLASS UWForm - AADD(Self:aChilds, oWidget) -RETURN Self + 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 + UWrite( '
' ) + AEval( Self:aChilds, { |x| X:Paint() } ) + UWrite( '
' ) + + RETURN Self //============================================================ -CLASS UWInput - DATA cName - DATA cValue - DATA cID - DATA cStyle - METHOD Paint() +CREATE CLASS UWInput + + DATA cName + DATA cValue + DATA cID + DATA cStyle + + METHOD Paint() + ENDCLASS +FUNCTION UWInputNew( cName, cValue, cID, cStyle ) -FUNC UWInputNew(cName, cValue, cID, cStyle) -LOCAL oW := UWInput() - oW:cName := cName - oW:cValue := cValue - SetWId(oW, cID) - oW:cStyle := cStyle -RETURN oW + LOCAL oW := UWInput() + oW:cName := cName + oW:cValue := cValue + SetWId( oW, cID ) + oW:cStyle := cStyle + + RETURN oW METHOD Paint() CLASS UWInput - UWrite('') -RETURN Self + UWrite( '' ) + + RETURN Self //============================================================ -CLASS UWPassword - DATA cName - DATA cValue - METHOD Paint() +CREATE CLASS UWPassword + + DATA cName + DATA cValue + + METHOD Paint() + ENDCLASS +FUNCTION UWPasswordNew( cName ) -FUNC UWPasswordNew(cName) -LOCAL oW := UWPassword() - oW:cName := cName -RETURN oW + LOCAL oW := UWPassword() + oW:cName := cName + + RETURN oW METHOD Paint() CLASS UWPassword - UWrite('') -RETURN Self + UWrite( '' ) + + RETURN Self //============================================================ -CLASS UWSubmit - DATA cName - DATA cValue - METHOD Paint() +CREATE CLASS UWSubmit + + DATA cName + DATA cValue + + METHOD Paint() + ENDCLASS +FUNCTION UWSubmitNew( cName, cValue ) -FUNC UWSubmitNew(cName, cValue) -LOCAL oW := UWSubmit() - oW:cName := cName - oW:cValue := cValue -RETURN oW + LOCAL oW := UWSubmit() + oW:cName := cName + oW:cValue := cValue + + RETURN oW METHOD Paint() CLASS UWSubmit - UWrite('') -RETURN Self + UWrite( '' ) + + RETURN Self //============================================================ -CLASS UWSeparator - METHOD Paint() + +CREATE CLASS UWSeparator + + METHOD Paint() + ENDCLASS +FUNCTION UWSeparatorNew() -FUNC UWSeparatorNew() -LOCAL oW := UWSeparator() -RETURN oW + LOCAL oW := UWSeparator() + RETURN oW METHOD Paint() CLASS UWSeparator - UWrite('
') -RETURN Self + UWrite( '
' ) + + RETURN Self //============================================================ -CLASS UWMenu - DATA aItems INIT {} - METHOD AddItem() - METHOD Paint() +CREATE CLASS UWMenu + + DATA aItems INIT {} + + METHOD AddItem( cTitle, cLink ) + METHOD Paint() + ENDCLASS +FUNCTION UWMenuNew() -FUNC UWMenuNew() -LOCAL oB := UWMenu() -RETURN oB + LOCAL oB := UWMenu() + RETURN oB -METHOD AddItem(cTitle, cLink) CLASS UWMenu - AADD(Self:aItems, {cTitle, cLink}) -RETURN Self +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 + 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. +CREATE CLASS UWBrowse + + DATA cID + DATA aColumns INIT {} + DATA nArea + + DATA nRecno + DATA lBof INIT .F. + DATA lEof INIT .F. + + METHOD AddColumn( nID, cTitle, cField, lRaw ) + METHOD Paint() + METHOD PaintBody() + METHOD Ajax( cAction ) + METHOD Skipper( nSkip ) - METHOD AddColumn() - METHOD Paint() - METHOD PaintBody() - METHOD Ajax() - METHOD Skipper() ENDCLASS +FUNCTION UWBrowseNew( cID ) -FUNC UWBrowseNew(cID) -LOCAL oW := UWBrowse() - SetWId(oW, cID) - oW:nArea := SELECT() -RETURN oW + LOCAL oW := UWBrowse() + SetWId( oW, cID ) + oW:nArea := Select() -METHOD AddColumn(nID, cTitle, cField, lRaw) CLASS UWBrowse - AADD(Self:aColumns, {nID, cTitle, cField, !EMPTY(lRaw)}) -RETURN Self + 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 + 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('') + LOCAL nI, nJ, xI, xField, nArea - // Header - UWrite('') - FOR nI := 1 TO LEN(Self:aColumns) - UWrite('') - NEXT - UWrite('') + 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( '
' + UHtmlEncode(Self:aColumns[nI, 2]) + '
' ) - // 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) + // 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 - 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 + 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 := RTrim( 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( '' + xI + '' ) + NEXT + UWrite( '' ) + dbSkip() + NEXT + UWrite( '' ) + dbSelectArea( nArea ) + RETURN Self -METHOD Ajax(cAction) CLASS UWBrowse -LOCAL nI, nJ, aI, aJ, xI +METHOD Ajax( cAction ) CLASS UWBrowse - IF cAction == "nextpg" - (Self:nArea)->(Self:Skipper(20)) - ELSEIF cAction == "prevpg" - (Self:nArea)->(Self:Skipper(-20)) - ENDIF - Self:PaintBody() -RETURN Self + 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() +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) - Self:lBof := .F. - ENDIF - ENDIF - Self:nRecno := RECNO() -RETURN Self + ELSE + dbSkip( - 1 ) + IF Bof() + Self:lBof := .T. + ELSE + dbSkip( 1 ) + Self:lBof := .F. + ENDIF + ENDIF + Self:nRecno := RecNo() + + RETURN Self /******************************************************************** @@ -425,96 +487,100 @@ RETURN Self * ********************************************************************/ -PROC UProcWidgets(cURL, aMap) -LOCAL aStack, aURL, aFrame, cI, nI, nL, lRet +PROCEDURE UProcWidgets( cURL, aMap ) - ? "cURL:", cURL - IF HB_HHasKey(aMap, cURL) - // aStack[i] = {url_part, function, variables} - IF (aStack := hb_HGetDef(session, "_ustack")) == NIL - session["_ustack"] := aStack := {} - ENDIF + LOCAL aStack, aURL, aFrame, cI, nI, nL, lRet - aURL := split("/", cURL) - nI := 1 - nL := MIN(LEN(aURL), LEN(aStack)) - DO WHILE nI <= nL - IF aStack[nI, 1] == aURL[nI] - nI++ - ELSE - EXIT + ? "cURL:", cURL + IF HB_HHasKey( aMap, cURL ) + // aStack[i] = {url_part, function, variables} + IF ( aStack := hb_HGetDef( session, "_ustack" ) ) == NIL + session["_ustack"] := aStack := {} ENDIF - ENDDO - // Exit procedures - DO WHILE nI <= LEN(aStack) - aFrame := ATAIL(aStack) - IF aFrame[2] != NIL - session["_uthis"] := aFrame[3] - EVAL(aFrame[2], "EXIT") + 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 - ASIZE(aStack, LEN(aStack) - 1) - ENDDO - aFrame := NIL + ELSE + USetStatusCode( 404 ) + ENDIF - 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 + RETURN + +PROCEDURE UWDefaultHandler( cMethod ) + + LOCAL cID, oW + + IF cMethod == "GET" + IF ( cID := hb_HGetDef( get, "ajax" ) ) == NIL + session["_uthis", "main"]:Paint() ELSE - AADD(aStack, {aURL[nI], NIL, NIL}) + IF ( oW := GetWidgetById( cID ) ) != NIL + UAddHeader( "Content-type", "text/html; charset=windows-1257" ) + oW:Ajax( hb_HGetDef( get, "action" ) ) + ENDIF ENDIF - nI++ - ENDDO + ENDIF - 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 + RETURN +STATIC PROC SetWId( oW, cID ) -PROC UWDefaultHandler(cMethod) -LOCAL cID, oW - IF cMethod == "GET" - IF (cID := hb_HGetDef(get, "ajax")) == NIL - session["_uthis", "main"]:Paint() - ELSE - IF (oW := GetWidgetById(cID)) != NIL - UAddHeader("Content-type", "text/html; charset=windows-1257") - oW:Ajax(hb_HGetDef(get, "action")) - ENDIF - ENDIF - ENDIF -RETURN + IF cID != NIL + oW:cID := cID + session["_uthis", "idhash", cID] := oW + ENDIF + RETURN -STATIC PROC SetWId(oW, cID) - IF cID != NIL - oW:cID := cID - session["_uthis", "idhash", cID] := oW - ENDIF -RETURN - - -FUNC GetWidgetById(cID) -RETURN hb_HGetDef(session["_uthis", "idhash"], cID) +FUNCTION GetWidgetById( cID ) + RETURN hb_HGetDef( session["_uthis", "idhash"], cID )