%include "C_Strings.Inc" %constinteger timer efn = 4 %constinteger timeout period = 20 %include "TFTP.Inc" %externalintegerfnspec set INet; ! Kernel mode.... %systemintegerfnspec setprv (%integer enbflg, %integername prvadr, %integer prmflg, prvprv) %constinteger enable privilege = 1 %constinteger disable privilege = 0 %constinteger PRV sysprv = 16_10000000 %owninteger sysprv priv1 = PRV sysprv, sysprv priv2 = 0 %systemintegerfnspec setimr (%integer efn, %integername daytim, %integer astadr, reqidt) %externalintegerfnspec INet assign(%string(15) device, %integername channel, unit) %recordformat IOSB fm(%short status, length, %integer extra) %systemintegerfnspec QIOW (%integer efn, chan, func, %record(IOSB fm)%name IOSB, %integer astadr, astprm, %integer P1, P2, P3, P4, P5, P6) %constinteger IO ReadVBlk = 16_0031 %constinteger IO WriteVBlk = 16_0030 %constinteger IO Create = 16_0033 !constinteger IO WritEOF = 16_0028 !constinteger IO ReadPrompt = 16_0037 %constinteger IOM Qualified = 16_0080 %systemintegerfnspec cancel (%integer channel) %externalstring(127)%fnspec sysmess(%integer which) %externalroutinespec dump(%bytename start, %integer bytes) %externalroutinespec wait(%integer msecs) %routine pdate printstring(date); space printstring(time); spaces(2) %end %routine convert plings(%string(*)%name s) %integer i %bytename ch %return %if s = "" %for i = 1, 1, length(s) %cycle ch == charno(s, i) ch = ':' %if ch = '!' %or ch = '+' %repeat %end %routine to lower(%string(*)%name s) %integer i %bytename ch %return %if s = "" %for i = 1, 1, length(s) %cycle ch == charno(s, i) ch = ch - 'A' + 'a' %if 'A' <= ch <= 'Z' %repeat %end %constinteger R0 = 0, R1 = 1 %routine net order short(%shortname X) *MovL _ X, R0 *MovB _ (R0), R1 *MovB _ 1(R0), (R0) *MovB _ R1, 1(R0) %end %constinteger idle = 0 %constinteger open = 1 %owninteger state = idle %owninteger channel = 0 %integerfn send packet(%record(tftp fm)%name p, %integer size) %record(IOSB fm) IOSB %integer status !! printstring("Sending..."); newline !! dump(byteinteger(addr(p)), size) status = QIOW(0, channel, IO writevblk, IOSB, 0, 0, addr(p), size, 0, 0, 0, 0) %result = status %if status & 1 = 0 %result = IOSB_status %end %integerfn receive packet(%record(tftp fm)%name p, %integername size) %record(IOSB fm) IOSB %integer status status = QIOW(0, channel, IO readvblk, IOSB, 0, 0, addr(p), 516, 0, 0, 0, 0) %result = status %if status & 1 = 0 %result = IOSB_status %if IOSB_status & 1 = 0 size = IOSB_length %result = 1 %end %routine send error(%integer code, %string(31) text) %record(tftp fm) t %integer status {} printstring("Send error code "); write(code, 0) {} printstring(", text """); printstring(text) {} print symbol('"'); newline t_op = tftp err t_error code = code Imp to C(text, t_error text(1)) {N} net order short(t_op) {N} net order short(t_error code) status = send packet(t, 4 + 1 + length(text)) !! printstring("Send error status: "); phex(status); newline %end %ownrecord(tftp fm) last = 0 %owninteger last block = 0 %owninteger last bytes = 0 %integerfn send data %result = send packet(last, last bytes + 4) %end %routine fill next %integer x %on 9 %start; -> filled; %finish last block = last block + 1 !! printstring("Fill next: "); write(last block, 0); newline last bytes = 0 %while last bytes < 512 %cycle read symbol(x) last bytes = last bytes + 1 last_data(last bytes) = x %repeat filled: last_op = tftp data last_block = last block {N} net order short(last_op) {N} net order short(last_block) %end %predicate open file(%string(127) filename) %on 9 %start; %false; %finish open input(3, filename); select input(3) state = open last block = 0 fill next %true %end %integerfn packet arrived(%record(tftp fm)%name t, %integer bytes) %string(127) file, mode !! dump(byteinteger(addr(t)), bytes) {N} net order short(t_op) %if t_op = tftp rrq %start C to Imp(t_text(1), file) convert plings(file) C to Imp(t_text(length(file) + 2), mode) to lower(mode) pdate printstring("Read """); printstring(file) printstring(""" mode "); printstring(mode) newline %if mode # "netascii" %start send error(0, "RRQ mode " . mode . " not implemented") %result = 0 %finish ! Open the file and send the first block %if state # idle %start ! This one is already open. If the last block sent was the ! first, then assume that it's a retransmission of a previous ! RRQ and send it again. Otherwise send an error response. %if last block = 1 %start %result = send data %else !? send error(4, "RRQ for open TID") %result = 0 %finish %finish %if open file(file) %start %result = send data %else send error(1, "No access to " . file) %result = 0 %finish %else %if t_op = tftp wrq C to Imp(t_text(1), file) convert plings(file) C to Imp(t_text(length(file) + 2), mode) to lower(mode) pdate printstring("WRQ """); printstring(file) printstring(""" mode "); printstring(mode) newline send error(0, "WRQ not implemented") %result = 0 %else %if t_op = tftp data send error(4, "DATA invalid (read-only server)") %result = 0 %else %if t_op = tftp ack %if state = idle %start !? send error(0, "ACK for idle TID??") %result = 0 %finish {N} net order short(t_block) !! printstring("ACK block "); write(t_block, 0); newline %if t_block = last block - 1 %start ! Re-send the last one %result = send data %else %if t_block = last block ! Want the next one %if last bytes < 512 %start ! The last block to go was a short one, so we can just ! close the file and free the context now. !! printstring("Last one has gone, close it all"); newline close input state = idle %result = 0; ! Pseudo-error takes us to "the top" %else fill next %result = send data %finish %else ! Out of sequence send error(4, "ACK out of sequence") %result = 0 %finish %else %if t_op = tftp err !! printstring("Err received!"); newline %result = 0 %else !! printstring("Dud op "); write(t_op, 0); newline send error(4, "Unknown op " . itos(t_op, 0)) %result = 0 %finish %end %owninteger awake = -1 %routine start clock %externalintegerspec clock tick %alias "TFTPD__CLOCK_TICK" %owninteger t1 = 8000 * (-10 000), t2 = -1 %integer status status = setimr(timer efn, t1, addr(clock tick), addr(clock tick)) %signal 15, status %if status & 1 = 0 %end %externalroutine clock tick %alias "TFTPD__CLOCK_TICK" %integer status %if awake = 0 %start ! Timed out status = cancel(channel) %else %if awake > 0 awake = 0 start clock %finish ! Else < 0, so stopping %end %begin %record(tftp fm) receive %recordformat connect fm(%integer ra, rp, lp) %record(connect fm) c %record(IOSB fm) IOSB %integer i, status, unit, bytes status = set INet %signal 15, status %if status & 1 = 0 status = INet assign("UDP", channel, unit) %signal 15, status %if status & 1 = 0 !! printstring("Channel "); write(channel, 0) !! printstring(" assigned to UDP"); write(unit, 0); newline the top: awake = -1 status = setprv(enable privilege, sysprv priv1, 0, 0) !! printstring("Enable status: "); phex(status); newline %signal 15, status %if status & 1 = 0 %cycle c_ra = 0; c_rp = tftp port; c_lp = tftp port status = QIOW(0, channel, IO create, IOSB, 0, 0, addr(c), 12, 0, 0, 0, 0) %exit %if status & 1 # 0 %and IOSB_status & 1 # 0 wait(8000) %repeat status = setprv(disable privilege, sysprv priv1, 0, 0) !! printstring("Disable status: "); phex(status); newline %signal 15, status %if status & 1 = 0 ! Now sit in a loop waiting for stuff to arrive.... state = idle %cycle status = receive packet(receive, bytes) %if status & 1 = 0 %start !! printstring("Receive failed: "); newline close input %if state # idle -> the top %finish start clock %if awake < 0 awake = 1 !! dump(byteinteger(addr(receive)), bytes) status = packet arrived(receive, bytes) %if status & 1 = 0 %start close input %if state # idle -> the top %finish %repeat %end %of %program