[Coco] Checking for carrier
Taylor, Phillip L CIV
Phillip.L.Taylor at uscg.mil
Fri Jan 13 11:33:36 EST 2017
Question how do you check for carrier if it's true or false?
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
----------------
Message: 7
Date: Wed, 11 Jan 2017 11:26:05 -0500
From: Barry Nelson <barry.nelson at amobiledevice.com>
To: coco at maltedmedia.com
Cc: "Taylor, Phillip L Civ" <phillip.l.taylor at uscg.mil>
Subject: [Coco] NitrOS9 BBS
Message-ID: <B0F21E33-3738-47DC-BD99-B6D156E7CDE4 at amobiledevice.com>
Content-Type: text/plain; charset="utf-8"
> Taylor, Phillip L CIV Phillip.L.Taylor at uscg.mil
> Wed Jan 11 10:38:21 EST 2017
>
> What if you want to write a bbs system and make it listen to the incoming
ports. How can this be done please?
For a serial line run:
tsmon /n &
Or for telnet/internet access run:
inetd &
More information on inetd can be found here:
https://urldefense.proofpoint.com/v2/url?u=https-3A__sourceforge.net_p_drive
wireserver_wiki_Using-5FDriveWire_-23inetd&d=CwIGaQ&c=0NKfg44GVknAU-XkWXjNxQ
&r=_wDO0Ub5GRKd_gN_Uz7gGyIfuv5XrYnarPGRxBtD3N0&m=FKtBGDTxQ780FnQjJxvNQuAFkOq
yW8nQpeT6pO9rIVI&s=NimW7p3LfM6cs2pxmKF3i2Jldh9fQGRajikEKE0Ef7I&e=
<https://urldefense.proofpoint.com/v2/url?u=https-3A__sourceforge.net_p_driv
ewireserver_wiki_Using-5FDriveWire_-23inetd&d=CwIGaQ&c=0NKfg44GVknAU-XkWXjNx
Q&r=_wDO0Ub5GRKd_gN_Uz7gGyIfuv5XrYnarPGRxBtD3N0&m=FKtBGDTxQ780FnQjJxvNQuAFkO
qyW8nQpeT6pO9rIVI&s=NimW7p3LfM6cs2pxmKF3i2Jldh9fQGRajikEKE0Ef7I&e= >
You can use an inetd.conf line like:
6809 telnet auth protect banner, login,
Login will prompt for a user name configured in /etc/passwd
-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/pkcs7-signature
Size: 3599 bytes
Desc: not available
URL:
<https://urldefense.proofpoint.com/v2/url?u=https-3A__pairlist5.pair.net_pip
ermail_coco_attachments_20170111_cf3de85b_attachment-2D0001.bin&d=CwIGaQ&c=0
NKfg44GVknAU-XkWXjNxQ&r=_wDO0Ub5GRKd_gN_Uz7gGyIfuv5XrYnarPGRxBtD3N0&m=FKtBGD
TxQ780FnQjJxvNQuAFkOqyW8nQpeT6pO9rIVI&s=Nz0MznSVP5-qnMq16BvyWssu_1kjr9_lbH80
za6sfDs&e= >
------------------------------
-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/x-pkcs7-signature
Size: 5379 bytes
Desc: not available
URL: <https://pairlist5.pair.net/pipermail/coco/attachments/20170113/85a3b69b/attachment.bin>
More information about the Coco
mailing list