[Coco] FW: [Non-DoD Source] Coco Digest, Vol 172, Issue 23
Taylor, Phillip L CIV
Phillip.L.Taylor at uscg.mil
Tue Jan 23 17:00:37 EST 2018
William
What would I need to change in order to use in this bbs software since the device names is n1 & n2 How to check of carrier is lost?
Thanks
Phil Taylor
Message: 5
Date: Tue, 10 Jan 2017 18:41:55 -0500
From: William Carlin <whcarlinjr at gmail.com>
To: CoCoList for Color Computer Enthusiasts <coco at maltedmedia.com>
Subject: Re: [Coco] [Non-DoD Source] Coco Digest, Vol 172, Issue 22
Message-ID:
<CABDDd1RFk-9Hg4tthhN1AcccFVVNK48wwvnoVGB58mHEHQju=g at mail.gmail.com>
Content-Type: text/plain; charset=UTF-8
Phillip,
Here is an example from the drivewire extras disk:
For this example, the inetd is going to be setup for a web server:
[/DD/SYS/ientd.conf]
80,runb,httpd
DriveWIre will be instructed to listen for connections on port 80. When it
does, the coco runs the runb Basic09 runtime and runb loads and executes
the Basic09 program httpd. The inconing serial connection is passed to the
httpd as the standard input.
[httpd.b09]
PROCEDURE httpd
(* HTTPD09 - process one http request, should be spawned by inetd *)
! This program is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
ON ERROR GOTO 99
BASE 0
DIM fp:BYTE
DIM errnum:BYTE
DIM req:STRING[255]
DIM target:STRING[255]
DIM lf:BYTE
DIM cr:BYTE
DIM inbyte:BYTE
DIM buffer(256):BYTE
TYPE RREGISTERS=CC,A,B:BYTE; DP:BYTE; X,Y,U:INTEGER
DIM rregs:RREGISTERS
DIM reqid:BYTE
DIM i,p:INTEGER
DIM httperr:STRING[40]
DIM dent(32):BYTE
lf=10
cr=13
(* turn off echo on the input path *)
(* this will be done by inetd in the future *)
(* get ss.opt *)
rregs.A = 0
rregs.B = 0
rregs.X = ADDR(buffer)
reqid = $8D
RUN SYSCALL(reqid,rregs)
(* set PD.EKO to 0 *)
buffer(4) = 0
(* set ss.opt *)
rregs.A = 0
rregs.B = 0
rregs.X = ADDR(buffer)
reqid = $8E
RUN SYSCALL(reqid,rregs)
(* read headers from client *)
REPEAT
req = ""
REPEAT
GET #0,inbyte
req = req + chr$(inbyte)
UNTIL inbyte = 13 or EOF(#0)
IF LEFT$(req,4) = "GET " THEN
target = req
ENDIF
UNTIL PEEK(ADDR(req)) = 13 OR EOF(#0)
(* just die if stdin is gone.. might help with hung runbs? *)
IF EOF(#0) THEN 99
(* fixup paths *)
IF left$(target,6) = "GET / " THEN
req = "/DD/WWWROOT/index.html"
ELSE
req = mid$(target,5,len(target) - 14)
ENDIF
IF right$(req,1) = "/" THEN
req = left$(req,len(req)-1)
ENDIF
(* "security" checks *)
target = ""
FOR i=1 TO SIZE(req)
inbyte=ASC(MID$(req,i,1))
IF $40<inbyte AND inbyte<$60 THEN
inbyte = inbyte + $20
ENDIF
target=target + CHR$(inbyte)
NEXT i
IF (SUBSTR("..",req) > 0) OR (SUBSTR("/sys/",target) > 0) THEN
httperr = "403 Forbidden"
GOTO 1000
ENDIF
(* /favicon.ico *)
IF (req = "/favicon.ico") THEN
req = "/DD/WWWROOT/favicon.ico"
ENDIF
ON ERROR GOTO 100
OPEN #fp,req:READ
ON ERROR GOTO 50
httperr = "200 OK"
GOSUB 2000
IF RIGHT$(req,4) = ".htm" OR RIGHT$(req,5) = ".html" THEN
PRINT "Content-Type: text/html"
ELSE
IF RIGHT$(req,4) = ".jpg" THEN
PRINT "Content-Type: image/jpeg"
ELSE
IF RIGHT$(req,4) = ".gif" THEN
PRINT "Content-Type: image/gif"
ELSE
IF RIGHT$(req,4) = ".png" THEN
PRINT "Content-Type: image/png"
ELSE
IF RIGHT$(req,4) = ".ico" THEN
PRINT "Content-Type: image/x-icon"
PRINT "Cache-Control: public, max-age=31536000"
ELSE
PRINT "Content-Type: text/plain"
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
PUT #1,lf
(* send file contents *)
REPEAT
rregs.A = fp
rregs.Y = 256
rregs.X = ADDR(buffer)
reqid = $89
RUN SYSCALL(reqid,rregs)
rregs.A = 1
rregs.X = ADDR(buffer)
reqid = $8A
RUN SYSCALL(reqid,rregs)
UNTIL EOF(#fp)
50 ON ERROR GOTO 99
CLOSE #fp
target = DATE$ + " 200 OK " + req
GOSUB 3000
99 END
100 ON ERROR GOTO 99
errnum := ERR
IF errnum = 214 THEN
(* directory check *)
ON ERROR GOTO 200
OPEN #fp,req:READ+DIR
ON ERROR GOTO 99
httperr = "200 OK"
GOSUB 2000
PRINT "Content-Type: text/html"
PUT #1,lf
PRINT "<HTML><HEAD><TITLE>"
PRINT "Directory of ";req
PRINT "</TITLE></HEAD><BODY>"
PRINT "<H3>Directory of ";req;"</H3>"
PRINT "<HR>"
REPEAT
get #fp,dent
IF dent(0) > 0 THEN
target = ""
inbyte = dent(0)
i = 0
WHILE inbyte < 128 AND i<29 DO
target = target + chr$(inbyte)
i = i + 1
inbyte = dent(i)
ENDWHILE
target = target + chr$(inbyte - 128)
IF target <> "." THEN
PRINT "<A HREF=";req;"/";target;">";target;"</A>"
PRINT "<br>"
ENDIF
ENDIF
UNTIL EOF(#fp)
CLOSE #fp
GOSUB 2100
PRINT "</BODY></HTML>"
target = DATE$ + " 200 OK (dir) " + req
GOSUB 3000
END
ELSE
IF errnum = 216 THEN
httperr = "404 Not Found"
ELSE
IF errnum = 215 THEN
httperr = "400 Bad Request"
ELSE
httperr = "500 Internal Server Error"
ENDIF
ENDIF
GOTO 1000
ENDIF
200 ON ERROR GOTO 99
httperr = "403 Forbidden"
(* error result *)
1000 GOSUB 2000
PRINT "Content-Type: text/html"
PUT #1,lf
PRINT "<HTML>"
PRINT "<HEAD><TITLE>";httperr;"</TITLE></HEAD>"
PRINT "<BODY><H2>";httperr;"</H2>"
GOSUB 2100
PRINT "</BODY></HTML>"
target = DATE$ + " " + httperr + " " + req
GOSUB 3000
END
(* server headers *)
2000 PRINT "HTTP/1.1 ";httperr
PRINT "Server: CoCoHTTPD"
PRINT "Connection: close"
RETURN
(* footer *)
2100 PRINT "<br><HR><font face=Tahoma;Arial;Sans size=2><i>httpd09 version
1.1 -
";DATE$;"</i></font>"
RETURN
(* logging - string to log in target *)
3000 ON ERROR GOTO 3010
CREATE #fp,"/DD/LOG/httpd.log":WRITE
ON ERROR GOTO 3030
GOTO 3020
3010 ON ERROR GOTO 3040
OPEN #fp,"/DD/LOG/httpd.log":WRITE
ON ERROR GOTO 3030
(* getstat ss.siz *)
rregs.A = fp
rregs.B = $02
reqid = $8D
RUN SYSCALL(reqid,rregs)
(* seek to eof *)
rregs.A = fp
reqid = $88
RUN SYSCALL(reqid,rregs)
3020 WRITE #fp,target
3030 ON ERROR GOTO 3040
CLOSE #fp
3040 ON ERROR GOTO 99
RETURN
I hope this helps.
William
On Tue, Jan 10, 2017 at 12:45 PM, Taylor, Phillip L CIV <
Phillip.L.Taylor at uscg.mil> wrote:
> Robert
More information about the Coco
mailing list