Status: Unverified
GOAL:
How to serve HTML pages from a 4GL program
GOAL:
Sample HTTP server (HTTPD)
GOAL:
4GL sockets server
FACT(s) (Environment):
Progress 9.1x
FIX:
/*--------------------------------------------------------------------
Name: httpd.p
Purpose: Simple HTTP Daemon (web server) example for TCP Sockets in
Progress 4GL
Author: Edsel Garcia
Notes: You can use this sample code as the starting point of a
program for a server-side program that receives requests
as an HTTP server. To test the HTTP server, use a web
browser to enter a url such as:
'http://host:33735/'
where host is the IP Address or name of the computer,
or localhost if the web browser is on the same computer
that the program is running on. The port 33735 is the
default port number used by the program, but it can be
changed to any other number.
--------------------------------------------------------------------*/
DEFINE VARIABLE hServerSocket AS HANDLE NO-UNDO.
DEFINE VARIABLE vport AS INTEGER LABEL "TCP Port" FORMAT ">>>>9"
INITIAL 33735 NO-UNDO.
DEFINE BUTTON b-start LABEL "Start Server".
&IF "{&OPSYS}" = "WIN32" &THEN
DEFINE BUTTON b-visit LABEL "Test WebSite".
&ENDIF
DEFINE STREAM ifile.
DEFINE VARIABLE wlog AS LOGICAL NO-UNDO.
DEFINE VARIABLE hInstance AS INTEGER NO-UNDO.
SESSION:APPL-ALERT-BOXES = YES.
FORM vport
b-start
&IF "{&OPSYS}" = "WIN32" &THEN
b-visit
&ENDIF
WITH FRAME xx THREE-D SIDE-LABELS.
ON 'CHOOSE':U OF b-start
DO:
ASSIGN vport.
IF SELF:LABEL = "Start Server" THEN DO:
CREATE SERVER-SOCKET hServerSocket.
hServerSocket:SET-CONNECT-PROCEDURE("connProc").
wlog = hServerSocket:ENABLE-CONNECTIONS("-S " + STRING(vport))
NO-ERROR.
IF wlog THEN b-start:LABEL = "Stop Server".
ELSE MESSAGE "Server could not start." VIEW-AS ALERT-BOX.
END.
ELSE DO:
hServerSocket:DISABLE-CONNECTIONS().
DELETE OBJECT hServerSocket.
b-start:LABEL = "Start Server".
END.
RETURN.
END.
&IF "{&OPSYS}" = "WIN32" &THEN
ON 'CHOOSE':U OF b-visit
DO:
RUN ShellExecuteA(0, "open", "http://localhost:" + STRING(vport)
+ "/", "", "", 0, OUTPUT hInstance).
RETURN.
END.
&ENDIF
OS-CREATE-DIR "htdocs".
DISPLAY vport WITH FRAME xx.
ENABLE vport b-start
&IF "{&OPSYS}" = "WIN32" &THEN
b-visit
&ENDIF
WITH FRAME xx.
DISPLAY
"To test this server use a web browser and enter url:"
"http://server:port/" SKIP
"You can put files into dir htdocs to be be accessed via http" SKIP
"The section to return the MIME Types can be edited to add" SKIP
"support for additional types" SKIP
"Hit " + KBLABEL("END-ERROR") + " to terminate this session" FORMAT
"x(45)".
CREATE SERVER-SOCKET hServerSocket.
hServerSocket:SET-CONNECT-PROCEDURE("connProc").
hServerSocket:ENABLE-CONNECTIONS("-S " + STRING(vport)).
b-start:LABEL = "Stop Server".
WAIT-FOR WINDOW-CLOSE OF CURRENT-WINDOW.
hServerSocket:DISABLE-CONNECTIONS().
DELETE OBJECT hServerSocket.
PROCEDURE connProc.
DEFINE INPUT PARAMETER hSocket AS HANDLE. /*Socket implicitly
created*/
hSocket:SET-READ-RESPONSE-PROCEDURE ("readHandler", THIS-PROCEDURE).
END.
FUNCTION socketRead RETURNS CHARACTER (h AS HANDLE, l AS INTEGER):
DEFINE VARIABLE b AS MEMPTR NO-UNDO.
DEFINE VARIABLE s AS CHARACTER NO-UNDO.
SET-SIZE(b) = l + 1.
h:READ(b, 1, l, 1).
s = GET-STRING(b,1).
SET-SIZE(b) = 0.
RETURN s.
END.
PROCEDURE readHandler:
DEFINE VARIABLE l AS INTEGER NO-UNDO.
DEFINE VARIABLE str AS CHARACTER NO-UNDO.
DEFINE VARIABLE mBuffer AS MEMPTR NO-UNDO.
DEFINE VARIABLE wrequest AS CHARACTER NO-UNDO.
DEFINE VARIABLE wd.ata AS CHARACTER NO-UNDO.
l = SELF:GET-BYTES-AVAILABLE().
IF l > 0 THEN DO:
str = socketRead(SELF:HANDLE, l).
wrequest = ENTRY(1,str,CHR(10)).
SET-SIZE(mBuffer) = 1024.
wdata = "HTTP/1.0 200 OK~nServer: 4GL demo~nConnection: " +
"close~nContent-type: text/html~n~n".
wdata = wdata + '<A HREF="/">Home Page</a> | <A ' +
'HREF="/4gl.html">Sample Dynamic 4GL code</a> | <A ' +
'HREF="/about.html">About</a><HR>'.
IF ENTRY(1, wrequest, " ") = "GET" THEN DO:
CASE ENTRY(2, wrequest, " "):
WHEN "/" THEN
wdata = wdata
+ "Welcome to the Simple 4GL WebServer Example"
+ "<BR><BR><BR>"
+ 'Click <A HREF="/source.txt">here</a> to see the '
+ 'source code of this program. ({&FILE-NAME})'.
WHEN "/4gl.html" THEN RUN 4gltest (INPUT-OUTPUT wdata).
WHEN "/about.html" THEN
wdata = wdata + "The Simple 4GL Web Server Example was "
+ "written by Edsel Garcia at PSC Technical Suport"
+ "~n<BR>This program is intended to be an example "
+ "of using Progress 4GL server sockets.".
WHEN "/source.txt" THEN DO:
wdata = "".
RUN getfile ("{&FILE-NAME}").
END.
OTHERWISE DO:
wdata = "".
RUN getfile ("htdocs" + ENTRY(2, wrequest, " ")).
END.
END CASE.
END.
ELSE DO:
wdata = wdata + "Request: "
+ wrequest + "~nRequest not implemented.".
END.
IF wdata <> "" THEN DO:
PUT-STRING(mBuffer,1) = wdata.
SELF:WRITE (mBuffer,1,LENGTH(wdata)).
SET-SIZE(mBuffer) = 0.
END.
SELF:DISCONNECT().
END.
ELSE DO:
SELF:DISCONNECT().
END.
END.
PROCEDURE 4gltest:
DEFINE INPUT-OUTPUT PARAMETER wdata AS CHARACTER NO-UNDO.
DEFINE VARIABLE I AS INTEGER NO-UNDO.
wdata = wdata + "Today's date: " + STRING(TODAY) + " Time: " +
STRING(TIME,"HH:MM:SS") + "<BR>".
DO I = 1 TO 6:
wdata = wdata
+ "<H" + STRING(I) + ">"
+ "Header: " + STRING(I) + "</" +
STRING(I) + ">".
END.
END.
PROCEDURE getsource:
DEFINE VARIABLE wdata AS CHARACTER NO-UNDO.
DEFINE VARIABLE mBuffer AS MEMPTR NO-UNDO.
DEFINE VARIABLE wline AS CHARACTER NO-UNDO.
SET-SIZE(mBuffer) = 1024.
wdata = "HTTP/1.0 200 OK~nServer: 4GL demo~nConnection: "
+ "close~nContent-type: text/plain~n~n".
PUT-STRING(mBuffer,1) = wdata.
SELF:WRITE (mBuffer,1,LENGTH(wdata)).
FILE-INFO:FILE-NAME = "{&FILE-NAME}".
IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
wdata = "Source file not found.".
PUT-STRING(mBuffer,1) = wdata.
SELF:WRITE (mBuffer,1,LENGTH(wdata)).
RETURN.
END.
INPUT STREAM ifile FROM VALUE(FILE-INFO:FULL-PATHNAME).
REPEAT:
IMPORT STREAM ifile UNFORMATTED wline.
wdata = wline + "~n".
PUT-STRING(mBuffer,1) = wdata.
SELF:WRITE (mBuffer,1,LENGTH(wdata)).
END.
INPUT STREAM ifile CLOSE.
END.
PROCEDURE getfile:
DEFINE INPUT PARAMETER pfilename AS CHARACTER NO-UNDO.
DEFINE VARIABLE wdata AS CHARACTER NO-UNDO.
DEFINE VARIABLE mBuffer AS MEMPTR NO-UNDO.
DEFINE VARIABLE vdata AS RAW NO-UNDO.
DEFINE VARIABLE wcontent AS CHARACTER NO-UNDO.
/* MIME Types definition */
CASE ENTRY(2, pfilename, "."):
WHEN "txt" OR WHEN "ped" OR WHEN "p" THEN wcontent = "text/plain".
WHEN "html" OR WHEN "htm" THEN wcontent = "text/html".
WHEN. "gif" THEN wcontent = "image/gif".
WHEN "jpg" THEN wcontent = "image/jpeg".
OTHERWISE wcontent = "*/*".
END CASE.
SET-SIZE(mBuffer) = 4096.
FILE-INFO:FILE-NAME = pfilename.
wdata = "HTTP/1.0 200 OK~nServer: 4GL demo~nConnection: "
+ "close~nContent-type: "
+ wcontent
/*
+ "~n"
+ "Accept-Ranges: bytes~n"
+ "Content-Length: " + STRING(FILE-INFO:FILE-SIZE) + "~n"
+ "Connection: close"
*/
+ "~n~n".
IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
wdata = "HTTP/1.0 404 Not found~nServer: 4GL demo~nConnection: "
+ "close~nContent-type: text/html~n~n" + "Sorry page not found.".
PUT-STRING(mBuffer,1) = wdata.
SELF:WRITE (mBuffer,1,LENGTH(wdata)).
RETURN.
END.
PUT-STRING(mBuffer,1) = wdata.
SELF:WRITE (mBuffer,1,LENGTH(wdata)).
INPUT STREAM ifile FROM VALUE(FILE-INFO:FULL-PATHNAME) BINARY.
LENGTH(vdata) = 4096.
REPEAT:
IMPORT STREAM ifile UNFORMATTED vdata.
PUT-BYTES(mBuffer,1) = vdata.
SELF:WRITE (mBuffer,1,LENGTH(vdata)).
END.
LENGTH(vdata) = 0.
INPUT STREAM ifile CLOSE.
SET-SIZE(mBuffer) = 0.
END.
&IF "{&OPSYS}" = "WIN32" &THEN
PROCEDURE ShellExecuteA EXTERNAL "shell32.dll":
DEFINE INPUT PARAMETER hwnd AS LONG.
/* Handle to parent window */
DEFINE INPUT PARAMETER lpOperation AS CHAR.
/* Operation to perform: open, print */
DEFINE INPUT PARAMETER lpFile AS CHAR.
/* Document or executable name */
DEFINE INPUT PARAMETER lpParameters AS CHAR.
/* Command line parameters to executable in lpFile */
DEFINE INPUT PARAMETER lpDirectory AS CHAR.
/* Default directory */
DEFINE INPUT PARAMETER nShowCmd AS LONG.
/* whether shown when opened:
0 hidden, 1 normal, minimized 2, maximized 3,
0 if lpFile is a document */
DEFINE RETURN PARAMETER hInstance AS LONG.
/* Less than or equal to 32 */
END.
&ENDIF.