c64http.bas
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Show hidden characters
10 rem c64u uci http query tester v1.6
20 print chr$(147):poke646,1:print "c64u uci http qry v1.6"
30 rem c() is command bytes, d() is uci reply bytes
40 dim c(260),d(260):dc=260
50 rem endpoint pieces: httpbin echoes query in json args
60 hn$="httpbin.org":qp$="codex=basic&uci=1"
70 pa$="/get?"+qp$:ag$="c64u-basic/1.0"
80 rem find uci, identify network target, open tcp
90 gosub 1000:if er then end
100 co=3:m$="uci base "+str$(ba):gosub 900
110 co=7:m$="identify network":gosub 900
120 c(0)=3:c(1)=1:cl=2:gosub 3000
130 if er then co=2:m$="identify failed "+s$:gosub 900:end
140 co=5:m$="network target ok":gosub 900
150 co=7:m$="open tcp "+hn$+":80":gosub 900
160 c(0)=3:c(1)=7:c(2)=80:c(3)=0:cl=4
170 q$=hn$+chr$(0):gosub 2000
180 gosub 3000
190 if er then co=2:m$="open failed "+s$:gosub 900:end
200 if dl<1 then co=2:m$="no socket id":gosub 900:end
210 so=d(0):co=5:m$="socket "+str$(so):gosub 900
220 rem build readable http request from strings
230 co=7:m$="build http request":gosub 900
240 rq$="GET "+pa$+" HTTP/1.1"+chr$(13)+chr$(10)
250 rq$=rq$+"Host: "+hn$+chr$(13)+chr$(10)
260 rq$=rq$+"User-Agent: "+ag$+chr$(13)+chr$(10)
270 rq$=rq$+"Accept: */*"+chr$(13)+chr$(10)
280 rq$=rq$+"Connection: close"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
290 rem write_socket command: target 3, command 17, socket, payload
300 co=7:m$="send http request":gosub 900
310 c(0)=3:c(1)=17:c(2)=so:cl=3
320 q$=rq$:gosub 2000:wr=cl-3
330 gosub 3000
340 if er then co=2:m$="write failed "+s$:gosub 900:gosub 7000:end
350 if dl<2 then co=2:m$="write reply short":gosub 900:gosub 7000:end
360 ac=d(0)+256*d(1)
370 if ac<wr then co=2:m$="short write "+str$(ac):gosub 900:gosub 7000:end
380 co=5:m$="request sent":gosub 900
390 rem read response in chunks and print only body
400 co=7:m$="read response":gosub 900
410 poke646,1:print "---- json body ----"
420 hd=0:hm=0:bt=0:id=0:rc=0
430 c(0)=3:c(1)=16:c(2)=so:c(3)=128:c(4)=0:cl=5
440 gosub 3000
450 if er and left$(s$,2)="02" then id=id+1:goto 530
460 if er and left$(s$,2)="01" then goto 570
470 if er then co=2:m$="read failed "+s$:gosub 900:gosub 7000:end
480 if dl<2 then id=id+1:goto 530
490 ac=d(0)+256*d(1)
500 if ac=0 then id=id+1:goto 530
510 id=0:rc=rc+ac
520 for i=2 to ac+1:x=d(i):gosub 5000:next i
530 if id<60 and rc<4096 then goto 430
540 if rc=0 then co=2:m$="no response":gosub 900:gosub 7000:end
550 if id>=60 then co=2:m$="read timeout":gosub 900:gosub 7000:end
560 goto 580
570 co=5:m$="closed by host":gosub 900 580 gosub 7000
590 co=5:m$="done bytes "+str$(rc):gosub 900 600 poke646,1:end
890 rem sub 900: print m$ using color co for progress/fail status
900 poke646,co:print m$:return 990 rem sub 1000: locate ultimate command interface base register
1000 er=0:ba=57116
1010 if peek(ba+1)=201 then gosub 1100:return
1020 ba=56860
1030 if peek(ba+1)=201 then gosub 1100:return 1040 ba=57340
1050 if peek(ba+1)=201 then gosub 1100:return
1060 co=2:m$="uci not enabled":gosub 900
1070 er=1:return
1090 rem sub 1100: derive uci register addresses from base ba
1100 cs=ba:cd=ba+1:rd=ba+2:sd=ba+3:return
1990 rem sub 2000: append q$ to c() after petscii-to-ascii mapping
2000 for i=1 to len(q$)
2010 x=asc(mid$(q$,i,1)):gosub 2200
2020 c(cl)=x:cl=cl+1:next i:return
2190 rem sub 2200: map one basic string byte x to network wire ascii
2200 if x=13 or x=10 or x=9 or x=0 then return
2210 if x>=193 and x<=218 then x=x-128:return
2220 if x>=65 and x<=90 then x=x+32:return
2230 if x>=97 and x<=122 then return
2240 if x>=32 and x<=126 then return
2250 x=63:return
2990 rem sub 3000: send c() command, collect d() reply and s$ status
3000 er=0:dl=0:sl=0:s$=""
3010 gosub 3400:if er then return
3020 for i=0 to cl-1:poke cd,c(i):next i 3030 poke cs,1
3040 for w=1 to 20000
3050 zt=peek(cs)
3060 if (zt and 128)<>0 then x=peek(rd):if dl<dc then d(dl)=x:dl=dl+1
3070 if (zt and 128)<>0 then goto 3050
3080 if (zt and 64)<>0 then x=peek(sd):if sl<240 then s$=s$+chr$(x):sl=sl+1
3090 if (zt and 64)<>0 then goto 3050
3100 ss=zt and 48
3110 if (zt and 8)<>0 then poke cs,8:er=1:s$="uci error":return
3120 if (zt and 4)<>0 then poke cs,4:goto 3050
3130 if ss=32 or ss=48 then poke cs,2:goto 3050
3140 if ss=0 and (zt and 1)=0 then goto 3180
3150 next w
3160 er=1:s$="uci timeout":return
3180 if sl<2 then er=1:s$="no status":return
3190 if left$(s$,2)<>"00" then er=1
3200 return
3390 rem sub 3400: drain old uci data/status and wait for idle
3400 for w=1 to 20000
3410 zt=peek(cs)
3420 if (zt and 128)<>0 then x=peek(rd):goto 3410
3430 if (zt and 64)<>0 then x=peek(sd):goto 3410
3440 ss=zt and 48
3450 if (zt and 8)<>0 then poke cs,8:goto 3410
3460 if (zt and 4)<>0 then poke cs,4:goto 3410
3470 if ss=32 or ss=48 then poke cs,2:goto 3410
3480 if ss=0 and (zt and 1)=0 then return
3490 next w
3500 er=1:s$="sync timeout":return 4990 rem sub 5000: skip http headers until cr/lf/cr/lf, then body
5000 if hd=1 then gosub 6000:return
5010 if hm=0 and x=13 then hm=1:return
5020 if hm=1 and x=10 then hm=2:return
5030 if hm=2 and x=13 then hm=3:return
5040 if hm=3 and x=10 then hd=1:print "httpbin /get? json:":return
5050 if x=13 then hm=1:return
5060 hm=0:return
5990 rem sub 6000: print one body byte in readable c64 text
6000 if x=13 then return
6010 if x=10 then print:return
6020 if x=9 then print " ";:return
6030 if x=123 or x=91 then print:print "(";:bt=bt+1:return
6040 if x=125 or x=93 then print:print ")";:bt=bt+1:return
6050 if x=92 then print "/";:bt=bt+1:return
6060 if x=44 then print ",":return
6070 if x>=97 and x<=122 then x=x-32
6080 if x>=32 and x<=95 then print chr$(x);:bt=bt+1:return
6090 print ".";:bt=bt+1:return
6990 rem sub 7000: close tcp socket through uci network target
7000 c(0)=3:c(1)=9:c(2)=so:cl=3:gosub 3000:return