0Syntax10.Scn.Fnt DpVersionElemsAllocBeg#Syntax10.Scn.FntWindows PowerMac LinuxPowerMacWindows#Syntax10.Scn.Fnt (* Windows *)PowerMac Linux#Syntax10.Scn.Fnt (*Linux *)Syntax10i.Scn.FntpVersionElemsAllocEndInfoElemsAllocUSyntax10.Scn.FntSIStampElemsAlloc7 Oct 98O"Title": NNTP "Author": Hamader Peter "Abstract": implementation of the nntp protocol defined in rfc977 et al. "Keywords": netnews nntp internet "Version": 1.0 "From": ? "Until":  "Changes": no changes "Hints": be sure you have set the VersionElems properly 8FoldElemsNew8848@8888%8!8E888#88,85888v8 8^8K8M8688588-858,838$8w88#Syntax10.Scn.Fnt66 BEGIN T.WriteLn(w); T.Append(O.Log, w.buf) END EOL; 8*8#Syntax10.Scn.Fnt (* standard text callback procedure; appends req.tmpText to System.Log *) VAR r: T.Reader; ch: CHAR; BEGIN T.OpenReader(r, req.tmpText, 0); T.Read(r, ch); WHILE ~r.eot DO T.Write(w, ch); T.Read(r, ch) END; T.Append(O.Log, w.buf) END TCallBackProc; 8*8#Syntax10.Scn.Fnt.. BEGIN Msg(req.sResponse) END SCallBackProc; 818#Syntax10.Scn.Fnt (* get a return code from a status response stored in 'c' *) VAR i, code: INTEGER; BEGIN code := 0; i := 0; WHILE (c[i] >= "0") & (c[i] <= "9") DO code := code*10 + ORD(c[i])-48; INC(i) END; RETURN code END GetCode; 8898#Syntax10.Scn.Fnt(((* send the request with added CR-LF *)p#Syntax10.Scn.Fnt Windows PowerMac MacOberon LinuxPowerMacWindows#Syntax10.Scn.FntBBIF TCP.AvailToSend(req.conn.tcpConn) >= S.Length(req.str) + 2 THENPowerMac MacOberon Linux#Syntax10.Scn.FntBBIF TCP.AvailToSend(req.conn.tcpConn) >= S.Length(req.str) + 2 THEN"0p8w8#Syntax10.Scn.Fntgg readOrWrote := req.conn.buf.Read(req.conn.tcpConn, ch); IF readOrWrote THEN LOOP IF ch = LF THEN (* the status response ends *) req.sResponse[req.sResIndex] := 0X; req.statusCBP(req); IF ORD(req.sResponse[0])-48 IN {1, 2} THEN IF req.op IN sResponseOnly THEN req.state := done ELSE (* assume the a text response is available and try to read it *) req.state := readTextResponse END ELSIF (req.op = post) & (GetCode(req.sResponse) = postArticle) THEN req.state := prepareArticle; req.sResIndex := 0 ELSE req.state := done END; EXIT ELSE (* continue to read the status response *) req.sResponse[req.sResIndex] := ch; INC(req.sResIndex) END; IF ~req.conn.buf.Read(req.conn.tcpConn, ch) THEN EXIT END END END 28Q8#Syntax10.Scn.Fnt readOrWrote := req.conn.buf.Read(req.conn.tcpConn, ch); IF readOrWrote THEN bytes := 0; LOOP IF (ch # LF) THEN T.Write(w, ch); IF (req.s = 1) & (ch = ".") THEN req.s := 2 ELSIF (req.s = 2) & (ch = CR) THEN req.s := 3 ELSE req.s := 0 END ELSIF req.s = 0 THEN req.s := 1 ELSIF req.s = 3 THEN T.Append(req.tmpText, w.buf); req.textCBP(req); req.state := done; EXIT END; INC(bytes); IF (bytes = bytesATime) OR ~req.conn.buf.Read(req.conn.tcpConn, ch) THEN EXIT END END; T.Append(req.tmpText, w.buf) END -8 8#Syntax10.Scn.Fnt readOrWrote := req.conn.buf.Read(req.conn.tcpConn, ch); IF readOrWrote THEN LOOP IF ch = LF THEN req.sResponse[req.sResIndex] := 0X; req.statusCBP(req); TCP.Write(req.conn.tcpConn, CR); TCP.Write(req.conn.tcpConn, LF); req.state := done; EXIT ELSE req.sResponse[req.sResIndex] := ch; INC(req.sResIndex) END; IF ~req.conn.buf.Read(req.conn.tcpConn, ch) THEN EXIT END END END 88G8#Syntax10.Scn.Fnt T.OpenReader(req.reader, req.tmpText, 0); T.Read(req.reader, ch); i := 0; WHILE ~req.reader.eot DO IF (i = 0) & (ch = CR) THEN i := 1 ELSIF (i = 1) & (ch = "." ) THEN i := 2 ELSIF (i = 2) & (ch = CR) THEN T.Write(w, "."); i := 1 ELSE i := 0 END; IF ch = CR THEN T.Write(w, CR); T.Write(w, LF); ELSE T.Write(w, ch) END; T.Read(req.reader, ch) END; T.Write(w, CR); T.Write(w, LF); T.Write(w, "."); T.Write(w, CR); T.Write(w, LF); T.Delete(req.tmpText, 0, req.tmpText.len); T.Append(req.tmpText, w.buf); T.OpenReader(req.reader, req.tmpText, 0); req.state := sendArticle $88:Syntax10.Scn.Fnt CpVersionElemsAllocBeg#Syntax10.Scn.FntWindows PowerMac LinuxPowerMacWindows#Syntax10.Scn.Fnt00availToSend := TCP.AvailToSend(req.conn.tcpConn)PowerMac Linux pVersionElemsAllocEnd LOOP availToSend := MAX(LONGINT); readOrWrote := availToSend > 0; IF ~readOrWrote THEN EXIT END; IF availToSend > LEN(req.conn.buf.buf) THEN availToSend := LEN(req.conn.buf.buf) END; i := 0; WHILE ~req.reader.eot & (i= "0") & (host[0] <= "9") THEN TCP.HostByNumber(host, currC.serverAddr, res) ELSE TCP.HostByName(host, currC.serverAddr, res) END; currC.serverPort := port; IF res = TCP.Done THEN T.WriteString(w, "Set Server IP Address to "); IF (host[0] < "0") OR (host[0] > "9") THEN T.WriteString(w, host); T.WriteString(w, " = ") END; FOR i := -3 TO 0 DO serverAdr[i+3] := SHORT(ASH(currC.serverAddr, 8 * i) MOD 256) END; FOR i := 3 TO 0 BY -1 DO T.WriteInt(w, serverAdr[i], 0); IF i > 0 THEN T.Write(w, ".") END END; T.WriteLn(w); T.WriteString(w, " and TCP Port to "); T.WriteInt(w, currC.serverPort, 0); EOL ELSE currC.serverAddr := noAddr; Msg("Could not set Server IP Address") END END SetServer; 808#Syntax10.Scn.Fnt (* compute hash address from a string as key *) CONST charSetSize = 256; VAR i, adr: INTEGER; BEGIN i := 0; adr := 0; WHILE s[i] # 0X DO adr := ((adr*charSetSize)+ORD(s[i])) MOD cmdNum; INC(i) END; RETURN adr END HashAdr; 88#Syntax10.Scn.Fnt (* send a request to the connnection 'currC' *) VAR req: Request; i: INTEGER; cmdWord: ARRAY cmdLen OF CHAR; BEGIN IF currC.serverAddr = noAddr THEN T.WriteString (w, "Server address not set"); T.WriteLn(w); T.Append(O.Log, w.buf) ELSE NEW(req); COPY(reqStr, req.str); (* extract the command word from the request string and get the corresponding operation id *) i := 0; WHILE (i < cmdLen-1) & (reqStr[i] # 0X) & (CAP(reqStr[i]) >= "A") & (CAP(reqStr[i]) <= "Z") DO cmdWord[i] := reqStr[i]; INC(i) END; cmdWord[i] := 0X; S.Cap(cmdWord); req.op := cmds[HashAdr(cmdWord)].num; (* if it is a valid command then ... *) IF (req.op # noCmd) & (cmdWord = cmds[HashAdr(cmdWord)].str) THEN IF tmpText # NIL THEN req.tmpText := tmpText ELSE req.tmpText := TF.Text("") END; T.OpenReader(req.reader, req.tmpText, 0); req.conn := currC; req.state := sendRequest; req.safe := FALSE; req.time := 0; req.handle := Handler; req.sResIndex := 0; req.timeout := O.Time() + responseTimeout * oberonTimeUnit; req.s := 0; req.textCBP := th; req.statusCBP := sh; req.data := data; currC.InstallTask(req) ELSIF req.op = noCmd THEN Msg("command not supported") ELSE END END END Req; 89M8#Syntax10.Scn.Fnt (* returns whether a logical TCP connection exists or not *) BEGIN RETURN currC.triedToConnect & TCP.Connected(currC.tcpConn) END IsConnected; 8Hx8#Syntax10.Scn.Fntff (* tries to establish a logical TCP connection *) VAR res: INTEGER; req: Request; BEGIN TCP.Connect (currC.tcpConn, TCP.AnyPort, currC.serverAddr, currC.serverPort, connectTimeout, res); IF res # TCP.Done THEN T.WriteString(w, "No link (res="); T.WriteInt(w, res, 0); T.WriteString(w, ")"); IF res = TCP.Timeout THEN T.WriteString(w, ": timeout") ELSIF res = TCP.LocalPortInUse THEN T.WriteString(w, ": local port in use") END; EOL ELSE (*connection could be established *) NEW(req); req.conn := currC; req.state := readStatusResponse; req.safe := FALSE; req.time := 0; req.handle := Handler; req.sResIndex := 0; req.op := connect; req.s := 0; req.timeout := O.Time() + responseTimeout * oberonTimeUnit; req.textCBP := TCallBackProc; req.statusCBP := sh; req.data := data; currC.InstallTask(req) END; currC.triedToConnect := TRUE END Connect; 8L8#Syntax10.Scn.Fnt (* resets the NNTP module *) VAR t: Task; BEGIN t := O.CurTask(Task); t.conn.cancelAllRequests := FALSE; t.conn.RemoveTask(t) END ResetConn; 838#Syntax10.Scn.FntAA (* cancels all requests associates with 'currC' and empties the corresponding FIFO queues *) VAR task: Task; BEGIN IF currC.busy THEN currC.cancelAllRequests := TRUE; NEW(task); task.safe := FALSE; task.time := 0; task.handle := ResetConn; task.conn := currC; currC.InstallTask(task) END END CancelAllRequests; 88Syntax10.Scn.Fnt|r8FoldElemsNew#Syntax10.Scn.Fntll VAR pos: INTEGER; BEGIN pos := HashAdr(s); COPY(s, cmds[pos].str); cmds[pos].num := n END Insert; 89 (* initilalizes hash table with NNTP commands *) VAR i: INTEGER; PROCEDURE Insert(s: ARRAY cmdLen OF CHAR; n: SHORTINT);  BEGIN i := 0; FOR i := 0 TO cmdNum-1 DO cmds[i].str := ""; cmds[i].num := noCmd END; Insert("ARTICLE", article); Insert("BODY", body); Insert("GROUP", group); Insert("HEAD", head); Insert("HELP", help); Insert("LAST", last); Insert("LIST", list); Insert("NEWGROUPS", newGroups); Insert("NEWNEWS", newNews); Insert("NEXT", next); Insert("POST", post); Insert("QUIT", quit); Insert("STAT", stat); Insert("XOVER", xover) END InitCmds; 8&8#Syntax10.Scn.Fnt00 (* initilalizes 'currC' ; HAS TO BE called before usung 'currC' *) BEGIN NEW(currC.tcpConn); currC.busy := FALSE; currC.triedToConnect := FALSE; NEW(currC.reqQueue); currC.reqQueue.head := NIL; currC.reqQueue.tail := NIL; NEW(currC.buf); currC.buf.Reset; currC.cancelAllRequests := FALSE END Init; 888 MODULE NNTP; (* PowerMac *)  (* for a detailed description of types and constants see 'NetNews.Text' *) IMPORT TCP, T := Texts, TF := TextFrames, O:=Oberon, Input, S:=Strings; CONST  CR = 0DX; LF = 0AX; noCmd = -1; article* = 0; body* = 1; group* = 2; head* = 3; (* supported commands *) help* = 4; last* = 5; list* = 6; newGroups* = 7; newNews* = 8; next* = 9; post* = 10; quit* = 11; stat* = 12; connect = 13; xover* = 14; postArticle = 340; sResponseOnly* = {connect, stat, group, last, next, quit}; sendRequest* = 0; (* states of a task *) readStatusResponse* = 1; readTextResponse* = 2; readPostResponse* = 3; sendArticle* = 4; prepareArticle* = 5; done* = 6; cmdNum = 37; cmdLen = 12; reqLen* = 511; bufLen = 2048; bytesATime = 512; noAddr = 0FFFFFFFFH; stdConnectTimeout* = 10000; (* milliseconds *) stdResponseTimeout* = 50; (* seconds; response timeout for client and server once a connection has been established *) stdPort* = 119;  TYPE  Task = POINTER TO TaskDesc; Connection* = POINTER TO ConnectionDesc; Request* = POINTER TO RequestDesc; Queue = POINTER TO QueueDesc; QueueElem = POINTER TO QueueElemDesc; Data* = POINTER TO DataDesc; Buffer* = POINTER TO BufferDesc; CallBackProc* = PROCEDURE(req: Request); BufferDesc* = RECORD  buf: ARRAY bufLen OF CHAR; avail, len, pos: LONGINT END;  QueueDesc = RECORD  head, tail: QueueElem END; QueueElemDesc = RECORD  prev: QueueElem; t: Task END;  TaskDesc = RECORD (O.TaskDesc)  conn-: Connection; (* referencing the tcp/ip-connection *) END;  ConnectionDesc* = RECORD  cancelAllRequests: BOOLEAN; serverAddr: TCP.IpAdr; serverPort: INTEGER; tcpConn: TCP.Connection; busy-: BOOLEAN; triedToConnect: BOOLEAN; reqQueue: Queue; (* queue storing pending requests *) buf-: Buffer END;  RequestDesc* = RECORD (TaskDesc)  str: ARRAY reqLen OF CHAR; (* the command *) sResponse-: ARRAY reqLen OF CHAR; (* status-response *) sResIndex: INTEGER; (* lenght of the status-response *) tmpText-: T.Text; (* text, which is posted from / textresponses are temp. written to *) reader: T.Reader; (* reader on the text to be posted *) op-: SHORTINT; (* operation to be performed *) s, state-: SHORTINT; (* state of the request *) timeout: LONGINT; textCBP, statusCBP: CallBackProc; data*: Data END;  DataDesc* = RECORD END; Command = RECORD  str: ARRAY cmdLen OF CHAR; num: SHORTINT; END;  VAR  oberonTimeUnit: INTEGER; w: T.Writer; cmds: ARRAY cmdNum OF Command; responseTimeout-, connectTimeout-: LONGINT; PROCEDURE (b: Buffer) Reset*;  (* reset buffer to initial state *) BEGIN b.pos := 0; b.len := 0; b.avail := 0 END Reset;  PROCEDURE (b: Buffer) Read (conn: TCP.Connection; VAR ch: CHAR): BOOLEAN;  (* read from buffer, if available; else try to read from TCP connection *) BEGIN IF b.pos < b.len THEN ch := b.buf[b.pos]; INC(b.pos); RETURN TRUE ELSE IF b.avail = 0 THEN b.avail := TCP.Available(conn); IF TCP.res # TCP.Done THEN b.avail := 0; RETURN FALSE END END; IF b.avail > 0 THEN IF b.avail > bufLen THEN b.len := bufLen ELSE b.len := b.avail END; TCP.ReadBytes(conn, b.buf, 0, b.len); IF TCP.res = TCP.Done THEN DEC(b.avail, b.len); ch := b.buf[0]; b.pos := 1; RETURN TRUE END END END; RETURN FALSE END Read;  PROCEDURE (currC: Connection) InstallTask (t: Task);  (* add a task to the FIFO queue assiciated with 'currC'; similar to Oberon.Install *) VAR qe: QueueElem; BEGIN IF ~currC.busy THEN O.Install(t); currC.busy := TRUE ELSE NEW(qe); qe.t := t; qe.t.conn := currC; qe.prev := NIL; IF currC.reqQueue.tail # NIL THEN currC.reqQueue.tail.prev := qe END; currC.reqQueue.tail := qe; IF currC.reqQueue.head = NIL THEN currC.reqQueue.head := qe END END END InstallTask;  PROCEDURE (currC: Connection) RemoveTask (t: Task);  (* remove a task; if the queue associated with 'currC' is not empty, the next task (in FIFO order) is installed *) VAR newT: O.Task; BEGIN IF currC.reqQueue.head = NIL THEN currC.busy := FALSE ELSE newT := currC.reqQueue.head.t; IF currC.reqQueue.head = currC.reqQueue.tail THEN currC.reqQueue.head := NIL; currC.reqQueue.tail := NIL ELSE currC.reqQueue.head := currC.reqQueue.head.prev END; O.Install(newT) END; O.Remove(t) END RemoveTask;  PROCEDURE SetResponseTimeout* (n: LONGINT);  BEGIN responseTimeout := n END SetResponseTimeout;  PROCEDURE SetConnectTimeout* (n: LONGINT);  BEGIN connectTimeout := n END SetConnectTimeout;  PROCEDURE Msg* (s: ARRAY OF CHAR);  (* displays a message to the System.Log *) BEGIN T.WriteString(w, s); T.WriteLn(w); T.Append(O.Log, w.buf) END Msg;  PROCEDURE EOL;  PROCEDURE TCallBackProc* (req: Request);  PROCEDURE SCallBackProc* (req: Request);  PROCEDURE GetCode* (c: ARRAY OF CHAR): INTEGER;  PROCEDURE Handler;  (* task handler *) VAR req: Request; ch: CHAR; i: INTEGER; readOrWrote: BOOLEAN; availToSend: LONGINT; bytes: INTEGER; BEGIN req := O.CurTask(Request); IF req.conn.cancelAllRequests THEN req.conn.cancelAllRequests := FALSE; req.state := done END; readOrWrote := FALSE; CASE req.state OF sendRequest:   IF TRUE THEN (* because of bug in TCP for PowerMac see also other VersionElems in similar places*) TCP.WriteString(req.conn.tcpConn, req.str); TCP.Write(req.conn.tcpConn, CR); TCP.Write(req.conn.tcpConn, LF); req.state := readStatusResponse; readOrWrote := TRUE END  | readStatusResponse: (* read the status response from the connection *) | readTextResponse: (* read a text response from the connection *) | readPostResponse: (* read the response returned after an attempt to post *) | prepareArticle: (* prepare an article for posting *) | sendArticle: (* send an article to a connection *) ELSE req.state := done END; IF req.state = done THEN IF req.op = quit THEN TCP.Disconnect(req.conn.tcpConn) END; req.conn.RemoveTask(req) ELSE req.timeout := O.Time() + responseTimeout * oberonTimeUnit END; IF ~readOrWrote THEN IF O.Time() > req.timeout THEN Msg("no response"); IF req.state = readTextResponse THEN T.Write(w, CR); T.Write(w, "."); T.Write(w, CR); T.Append(req.tmpText, w.buf); req.textCBP(req) END; req.conn.RemoveTask(req) ELSIF (((req.state = sendArticle) & (TCP.AvailToSend(req.conn.tcpConn) = 0)) OR (TCP.Available(req.conn.tcpConn) = 0)) & ~TCP.Connected(req.conn.tcpConn) THEN Msg("Connection closed"); req.conn.RemoveTask(req) END END END Handler;  PROCEDURE (currC: Connection) SetServer* (host: ARRAY OF CHAR; port: INTEGER);  PROCEDURE HashAdr (s: ARRAY OF CHAR): INTEGER;  PROCEDURE (currC: Connection) Req* (reqStr: ARRAY OF CHAR; tmpText: T.Text; data: Data; th,sh: CallBackProc);  PROCEDURE (currC: Connection) IsConnected* (): BOOLEAN;  PROCEDURE (currC: Connection) Connect* (data: Data; sh: CallBackProc);  PROCEDURE ResetConn;  PROCEDURE (currC: Connection) CancelAllRequests*;  PROCEDURE InitCmds;  PROCEDURE(currC: Connection) Init *;  BEGIN  T.OpenWriter(w); Msg("NetNews for Oberon V1.2 / PH 1997"); oberonTimeUnit := Input.TimeUnit; InitCmds; responseTimeout := stdResponseTimeout; connectTimeout := stdConnectTimeout  END NNTP.