-- File: WebServerImpl.mesa - last edit:
-- AOF 12-Jan-97 18:40:43
-- DLion 2-Mar-96 23:43:55
-- Copyright (C) 1995, 1996, 1997 by Freier's Garage. All rights reserved.
DIRECTORY
ArpaRouter USING[InternetAddress, Port],
ArpaSMTP USING[
FreeInvalidRecipients, Handle, InvalidRecipientList, Open, Recipients,
RecipientsSequence, Post],
ArpaTypes USING[Port],
CmFile USING[
Close, Error, FindSection, FreeString, Handle, NextItem, UserDotCmOpen],
Environment USING[Block, Byte],
Format USING[Date, LongNumber, Number, NumberFormat, StringProc],
FormSW USING[DisplayItem],
Heap USING[MakeNode],
Http USING[
Create, Handle, ParseError, ParseRequest, ServeRequest, YafDate],
Inline USING[BITROTATE, BITXOR, LongCOPY],
MFile USING [Acquire, Error, Handle, Release, Rename],
MStream USING[Handle, Log, ReadOnly, SetLogReadLength],
Process USING[
Abort, DisableTimeout, EnableAborts, priorityBackground,
priorityForeground, priorityNormal,
SetPriority],
Stream USING[PutString],
String USING[
AppendString, CopyToNewString, Empty, Equal, Equivalent,
StringToDecimal],
System USING[GreenwichMeanTime, GetGreenwichMeanTime],
TcpStream USING[Failed, Handle, Listen, Suspended],
Time USING[Append, Current, Unpack],
WebCache USING[Element, Entry, Handle, Object, Value, CreateServerCache],
WebLog USING[CreateLog, LogHandle, LogObject],
WebTool USING[data, FormItems, Msg, Write, zone],
WebOps USING[Handle, param, Param, Servers, Service];
WebServerImpl: MONITOR
IMPORTS
ArpaSMTP, CmFile, Format, FormSW, Heap, Http, Inline, MFile, MStream,
Process, Stream, String, System, Time, TcpStream, WebCache,
WebLog, WebOps, WebTool
EXPORTS ArpaRouter, WebCache, WebLog, WebOps =
BEGIN
listener: LONG POINTER TO ListenerList ¬ NIL;
ListenerList: TYPE = RECORD[process: SEQUENCE COMPUTED NATURAL OF PROCESS];
Status: TYPE = {success, vacant, full};
servers: LONG POINTER TO WebOps.Servers ¬ NIL;
Port: PUBLIC --ArpaRouter-- TYPE = ArpaTypes.Port;
param: PUBLIC WebOps.Param ¬ [];
serverCache: PUBLIC --WebCache-- WebCache.Handle ¬ NIL;
logger: PROCESS ¬ NIL;
logMessage: CONDITION;
logAvailable: CONDITION;
messageQueue: MessageQueue;
logFilename: LONG STRING ¬ NIL;
MessageHandle: TYPE = LONG POINTER TO Message;
MessageQueue: TYPE = RECORD[head, tail: MessageHandle ¬ NIL];
Message: TYPE = RECORD[next: MessageHandle, message: WebLog.LogHandle];
ConvertToTajo: PUBLIC --WebOps--PROC[filename: LONG STRING] =
BEGIN
FOR index: NATURAL IN[1..filename.length) DO
IF (filename[index] = '/) THEN
filename[index] ¬ '>;
ENDLOOP;
SELECT TRUE FROM
(filename[0] # '/) => NULL;
(filename.length = 1) => filename.length ¬ 0;
ENDCASE => filename[0] ¬ '<;
END; --ConvertToTajo--
Logger: --FORKED-- PROC[] =
BEGIN
dequeue: ENTRY PROC[] RETURNS[msg: MessageHandle] =
BEGIN
ENABLE UNWIND => NULL;
WHILE (messageQueue.head = NIL) DO
WAIT logMessage;
ENDLOOP;
msg ¬ messageQueue.head;
IF ((messageQueue.head ¬ msg.next) = NIL) THEN
messageQueue.tail ¬ NIL;
END; --dequeue--
logFile: PROC[] RETURNS[lsH: MStream.Handle] =
BEGIN
put: Format.StringProc = {Stream.PutString[lsH, s]};
lsH ¬ MStream.Log[logFilename, []];
Stream.PutString[lsH, "Subject: "L];
Stream.PutString[lsH, logFilename];
Stream.PutString[lsH, "\nFrom: "L];
Stream.PutString[lsH, WebOps.param.serverName];
Stream.PutString[lsH, "\nDate: "L];
Format.Date[put, Time.Current[], full];
Stream.PutString[lsH, "\n\n"G];
END; --logFile--
put: Format.StringProc =
BEGIN
IF (s # NIL) THEN
BEGIN
Stream.PutString[lsH, s];
IF (WebTool.data.level > basic) THEN WebTool.Write[s];
END
ELSE
BEGIN
Stream.PutString[lsH, "-"L];
IF (WebTool.data.level > basic) THEN WebTool.Write["-"L];
END;
END; --put--
lsH: MStream.Handle ¬ logFile[];
Process.EnableAborts[@logMessage];
Process.DisableTimeout[@logMessage];
Process.EnableAborts[@logAvailable];
Process.DisableTimeout[@logAvailable];
Process.SetPriority[Process.priorityBackground];
DO ENABLE ABORTED => EXIT;
msg: MessageHandle ¬ dequeue[];
FormatIpAddress[put, msg.message.entry.ip];
put[" - - ["G];
Http.YafDate[put, msg.message.entry.gmt];
put["] """G];
put[msg.message.entry.request];
put[""" "G];
Format.Number[put, msg.message.entry.status, []];
put[" "G];
IF (msg.message.entry.content = 0) THEN put["-"]
ELSE Format.LongNumber[put, msg.message.entry.content, []];
put["\n"];
msg.message.destroy[msg.message]; --get rid of evidence
WebTool.zone.FREE[@msg]; --and the container
--the following test is just used as a hint--
IF (messageQueue.head = NIL) THEN
MStream.SetLogReadLength[lsH, lsH.getPosition[lsH]];
ENDLOOP;
lsH.delete[lsH];
END; --Logger--
MailLogFile: PUBLIC --WebLog-- PROC[] =
BEGIN
bad: BOOLEAN;
sendto: ArpaSMTP.Recipients;
invalid: LONG POINTER TO ArpaSMTP.InvalidRecipientList;
msH: MStream.Handle ¬ MStream.ReadOnly[logFilename, []];
smtp: ArpaSMTP.Handle ¬ ArpaSMTP.Open[
WebOps.param.mailHost, WebOps.param.serverName];
sendto ¬ WebTool.zone.NEW[ArpaSMTP.RecipientsSequence[1]];
sendto[0] ¬ WebTool.data.emailaddress;
[bad, invalid] ¬ ArpaSMTP.Post[smtp, NIL, sendto, msH];
IF (bad) THEN ArpaSMTP.FreeInvalidRecipients[smtp, invalid];
WebTool.zone.FREE[@sendto];
msH.delete[msH];
WebTool.Msg["\nE-mailed log file of "L];
Format.LongNumber[WebTool.Msg, msH.getPosition[msH], []];
WebTool.Msg[" bytes to "L];
WebTool.Msg[WebTool.data.emailaddress];
WebTool.Msg[" at "L];
Format.Date[WebTool.Msg, Time.Current[], full];
END; --MailLogFile--
CreateLog: PUBLIC --WebLog-- PROC[]
RETURNS[lH: WebLog.LogHandle] =
BEGIN
lH ¬ WebTool.zone.NEW[WebLog.LogObject ¬ [
destroy: DestroyLog, init: ResetLog, log: LogMessage,
entry: [gmt: System.GetGreenwichMeanTime[]]]];
END; --CreateLog--
LogMessage: PROC[h: WebLog.LogHandle] =
BEGIN
Enqueue: ENTRY PROC[container: MessageHandle] =
BEGIN
container.next ¬ messageQueue.tail;
messageQueue.tail ¬ container;
IF (messageQueue.head = NIL) THEN
BEGIN
messageQueue.head ¬ container;
NOTIFY logMessage;
END;
END; --Enqueue--
container: MessageHandle ¬ WebTool.zone.NEW[
Message ¬ [next: NIL, message: h]];
Enqueue[container];
END; --LogMessage--
ResetLog: PROC[lH: WebLog.LogHandle] =
BEGIN
lH.entry.content ¬ 0;
lH.entry.status ¬ 200;
WebTool.zone.FREE[@lH.entry.unk1];
WebTool.zone.FREE[@lH.entry.unk2];
IF (lH.entry.request # NIL) THEN
lH.entry.request.length ¬ 0;
END; --ResetLog--
DestroyLog: PROC[lH: WebLog.LogHandle] =
BEGIN
WebTool.zone.FREE[@lH.entry.unk1];
WebTool.zone.FREE[@lH.entry.unk2];
WebTool.zone.FREE[@lH.entry.request];
WebTool.zone.FREE[@lH];
END; --DestroyLog--
AddNewService: ENTRY PROC[sh: WebOps.Handle] RETURNS[BOOLEAN ¬ TRUE] =
BEGIN
count: NATURAL ¬ servers.count;
IF (count < WebOps.param.maxStreams) THEN
BEGIN
servers.count ¬ servers.count.SUCC;
servers[count] ¬ sh;
END
ELSE RETURN[FALSE];
END; --AddNewService--
GetIdleServer: ENTRY PROC[tsH: TcpStream.Handle] RETURNS[status: Status] =
BEGIN
ENABLE UNWIND => NULL;
FOR index: NATURAL IN[0..servers.count) DO
IF (servers[index].tsH = NIL) THEN
BEGIN
sh: WebOps.Handle ¬ servers[index];
sh.tsH ¬ tsH;
NOTIFY sh.condition;
status ¬ success;
WebTool.data.connectionsserved ¬
WebTool.data.connectionsserved.SUCC;
EXIT;
END;
REPEAT FINISHED =>
status ¬ (IF (index # servers.maxCount) THEN vacant ELSE full);
ENDLOOP;
RETURN [status];
END; --GetIdleServer--
Listener: --FORKED-- PROC[] RETURNS[] =
BEGIN
Process.SetPriority[Process.priorityForeground];
DO
ENABLE
BEGIN
ABORTED => EXIT;
TcpStream.Failed => RETRY;
END;
tsH: TcpStream.Handle ¬ TcpStream.Listen[
localPort: Port[param.webPort] !
TcpStream.Failed =>
BEGIN
WebTool.Msg["\nTcpStream.Listen failed - RETRYing "G];
Format.Date[WebTool.Msg, Time.Current[], full];
END];
worker: Status ¬ GetIdleServer[tsH];
FormSW.DisplayItem[
WebTool.data.formSW,
WebTool.FormItems[connectionsserved].ORD];
IF (worker = vacant) THEN
BEGIN
sh: WebOps.Handle ¬ WebTool.zone.NEW[
WebOps.Service ¬ [tsH: tsH]];
Process.EnableAborts[@sh.condition];
Process.DisableTimeout[@sh.condition];
IF (AddNewService[sh]) THEN sh.thread ¬ FORK ServiceThread[sh]
ELSE WebTool.zone.FREE[@sh];
END;
ENDLOOP;
END; --Listener--
FormatIpAddress: PROC[
format: Format.StringProc, address: ArpaRouter.InternetAddress,
clientData: LONG POINTER ¬ NIL] =
BEGIN
IP: TYPE = RECORD[a, b, c, d: Environment.Byte];
BEGIN
OPEN ip: LOOPHOLE[address, IP];
nf: Format.NumberFormat = [];
Format.Number[format, ip.a, nf, clientData];
format["."G, clientData];
Format.Number[format, ip.b, nf, clientData];
format["."G, clientData];
Format.Number[format, ip.c, nf, clientData];
format["."G, clientData];
Format.Number[format, ip.d, nf, clientData];
END;
END; --FormatIpAddress--
ProcessHttp: PROC[http: Http.Handle, tsH: TcpStream.Handle] =
BEGIN
port: Port;
major, minor: LONG STRING;
address: ArpaRouter.InternetAddress;
[remoteAddr: address, remotePort: port] ¬ tsH.findAddresses[];
http.tsH ¬ tsH;
DO --while http.persist--
ENABLE
BEGIN
ABORTED =>
BEGIN
major ¬ "**Processing aborted\n"G;
minor ¬ NIL;
GOTO exit;
END;
Http.ParseError =>
BEGIN
major ¬ "**Parsing error: "G;
minor ¬ SELECT where FROM
allow => "allow"G,
authorization => "authorization"G,
connection => "connection"G,
contentEncoding => "contentEncoding"G,
contentLength => "contentLength"G,
contentType => "contentType"G,
date => "date"G,
endOfStream => "endOfStream"G,
expires => "expires"G,
from => "from"G,
httpVersion => "httpVersion"G,
ifModifiedSince => "ifModifiedSince"G,
lastModified => "lastModified"G,
method => "method"G,
mimeVersion => "mimeVersion"G,
parseRequest => "parseRequest"G,
referer => "referer"G,
requestLine => "requestLine"G,
requestURI => "requestURI"G,
pragma => "pragma"G,
space => "space"G,
userAgent => "userAgent"G,
ENDCASE => "***"G;
GOTO exit;
END;
TcpStream.Suspended =>
BEGIN
major ¬ "**Transport failure\n"G;
minor ¬ SELECT why FROM
notSuspended => "notSuspended"G,
transmissionTimeout => "transmissionTimeout"G,
noRouteToDestination => "noRouteToDestination"G,
remoteServiceDisappeared => "remoteServiceDisappeared"G,
reset => "reset"G,
securityMismatch => "securityMismatch"G,
precedenceMismatch => "precedenceMismatch"G,
ENDCASE => "***"G;
GOTO exit;
END;
END;
http.logging ¬ WebLog.CreateLog[];
http.logging.entry.ip ¬ address;
Http.ParseRequest[http];
Http.ServeRequest[http];
http.logging.log[http.logging];
http.logging ¬ NIL;
<<
Keep all the storage allocated for this request. It's mostly
strings, and reset will set them back to emtpy. This will avoid
going through the heap on subsequent connections at the cost
of hanging on to the storage forever.
>>
http.reset[http];
IF (~http.persist) THEN EXIT;
REPEAT exit =>
BEGIN
http.logging.log[http.logging];
http.logging ¬ NIL;
WebTool.Write[major];
IF (minor # NIL) THEN
BEGIN
WebTool.Write[" "L];
WebTool.Write[minor];
END;
WebTool.Write["\n"L];
http.reset[http];
END;
ENDLOOP;
END; --ProcessHttp--
ServiceThread: --FORKED-- PROC[wsH: WebOps.Handle] RETURNS[] =
BEGIN
WaitForWork: ENTRY PROC[] RETURNS[tsH: TcpStream.Handle] =
BEGIN
ENABLE UNWIND => NULL;
WHILE (wsH.tsH = NIL)
DO WAIT wsH.condition; ENDLOOP;
tsH ¬ wsH.tsH;
wsH.tsH ¬ NIL;
END; --WaitForWork--
http: Http.Handle;
Process.SetPriority[Process.priorityNormal];
http ¬ Http.Create[NIL];
DO
ENABLE ABORTED => EXIT;
tsH: TcpStream.Handle ¬ WaitForWork[];
ProcessHttp[http, tsH];
tsH.close[ ! TcpStream.Suspended => CONTINUE];
tsH.destroy[tsH]; --then destroy the stream
ENDLOOP;
http.destroy[http];
END; --ServiceThread--
ProcessUserDotCm: PROC[] =
BEGIN
ENABLE CmFile.Error => CONTINUE; --looks grim
string, value: LONG STRING ¬ NIL;
cm: CmFile.Handle ¬ CmFile.UserDotCmOpen[]; --do we have one of these?
param ¬ []; --reset everything back to default values
IF (CmFile.FindSection[cm, "WEBSERVER"G]) THEN
DO
[string, value] ¬ CmFile.NextItem[cm];
IF (string = NIL) THEN EXIT; --end of the list
SELECT TRUE FROM
(String.Equivalent["Connection"G, string]) =>
param.persist ¬ IF (value = NIL) THEN FALSE
ELSE String.Equivalent[value, "Keep-Alive"G];
(String.Equivalent["Mailer"G, string]) =>
param.mailHost ¬ IF (value = NIL) THEN NIL
ELSE String.CopyToNewString[value, WebTool.zone];
(String.Equivalent["Server"G, string]) =>
param.serverName ¬ IF (value = NIL) THEN NIL
ELSE String.CopyToNewString[value, WebTool.zone];
(String.Equivalent["Root"G, string]) =>
param.serverRoot ¬ IF (value = NIL) THEN NIL
ELSE String.CopyToNewString[value, WebTool.zone];
(String.Equivalent["Port"G, string]) =>
IF (value # NIL) THEN
param.webPort ¬ String.StringToDecimal[value];
(String.Equivalent["Listeners"G, string]) =>
IF (value # NIL) THEN
param.listeners ¬ String.StringToDecimal[value];
(String.Equivalent["Streams"G, string]) =>
IF (value # NIL) THEN
param.maxStreams ¬ String.StringToDecimal[value];
(String.Equivalent["TokenLength"G, string]) =>
IF (value # NIL) THEN
param.tokenLength ¬ String.StringToDecimal[value];
(String.Equivalent["TokenDelta"G, string]) =>
IF (value # NIL) THEN
param.tokenDelta ¬ String.StringToDecimal[value];
(String.Equivalent["LogLength"G, string]) =>
IF (value # NIL) THEN
param.logLength ¬ String.StringToDecimal[value];
(String.Equivalent["LogDelta"G, string]) =>
IF (value # NIL) THEN
param.logDelta ¬ String.StringToDecimal[value];
ENDCASE;
IF (value # NIL) THEN value ¬ CmFile.FreeString[value];
string ¬ CmFile.FreeString[string];
ENDLOOP;
cm ¬ CmFile.Close[cm]; --and that's that
END; --ProcessUserDotCm--
StartServer: PUBLIC --WebServer-- PROC[] RETURNS[] =
BEGIN
length: NATURAL = 16; --"Log/Activity.log"
ProcessUserDotCm[]; --do that icky stuff
<<
The log file goes in "{serverRoot}Log/Activity.log".
If that file already exists, then rename it to
"{serverRoot}Log/Activity.{v}" where {v} is a zero filled
three digit number. The renaming process starts at version
equal 1, and increments the version number until there is
no collision.
>>
WebTool.zone.FREE[@logFilename];
IF (~String.Empty[param.serverRoot]) THEN
BEGIN
logFilename ¬ String.CopyToNewString[
param.serverRoot, WebTool.zone, length];
String.AppendString[logFilename, "Log/Activity.log"L];
END
ELSE
logFilename ¬ String.CopyToNewString[
"Log/Activity.log"L, WebTool.zone, 0];
ConvertToTajo[logFilename]; --make it a Tajo filename
BEGIN
ENABLE MFile.Error => CONTINUE;
append: Format.StringProc = {String.AppendString[logFilename, s]};
version: NATURAL ¬ 1;
nf: Format.NumberFormat = [10, TRUE, TRUE, 3];
mfH: MFile.Handle ¬ MFile.Acquire[logFilename, rename, []];
BEGIN
ENABLE MFile.Error => {version ¬ version + 1; RETRY};
logFilename.length ¬ logFilename.length - 3;
Format.Number[append, version, nf];
MFile.Rename[mfH, logFilename];
END;
MFile.Release[mfH];
END;
logFilename.length ¬ logFilename.length - 3;
String.AppendString[logFilename, "log"L];
serverCache ¬ WebCache.CreateServerCache[WebTool.data.cacheLimit];
servers ¬ WebTool.zone.NEW[
WebOps.Servers[WebOps.param.maxStreams] ¬ []];
logger ¬ FORK Logger[]; --used to asynchronously log messages
listener ¬ WebTool.zone.NEW[ListenerList[WebOps.param.listeners]];
FOR l: NATURAL IN[0..WebOps.param.listeners) DO
listener[l] ¬ FORK Listener[]; --listens for incoming connections
ENDLOOP;
IF (WebTool.data.serverstarted = NIL) THEN
WebTool.data.serverstarted ¬
WebTool.zone.NEW[StringBody[30]]
ELSE WebTool.data.serverstarted.length ¬ 0;
Time.Append[WebTool.data.serverstarted, Time.Unpack[]];
WebTool.data.connectionsserved ¬ 0;
FormSW.DisplayItem[
WebTool.data.formSW,
WebTool.FormItems[serverstarted].ORD];
FormSW.DisplayItem[
WebTool.data.formSW,
WebTool.FormItems[connectionsserved].ORD];
END; --Start--
StopServer: PUBLIC --WebServer-- PROC[] RETURNS[] =
BEGIN
FOR l: NATURAL IN[0..WebOps.param.listeners) DO
Process.Abort[listener[l]]; JOIN listener[l]; listener[l] ¬ NIL;
REPEAT FINISHED => WebTool.zone.FREE[@listener];
ENDLOOP;
FOR index: NATURAL IN[0..servers.count) DO
Process.Abort[servers[index].thread];
JOIN servers[index].thread;
REPEAT FINISHED => WebTool.zone.FREE[@servers];
ENDLOOP;
Process.Abort[logger]; JOIN logger; logger ¬ NIL;
serverCache.destroy[serverCache]; --we loose our cache
END; --Stop--
--SERVER CACHE--
CreateServerCache: PUBLIC --WebCache-- PROC[limit: LONG CARDINAL]
RETURNS[cache: WebCache.Handle] =
BEGIN
size: NATURAL = SIZE[WebCache.Value] * WebOps.param.modulus;
table: LONG POINTER ¬ Heap.MakeNode[WebTool.zone, size];
table ¬ NIL;
Inline.LongCOPY[from: table, to: table + 1, nwords: size - 1];
cache ¬ WebTool.zone.NEW[WebCache.Object ¬ [
modulus: WebOps.param.modulus, cacheLimit: limit,
prune: CachePrune, destroy: CacheDestroy,
put: CachePut, get: CacheGet,
release: DeleteElement, remove: CacheRemove,
hashTable: DESCRIPTOR[table, WebOps.param.modulus]]];
END; --CreateServerCache--
CachePrune: PROC[cache: WebCache.Handle] =
BEGIN
extract: ENTRY PROC[index: NATURAL] RETURNS[ce: WebCache.Entry] =
BEGIN
ce ¬ cache.hashTable[index];
SELECT TRUE FROM
(ce = NIL) => NULL; --empty slot in table
((now - ce.timestamp) < ancient) => ce ¬ NIL; --too young
ENDCASE => cache.hashTable[index] ¬ NIL; --it's dead
END; --extract--
ancient: System.GreenwichMeanTime = [20];
limit: NATURAL = WebOps.param.modulus;
now: System.GreenwichMeanTime ¬ System.GetGreenwichMeanTime[];
FOR index: NATURAL DECREASING IN[0..limit) DO
entry: WebCache.Entry ¬ extract[index];
IF (entry # NIL) THEN DeleteElement[cache, entry];
ENDLOOP;
WebTool.data.cacheCurrent ¬ (cache.cacheSize + 500) / 1000;
FormSW.DisplayItem[
WebTool.data.formSW, WebTool.FormItems[cacheCurrent].ORD];
END; --CachePrune--
CacheDestroy: PROC[cache: WebCache.Handle] =
BEGIN
table: LONG POINTER ¬ cache.hashTable.BASE;
cache.prune[cache];
WebTool.zone.FREE[@table];
WebTool.zone.FREE[@cache];
WebTool.data.cacheCurrent ¬ 0;
FormSW.DisplayItem[
WebTool.data.formSW, WebTool.FormItems[cacheCurrent].ORD];
END; --CacheDestroy--
CacheRemove: PROC[cache: WebCache.Handle, cv: WebCache.Entry] =
BEGIN
extract: ENTRY PROC[index: NATURAL] RETURNS[ce: WebCache.Entry] =
BEGIN
ce ¬ cache.hashTable[index];
IF (ce # NIL) THEN
BEGIN
IF (String.Equal[ce.url, cv.url]) THEN
cache.hashTable[index] ¬ NIL;
END;
END; --extract--
limit: NATURAL = WebOps.param.modulus;
now: System.GreenwichMeanTime ¬ System.GetGreenwichMeanTime[];
FOR index: NATURAL DECREASING IN[0..limit) DO
element: WebCache.Entry ¬ extract[index];
IF (element # NIL) THEN
BEGIN
DeleteElement[cache, element];
EXIT;
END;
ENDLOOP;
WebTool.data.cacheCurrent ¬ (cache.cacheSize + 500) / 1000;
FormSW.DisplayItem[
WebTool.data.formSW, WebTool.FormItems[cacheCurrent].ORD];
END; --CacheRemove--
CachePut: PROC[
cache: WebCache.Handle, url: LONG STRING, value: WebCache.Value] =
BEGIN
locate: ENTRY PROC[new: WebCache.Entry] RETURNS[old: WebCache.Entry] =
BEGIN
hash: CARDINAL ¬ CacheHash[cache.modulus, url];
THROUGH [0..3) WHILE ((entry ¬ cache.hashTable[hash]) # NIL) DO
IF (String.Equal[entry.url, url]) THEN EXIT;
hash ¬ (hash + cache.modulus - 2) MOD cache.modulus;
ENDLOOP;
old ¬ cache.hashTable[hash];
cache.hashTable[hash] ¬ new;
END; --locate--
entry: WebCache.Entry ¬ WebTool.zone.NEW[
WebCache.Element ¬ [
url: String.CopyToNewString[url, WebTool.zone],
timestamp: System.GetGreenwichMeanTime[], value: value]];
IF ((entry ¬ locate[entry]) # NIL) THEN DeleteElement[cache, entry];
cache.cacheSize ¬ cache.cacheSize + value.length;
WebTool.data.cacheCurrent ¬ (cache.cacheSize + 500) / 1000;
FormSW.DisplayItem[
WebTool.data.formSW, WebTool.FormItems[cacheCurrent].ORD];
END; --CachePut--
CacheGet: ENTRY PROC[cache: WebCache.Handle, url: LONG STRING]
RETURNS[WebCache.Entry] =
BEGIN
entry: WebCache.Entry;
hash: CARDINAL ¬ CacheHash[cache.modulus, url];
THROUGH [0..3) WHILE ((entry ¬ cache.hashTable[hash]) # NIL) DO
IF (String.Equal[entry.url, url]) THEN EXIT;
hash ¬ (hash + cache.modulus - 2) MOD cache.modulus;
REPEAT FINISHED => RETURN[NIL];
ENDLOOP;
entry.timestamp ¬ System.GetGreenwichMeanTime[];
entry.refcount ¬ entry.refcount.SUCC;
RETURN [entry];
END; --CacheGet--
CacheHash: INTERNAL PROC[modulus: CARDINAL, string: LONG STRING]
RETURNS[hash: CARDINAL ¬ 0] =
BEGIN
FOR index: NATURAL IN[0..string.length) DO
hash ¬ Inline.BITROTATE[Inline.BITXOR[hash, string[index]], 1];
ENDLOOP;
RETURN [hash MOD modulus];
END; --CacheHash--
DeleteElement: PROC[
cache: WebCache.Handle, entry: WebCache.Entry] =
BEGIN
deref: ENTRY PROC[] RETURNS[BOOLEAN] =
BEGIN
RETURN[(entry.refcount ¬ entry.refcount.PRED) = 0];
END; --deref--
IF (deref[]) THEN
BEGIN
cache.cacheSize ¬ cache.cacheSize - entry.value.length;
WebTool.zone.FREE[@entry.value]; --that's a string
WebTool.zone.FREE[@entry.url]; --that's the ident string
WebTool.zone.FREE[@entry]; --that's the container itself
END;
END; --DeleteElement
END....