MODULE WebCGI;
IMPORT
KernelLog, Strings, Commands, Streams, WebHTTP, Files, WebHTTPServer, Modules,
HTTPSupport;
TYPE
CGIContext* = OBJECT
VAR request* : HTTPSupport.HTTPRequest;
w* : Streams.Writer;
reply* : WebHTTP.ResponseHeader;
END CGIContext;
CGIContextProc = PROCEDURE(context : CGIContext);
CGIPlugin = OBJECT(WebHTTPServer.HTTPPlugin)
PROCEDURE CanHandle(host : WebHTTPServer.Host; VAR request : WebHTTP.RequestHeader; secure : BOOLEAN) : BOOLEAN;
VAR path : ARRAY 1024 OF CHAR;
BEGIN
WebHTTP.GetPath(request.uri, path);
RETURN MyMatch(path, "/CGI/")
END CanHandle;
PROCEDURE Handle(host : WebHTTPServer.Host; VAR request : WebHTTP.RequestHeader; VAR reply : WebHTTP.ResponseHeader;
VAR in : Streams.Reader; VAR out : Streams.Writer);
VAR r : HTTPSupport.HTTPRequest;
cgiContextProc : CGIContextProc;
w : Streams.Writer; chunker : WebHTTP.ChunkedOutStream;
context : CGIContext;
path : ARRAY 1024 OF CHAR;
BEGIN
NEW(r, request, in);
WebHTTP.GetPath(r.shortUri, path);
cgiContextProc := FindProcedure(r.shortUri);
IF (cgiContextProc # NIL) THEN
NEW(context); context.w := out; context.request := r; context.reply := reply;
cgiContextProc(context);
ELSE
NEW(chunker, w, out, request, reply);
reply.statuscode := WebHTTP.NotFound;
WebHTTP.SendResponseHeader(reply, out);
IF (request.method = WebHTTP.GetM) THEN
w.String("<html><head><title>404 - Not Found</title></head>");
w.String("<body>HTTP 404 - File Not Found<hr><address>");
w.String(WebHTTPServer.ServerVersion); w.String("</address></body></html>");
w.Ln; w.Update;
chunker.Close
END
END
END Handle;
END CGIPlugin;
CGIProcInfo = POINTER TO RECORD
name, procedure : ARRAY 128 OF CHAR;
next : CGIProcInfo;
END;
VAR
cgi : CGIPlugin;
cgiProcs : CGIProcInfo;
PROCEDURE MyMatch(VAR uri : ARRAY OF CHAR; y : ARRAY OF CHAR) : BOOLEAN;
VAR i : LONGINT;
BEGIN
WHILE (i < LEN(uri)) & (i < LEN(y)) & (uri[i] = y[i]) &(y[i] # 0X) DO INC(i) END;
RETURN(i < LEN(uri)) & (i < LEN(y)) & (y[i] = 0X)
END MyMatch;
PROCEDURE FindProcedure(name : ARRAY OF CHAR) : CGIContextProc;
VAR
cur : CGIProcInfo; cgiProc : CGIContextProc;
moduleName, procedureName : Modules.Name; msg : ARRAY 32 OF CHAR; res : LONGINT;
BEGIN {EXCLUSIVE}
Strings.Delete(name, 0, 5);
cur := cgiProcs;
WHILE cur # NIL DO
IF cur.name = name THEN
Commands.Split(cur.procedure, moduleName, procedureName, res, msg);
IF (res = Commands.Ok) THEN
GETPROCEDURE(moduleName, procedureName, cgiProc);
RETURN cgiProc;
END;
END;
cur := cur.next
END;
RETURN NIL
END FindProcedure;
PROCEDURE RegisterCGI*(context : Commands.Context);
VAR c : CGIProcInfo;
BEGIN {EXCLUSIVE}
NEW(c);
context.arg.SkipWhitespace; context.arg.String(c.name);
context.arg.SkipWhitespace; context.arg.String(c.procedure);
c.next := cgiProcs; cgiProcs := c;
StoreCGIs;
END RegisterCGI;
PROCEDURE StoreCGIs;
VAR f : Files.File;
w : Files.Writer;
cur : CGIProcInfo;
res : LONGINT;
n0, n1 : ARRAY 64 OF CHAR;
BEGIN
n0 := "CGIConfig.dat"; n1 := "CGIConfig.dat.Bak";
Files.Rename(n0, n1, res);
f := Files.New("CGIConfig.dat");
Files.OpenWriter(w, f, 0);
Files.Register(f);
cur := cgiProcs;
WHILE cur # NIL DO
w.Char('"'); w.String(cur.name); w.Char('"'); w.Char(09X);
w.Char('"'); w.String(cur.procedure); w.Char('"'); w.Ln;
cur := cur.next
END;
w.Update
END StoreCGIs;
PROCEDURE LoadCGIs;
VAR f : Files.File;
r : Files.Reader;
c : CGIProcInfo;
BEGIN
f := Files.Old("CGIConfig.dat");
IF f # NIL THEN
Files.OpenReader(r, f, 0);
WHILE r.res = 0 DO
NEW(c);
r.String(c.name); r.SkipWhitespace;
r.String(c.procedure);
IF r.res = 0 THEN c.next := cgiProcs; cgiProcs := c END;
r.SkipLn
END
END
END LoadCGIs;
PROCEDURE ListCGI*(context : Commands.Context);
VAR cur : CGIProcInfo;
BEGIN {EXCLUSIVE}
cur := cgiProcs;
WHILE cur # NIL DO
context.out.String(cur.name); context.out.String("-->"); context.out.String(cur.procedure); context.out.Ln;
cur := cur.next
END;
END ListCGI;
PROCEDURE Install*(context : Commands.Context);
VAR hl : WebHTTPServer.HostList;
BEGIN
IF cgi = NIL THEN
NEW(cgi, "CGI-Support");
hl := WebHTTPServer.FindHosts("");
hl.host.AddPlugin(cgi);
context.out.String("CGI support installed to default host"); context.out.Ln;
hl := WebHTTPServer.FindHosts("*");
WHILE (hl # NIL) DO
hl.host.AddPlugin(cgi);
context.out.String("CGI support installed to "); context.out.String(hl.host.name); context.out.Ln;
hl := hl.next
END;
ELSE
context.out.String("CGI support already installed"); context.out.Ln;
END;
END Install;
PROCEDURE Close;
VAR h : WebHTTPServer.HostList;
BEGIN
IF cgi # NIL THEN
h := WebHTTPServer.FindHosts("");
h.host.RemovePlugin(cgi);
h := WebHTTPServer.FindHosts("*");
WHILE (h # NIL) DO
h.host.RemovePlugin(cgi);
h := h.next
END;
KernelLog.String("CGI support removed"); KernelLog.Ln;
cgi := NIL
END
END Close;
BEGIN
LoadCGIs;
Modules.InstallTermHandler(Close)
END WebCGI.
WebHTTPServerTools.Start ~\r:FAT:/httproot \l:FAT:/httproot/HTTP.Log~
WebHTTPServerTools.Stop
WebCGI.RegisterCGI RegisterRaily4 RegisterRFW.RegisterRFW4 ~
WebCGI.RegisterCGI RegisterRaily3 RegisterRFW.RegisterRFW3 ~
WebCGI.ListCGI ~
WebCGI.Install ~
SystemTools.Free RegisterRFW WebCGI ~