100 REM NadaNet File Server 110 REM MJM - 02/28/07 120 : 130 GOTO 300 140 : 150 REM Install M/L routine at LC 160 READ V: IF V > - 1 THEN POKE LC,V:LC = LC + 1: GOTO 160 170 RETURN 180 : 190 REM Scan decimal or hex number 200 IF LEFT$ (S$,1) < > "$" THEN V = VAL (S$): RETURN 210 V = 0:I = 1: REM Hex 220 I = I + 1:A$ = MID$ (S$,I,1): IF A$ = "" THEN RETURN 230 A = ASC (A$) 240 IF "0" < = A$ AND A$ < = "9" THEN V = V * 16 + A - A0: GOTO 220 250 IF "A" < = A$ AND A$ < = "F" THEN V = V * 16 + A - AA + 10: GOTO 220 260 GOTO 2890: REM Parameter error if non-hex char 270 : 300 PRINT : PRINT "NadaNet File Server v1.1": PRINT 310 D$ = CHR$ (4) 320 A0 = ASC ("0"):AA = ASC ("A") 330 TAIL = 255: REM For tail of string 340 : 350 REM Applesoft Definitions 360 DA = 7 * 16 + 13: REM DATA pointer ($7D.7E) 370 ABEG = 6 * 16 + 7: REM Beginning of BASIC prog ($63.64) 380 APND = 10 * 16 + 15: REM End of BASIC prog ($AF.B0) 390 : 400 REM NadaNet Definitions 410 NP = 3 * 256 + 12 * 16 + 15: REM NADANET page ($3CF) 420 IF PEEK (NP - 2) < > 76 THEN PRINT "*** NadaNet not loaded.": STOP 430 IF PEEK (NP) < > 145 THEN PRINT "*** Not ProDOS environment.": STOP 440 ID = PEEK (NP - 3): REM Our NadaNet ID 450 : 460 REM File Server Definitions 470 FSRV = 16: REM Msg Class of File Server Requests 480 RADR = 2 * 256 + 6 * 16: REM Result Code address = $260 490 BUF = 4 * 4096:LBUF = 4 * 4096: REM $4000..$7FFF 500 XMAX = 1024: REM Maximum &PEEK or &POKE length 510 : 520 REM Command table 530 CN = 13: DIM C2$(CN): DIM CT$(CN) 540 FOR I = 1 TO CN: READ C2$(I),CT$(I): NEXT 550 DATA BL,OAD,BR,UN,RU,N: REM Data transfer to requester 560 DATA BS,AVE,SA,VE: REM Data transfer from requester 570 DATA CR,EATE,DE,LETE,LO,CK,RE,NAME,UN,LOCK,VE,RIFY: REM No transfer 580 DATA MO,N,ST,ATS: REM Server 590 : 600 LC = 768: REM Init Page 3 Location Counter ($300) 610 : 620 REM MLI caller (must be at $300) 630 MLI = LC: GOSUB 150:LC = 768 + 32: REM MLI param block 640 PB = 640: REM Pathname at $280 650 C = MLI + 3:PC = MLI + 9: REM MLI command addr & parm count addr 660 AUXT = MLI + 14: REM AUX TYPE field in parm table 670 GTINFO = 196:GPARS = 10: REM GETINFO = $C4, 10 params 680 STINFO = 195:SPARS = 7: REM SETINFO = $C3, 7 params 690 DATA 32,0,191,0,9,3,133,222,96,0,128,2,-1 700 : 710 REM Fold Request in BUF to Upper Case 720 FOLD = LC: GOSUB 150 730 POKE FOLD + 4,BUF / 256: POKE FOLD + 15,BUF / 256 740 DATA 162,1,189,0,64,240,12,201,97,144,5,41,223,157,0,64,232,208,239,96,-1 750 : 760 REM Reset stack ptr to 240 ($F0) 770 FIXST = LC: GOSUB 150 780 DATA 104,168,104,162,240,154,72,152,72,96,-1 790 : 800 REM Applesoft relocator and program starter 810 AGO = LC: GOSUB 150 820 ARL = LC - AGO: REM Length 830 DATA 165,103,164,104,133,94,132,95,24,160,1,177,94,208,11,165,175,133,105 840 DATA 165,176,133,106,76,102,213,160,4,200,177,94,208,251,200,152,101,94 850 DATA 170,160,0,145,94,165,95,105,0,200,145,94,134,94,133,95,144,210,-1 860 : 870 IF LC > 959 THEN PRINT "Page 3 overflow.": STOP 880 : 890 REM File Server Loop 900 : 910 & SERVE#(10): REM Give others a chance... 920 & GET MSG#(2,FSRV,LR,BUF): REM Get next request 930 IF PEEK (1) AND PEEK (2) GOTO 910: REM If none, try again. 940 IF PEEK (1) THEN PRINT "*** No Message server.": STOP 950 SQ = SQ + 1: REM Keep "total requests" stats 960 RID = PEEK (BUF): REM Requestor's ID 970 POKE BUF + LR,0: POKE BUF + LR + 1,0: POKE BUF + LR + 2,0: REM Add 3 nulls 980 CALL FOLD: REM Fold to upper 990 : 1000 SHOW = (RID = MR) OR MR > 99: REM MONitoring this request? 1010 IF NOT SHOW GOTO 1060 1020 PRINT "Request from "RID": <";: REM Print request 1030 FOR I = BUF + 1 TO BUF + LR - 1: PRINT CHR$ ( PEEK (I));: NEXT 1040 PRINT ">" 1050 : 1060 REM Scan request for command 1070 ERR = 128: REM Result code = good 1080 RL = 1: REM Default report length 1090 IF LR < 4 GOTO 2880: REM Command err (shortest is 3 chars) 1100 POKE DA,0: POKE DA + 1,BUF / 256: REM Set DATA ptr 1110 READ S$: REM Request to first comma 1120 A$ = LEFT$ (S$,2): REM First 2 chars 1130 CM = 0 1140 FOR I = 1 TO CN: REM Look up command 1150 IF A$ = C2$(I) THEN CM = I:I = CN 1160 NEXT 1170 IF NOT CM GOTO 2880: REM Command error 1180 : 1190 L = LEN (CT$(CM)): REM Length of rest of command 1200 IF MID$ (S$,3,L) < > CT$(CM) GOTO 2880: REM Command error 1210 IF SHOW THEN PRINT C2$(CM)CT$(CM)" recognized." 1220 IF CM = 13 GOTO 2600: REM Process STATS command 1230 : 1240 REM Scan pathname(s) 1250 P1$ = MID$ (S$,L + 3,TAIL):P2$ = "" 1260 IF LEFT$ (P1$,1) = " " THEN P1$ = MID$ (P1$,2,TAIL): GOTO 1260: REM Trim 1270 IF CM = 12 GOTO 2540: REM Process MON command 1280 IF CM = 9 THEN READ P2$:P2$ = "," + P2$: REM RENAME has 2nd pathname 1290 IF SHOW THEN PRINT "P1$[,P2$]=<"P1$P2$">" 1300 : 1310 REM Scan parameters 1320 FA = 0:FL = 0:FE = 0:FB = - 1:FT$ = "": REM Clear params 1330 : 1340 ONERR GOTO 1440: REM Parms finished if OUT OF DATA 1350 READ S$:A$ = LEFT$ (S$,1): REM First char 1360 S$ = MID$ (S$,2,TAIL): REM Rest of string 1370 IF A$ = "A" THEN GOSUB 200:FA = V: GOTO 1350 1380 IF A$ = "L" THEN GOSUB 200:FL = V: GOTO 1350 1390 IF A$ = "E" THEN GOSUB 200:FE = V: GOTO 1350 1400 IF A$ = "B" THEN GOSUB 200:FB = V: GOTO 1350 1410 IF A$ = "T" THEN FT$ = ",t" + S$: GOTO 1350 1420 GOTO 2890: REM Invalid parm 1430 : 1440 REM Process parms 1450 POKE 216,0: IF PEEK (222) < > 42 GOTO 2890: REM Parm error 1460 IF SHOW THEN PRINT "Parms: A="FA", L="FL", E="FE", B="FB", T="FT$ 1470 IF CM > 5 GOTO 2810: REM No data transfer 1480 RL = 5: REM Result includes A and L if data transfer 1490 : 1500 REM RUN or SAVE parm setup 1510 IF NOT (CM = 3 OR CM = 5) GOTO 1700 1520 FT$ = ",tbas" 1530 IF FB < > - 1 GOTO 2890: REM No offset on RUN or SAVE 1540 ONERR GOTO 2900: REM Trap errs 1550 & PEEK (RID,ABEG,2,BUF): REM Get A for RUN or SAVE 1560 FA = PEEK (BUF + 1) * 256 + PEEK (BUF): REM BASIC A parm 1570 IF CM = 3 GOTO 1790: REM Get L if RUN 1580 : 1590 & PEEK (RID,APND,2,BUF): REM Get BASIC end-of-prog for SAVE 1600 FL = ( PEEK (BUF + 1) * 256 + PEEK (BUF)) - FA 1610 ONERR GOTO 1650: REM Catch "doesn't exist" 1620 PRINT D$"verify"P1$ 1630 GOTO 1660: REM File exists, no CREATE 1640 : 1650 PRINT D$"create"P1$FT$: REM Doesn't exist, CREATE BAS file 1660 POKE 216,0 1670 GOTO 1860: REM Do SAVE 1680 : 1690 REM Get A info if needed 1700 IF FA GOTO 1770 1710 ONERR GOTO 2900: REM Get A info (and trap errs) 1720 PRINT D$"verify"P1$ 1730 POKE 216,0 1740 FA = PEEK (48826) * 256 + PEEK (48825): REM Aux Type = Addr 1750 : 1760 REM Get L info if not explicit 1770 IF FL GOTO 1860: REM Have L info, ignore any E, do cmd. 1780 IF FE THEN FL = FE - FA + 1: GOTO 1860: REM Get L from E, do cmd. 1790 ONERR GOTO 1810: REM Always causes an error! 1800 PRINT D$"bload"P1$FT$",a$400": REM (invalid address) 1810 POKE 216,0 1820 IF PEEK (222) < > 12 GOTO 2900: REM NO BUFFERS expected, else ERR 1830 FL = PEEK (48841) * 256 + PEEK (48840): REM L = EOF 1840 IF FB > 0 THEN FL = FL - FB: REM Compensate for offset if length implicit 1850 : 1860 SA = FA:SL = FL:SB = FB: REM Save A, L, and B for later 1870 IF SHOW THEN PRINT "Actual: A="FA", L="FL", E="FE", B="FB", T="FT$ 1880 PRINT D$"fre": REM Garbage collect to force strings out of BUF 1890 IF CM > 3 GOTO 2230: REM Data transfer <-- requester 1900 : 1910 REM Data transfer --> requester 1920 SR = SR + 1: REM Keep "read requests" stats 1930 SI = SI + FL: REM Keep "bytes read" stats 1940 IF FB < 0 THEN FB = 0: REM For BLOADs, omitted B is like B=0 1950 ONERR GOTO 2900 1960 REM If RUN, cancel report & stop requestor before data transfer 1970 IF CM = 3 THEN RL = 0: & CALL (RID,973) 1980 : 1990 TL = LBUF: IF FL < LBUF THEN TL = FL 2000 FL = FL - TL 2010 PRINT D$"bload"P1$FT$",a"BUF",l"TL",b"FB: REM Read data 2020 XB = BUF 2030 : 2040 REM Transfer BUF data to requester 2050 XL = XMAX: IF TL < XMAX THEN XL = TL 2060 TL = TL - XL 2070 & POKE (RID,FA,XL,XB) 2080 IF TL > 0 THEN FA = FA + XL:XB = XB + XL: GOTO 2050: REM POKE til done 2090 : 2100 IF FL > 0 THEN FB = FB + LBUF: GOTO 1990: REM Read til done 2110 : 2120 IF CM = 2 THEN ERR = 129: REM Tell requester to CALL BRUN code 2130 IF CM < > 3 GOTO 2960: REM Done if not RUN 2140 : 2150 REM RUN a BASIC program... 2160 PGND = SA + SL: REM Prog end = Start + Length 2170 POKE BUF + 1,PGND / 256: POKE BUF,PGND - 256 * PEEK (BUF + 1) 2180 & POKE (RID,APND,2,BUF): REM Set PRGEND = PGND 2190 & B RUN (RID,512,ARL,AGO): REM &BRUN Applesoft relocator/starter at $200 2210 GOTO 2960: REM Done 2220 : 2230 REM Data transfer <-- requester 2240 SW = SW + 1: REM Keep "write requests" stats 2250 SO = SO + FL: REM Keep "bytes written" stats 2260 ONERR GOTO 2900 2270 : 2280 TL = LBUF: IF FL < LBUF THEN TL = FL 2290 FL = FL - TL 2300 XB = BUF:WL = TL 2310 : 2320 REM Fill BUF from requester 2330 XL = XMAX: IF TL < XMAX THEN XL = TL 2340 TL = TL - XL 2350 & PEEK (RID,FA,XL,XB) 2360 IF TL > 0 THEN FA = FA + XL:XB = XB + XL: GOTO 2330: REM PEEK til done 2370 : 2380 REM For BSAVE, A and L are set only if B not provided 2390 IF FB > - 1 THEN PRINT D$"bsave"P1$FT$",a"BUF",l"WL",b"FB: REM Write data 2400 IF FB = - 1 THEN PRINT D$"bsave"P1$FT$",a"BUF",l"WL:FB = 0 2410 IF FL > 0 THEN FB = FB + LBUF: GOTO 2280: REM Loop til done 2420 POKE 216,0 2430 IF NOT (CM = 5 OR (CM = 4 AND SB < 0)) GOTO 2960: REM All done, unless... 2440 : 2450 REM If SAVE, or BSAVE and no B parm, fix AUXTYP address 2460 POKE PB, LEN (P1$): REM Set up pathname for MLI calls 2470 FOR I = 1 TO LEN (P1$): POKE PB + I, ASC ( MID$ (P1$,I,1)): NEXT 2480 POKE C,GTINFO: POKE PC,GPARS: CALL 768: REM GETINFO 2490 POKE AUXT + 1,SA / 256: POKE AUXT,SA - 256 * PEEK (AUXT + 1): REM Addr 2500 POKE C,STINFO: POKE PC,SPARS: CALL 768: REM SETINFO 2510 IF PEEK (222) GOTO 2900: REM Report any error 2520 GOTO 2960: REM All OK! 2530 : 2540 REM Process MON command 2550 IF P1$ = "" THEN MR = 0: GOTO 2960: REM MONitor off, OK. 2560 ONERR GOTO 2890: REM Parameter error 2570 MR = VAL (P1$): REM 0=off, >99=all, else MONitor MR's requests 2580 GOTO 2960 2590 : 2600 REM Process STATS command 2610 ONERR GOTO 2900 2620 LC = BUF + 1 2630 V = ID:N = 1: GOSUB 2730: REM Server ID 2640 V = SQ:N = 2: GOSUB 2730: REM Total Requests 2650 V = SX:N = 2: GOSUB 2730: REM Total Errors 2660 V = SR:N = 2: GOSUB 2730: REM Read Requests 2670 V = SI:N = 4: GOSUB 2730: REM Bytes Read 2680 V = SW:N = 2: GOSUB 2730: REM Write Requests 2690 V = SO:N = 4: GOSUB 2730: REM Bytes Written 2700 RL = LC - BUF 2710 GOTO 2960 2720 : 2730 REM POKE N bytes of V at LC 2740 FOR I = 1 TO N 2750 VV = INT (V / 256) 2760 POKE LC,V - VV * 256 2770 LC = LC + 1:V = VV 2780 NEXT 2790 RETURN 2800 : 2810 REM Process non-data transfer commands 2820 IF SHOW THEN PRINT "Command: <"C2$(CM)CT$(CM)P1$P2$FT$">" 2830 ONERR GOTO 2900 2840 PRINT D$C2$(CM)CT$(CM)P1$P2$FT$ 2850 GOTO 2960: REM No error! 2860 : 2870 REM Handle errors 2880 ERR = 16: GOTO 2910: REM Command (Syntax) error 2890 ERR = 11: GOTO 2910: REM Invalid Parameter error 2900 ERR = PEEK (222): POKE 216,0: REM ProDOS or BASIC error 2910 SX = SX + 1: REM Keep error stats 2920 IF SHOW THEN PRINT "===== Error "ERR" =====" 2930 GOTO 2970: REM Report error 2940 : 2950 REM Report result to requester 2960 IF SHOW THEN PRINT "===== No error =====" 2970 POKE 216,0 2980 IF RL = 0 GOTO 920: REM No report if RL=0 (RUN) 2990 POKE BUF,ERR 3000 IF RL < > 5 GOTO 3030: REM No addr & length 3010 POKE BUF + 2,SA / 256: POKE BUF + 1,SA - 256 * PEEK (BUF + 2): REM Address 3020 POKE BUF + 4,SL / 256: POKE BUF + 3,SL - 256 * PEEK (BUF + 4): REM Length 3030 & POKE #(RID,RADR,RL,BUF) 3040 IF PEEK (1) THEN PRINT "*** Requester "RID" not listening." 3050 CALL FIXST: REM Reset stack 3060 GOTO 920: REM Process next request