.title KRTSER The server .ident "V03.62" ; /62/ 27-Jul-93 Billy Youdelman ; ; allow server to talk through the comm handler too.. ; move dispatch macro here ; add newline in log file at each new process ; /BBS/ 1-Dec-91 Billy Youdelman V03.61 ; ; gen.t filespec more carefully tested, defaults to .LST type ; double prompt on server exit killed by hosing ^M in FIN packet ; remget - now uses srcnam for input file ; no args to server command allowed under RT/TSX ; input file name to serv.r checked by fparse ; gen.c inserts colon after device name if necessary ; upcase incoming remote command args, so mskerm is happy ; gen.d checks for valid device before initiating any output, ; defaults to DK if no arg given, as from MSKermit ; modified gen.u to use krtdir ; remspa accepts optional device argument, gen.u passes to krtdir ; remfin returns error status in r0, to CONNECT if FINISH succeeds ; disallow running server unless link device is TT ; Brian Nelson 22-Dec-83 12:16:59 ; ; This is the server module for Kermit-11 ; it also has the modules to talk to a remote Kermit .include "IN:KRTMAC.MAC" .iif ndf KRTINC .error <; .include for IN:KRTMAC.MAC failed> .include "IN:KRTDEF.MAC" .iif ndf MSG$DA .error <; .include for IN:KRTDEF.MAC failed> .mcall .PURGE ; /62/ .macro dispat val,dsp,baseval,basedsp,default ; cmd dispatch tables .list me .save .nlist me .if nb .list me .psect genval ,ro,d,lcl,rel,con baseval: .psect gendsp ,ro,d,lcl,rel,con basedsp: .word default .nlist me .iff .list me .psect genval ,ro,d,lcl,rel,con .nlist me .if b .byte 0 .even .iff .byte val .list me .psect gendsp ,ro,d,lcl,rel,con .nlist me .word dsp .endc .endc .list me .restore .nlist me .endm .sbttl Local data .psect $pdata ; /62/ consolidated this stuff here.. A200$: .asciz "Get completed" A210$: .asciz "Get failed" A300$: .asciz 'Processing file name "' A301$: .asciz '"' B20$: .byte GN$EXIT ,0 B21$: .byte GN$BYE ,0 B22$: .asciz "Can't get the remote Kermit to " B23$: .asciz "FINISH" B24$: .asciz "LOGOUT" C20$: .asciz " block(s) copied to " ; /BBS/ C110$: .asciz "DK --> " delmsg: .asciz " deleted" exitxt: .asciz "%KRTSER-I-Server stopped" htxt: .ascii "The following commands are available on this Kermit-11" .ascii "server. To avoid ambiguity with local Kermit commands" .ascii "most of these server commands must be prefixed by the" .ascii "REMOTE keyword." .ascii "BYE Logs off the system" .ascii "REMOTE COPY Copy a file to another" .ascii "REMOTE CWD Changes server default" .ascii "REMOTE DELETE Erases specified file" .ascii "REMOTE DIR Displays a directory" .ascii "FINISH Exit server, reconnect" .ascii "GET Send file(s) to remote" .ascii "REMOTE HELP Prints this help text" .ascii "REMOTE RENAME Rename old file to new" .ascii "SEND Send file(s) to server" .ascii "REMOTE SPACE Shows blocks used/free" .ascii "REMOTE TYPE Types a specified file" .byte 0 invarg: .asciz "?KRTSER-E-Invalid arguments for remote server command" notimp: .asciz "?KRTSER-W-Unimplemented server command" notgen: .asciz "?KRTSER-W-Unimplemented server generic command" R20$: .asciz "1 file renamed" ; /BBS/ rem.01: .asciz "Remote not responding" rem.02: .asciz "Remote NAK'ed command" rem.03: .asciz "Bad checksum retry abort" rem.04: .asciz "Receive data failed" rem.ak: .asciz "Remote ACK:" rem.er: .asciz "Error from remote:" serpre: .asciz "%KRTSER-I-Server starting" sertxt: .ascii ". Return to your local machine by typing" .ascii "its escape sequence for closing the connection," .ascii " then issue further" .ascii "commands from there. To shut down the server," .ascii " use the BYE command" .asciz "to logout, or the FINISH command and then reconnect." serwn0: .asciz "Connecting to " serspd: .asciz " DTE speed: " serspx: .asciz "N/A" serwn1: .asciz "?KRTSER-W-Type ^C " serwn2: .asciz " times to stop the server from this terminal" typdef: .asciz ".LST" .even .psect $code .sbttl Call the server c$serv::tstb @argbuf ; if no arg, do normal server beq 1$ ; /BBS/ ok mov #er$ser ,r0 ; /BBS/ subcommands are not supported br 90$ ; /BBS/ goto error handler 1$: call seropn ; /62/ includes cantyp tst r0 ; /62/ did it work? bne 99$ ; /62/ no, error msg dumped by ttyini tst remote ; /62/ local or remote? bne 3$ ; /62/ remote, do appropriate message wrtall #serwn0 ; /62/ say where wrtall #ttname ; /62/ we're connected wrtall #serspd ; /62/ call ttspeed ; /62/ get speed tst r0 ; /62/ wuz it gettable? bne 21$ ; /62/ yup.. wrtall #serspx ; /62/ nope br 22$ ; /62/ continue 21$: call L10266 ; /62/ speed in r0 to TT 22$: .newline ; /62/ wrtall #serpre ; /62/ the minimum sign-on message.. wrtall #serwn1 ; /62/ and how to abort mov cc$max ,r0 ; /62/ it takes this many ^Cs inc r0 ; /62/ plus one for the .scca trap call L10266 ; /62/ put the total on the terminal wrtall #serwn2 ; /62/ and tag the display br 31$ ; /62/ leave cursor at end of the line 3$: wrtall #serpre ; /62/ the minimum sign-on message.. tst infomsg ; /41/ should we be verbose today? beq 30$ ; /41/ no wrtall #sertxt ; dump a message out please 30$: .newline ; /62/ tag minimum or whole message.. 31$: mov sp ,inserv ; global flag to say we are a server call server ; and do it clr inserv ; no longer a server wrtall #exitxt ; /BBS/ emulate C-Kermit.. br 99$ 90$: direrr r0 ; /BBS/ handle the error 99$: clr r0 ; /62/ success (error just handled..) jmp clostt ; /62/ close up the link .sbttl Server main_loop server: clr paknum ; packet_number := 0 clr cccnt ; /38/ clear ^C flag textsrc ; /38/ reset to normal file I/O mov #defchk ,chktyp ; checksum_type := type_1 mov #1 ,chksiz ; checksum_len := 1 mov $image ,image ; ensure correct default is set clr summary ; /BBS/ reset summary only flag clr dirflg ; /62/ reset embedded blanks flag call fixchk ; sendpar_checktype := set_checktype mov serwai ,sertim ; /41/ set a new time_out please bit #log$pa ,trace ; /62/ logging packets this time? beq 3$ ; /62/ no calls putrec ,<#0,#0,#lun.lo> ; /62/ ya, put newline into log file tst r0 ; /62/ did it work? beq 3$ ; /62/ ya call logerr ; /62/ no, handle the error 3$: rpack r2 ,r3 ,#packet,#maxlng ; /62/ loop forever clr sertim ; normal time_outs now movb sentim ,senpar+p.time ; /62/ default to send time_out scan r1 ,#sercom ; find the command in dispatch table asl r0 ; word indexing jsr pc ,@serdsp(r0) ; go run it tst r0 ; done? beq server ; /BBS/ no, next server command please calls suspend ,<#1> ; /BBS/ sleep a second jmp clrcns ; /62/ kill "double prompt" on exit dispat basedsp=serdsp ,baseval=sercom ,default=serv.$ dispat MSG$SND ,serv.s ; init to receive a file dispat MSG$RCV ,serv.r ; send a file dispat MSG$GENERIC ,serv.g ; do a server command dispat MSG$SER ,serv.i ; do a server sinit dispat TIMOUT ,serv$$ ; we timed out dispat BADCHK ,serchk ; a fubar checksum dispat MSG$NAK ,serv$$ ; a NAK this time dispat MSG$ACK ,serv$$ ; things are ok now dispat MSG$COMMAND ,serv.$ ; /BBS/ can't do host commands here dispat MSG$ERROR ,sernop ; ignore "E" packets from remote dispat .sbttl Server routines serv.$: strlen #notimp ; get length of this text into r0 spack #msg$error,paknum,r0,#notimp ; ignore unrecognized packet type clr r0 ; not done yet return serv$$: ; /62/ time_out, send a NAK please serchk: mov r3 ,paknum ; NAK checksum errors spack #msg$nak,paknum ; send the NAK out please sernop: clr r0 ; /62/ we are not done return serv.i: mov r3 ,paknum ; we got an init packet calls rpar ,<#packet,r2> ; save the other Kermit's parameters calls spar ,<#packet> ; get our parameters spack #msg$ack,paknum,sparsz,#packet ; send them to the other Kermit clr r0 ; not done jmp inirepeat ; /62/ init repeat char encoding serv.s: mov r3 ,paknum ; got an sinit, init packet number calls rpar ,<#packet,r2> ; store their send init info away calls spar ,<#packet> ; and send them ours for the ACK spack #msg$ack,paknum,sparsz,#packet call inirepeat ; do repeat initialization incm64 paknum ; paknum := paknum+1 mod 64 calls rec.sw ,<#sta.fil> ; and get set to receive a file name clr r0 ; not done return serv.r: calls bufunp ,<#packet,#spare1> ; /BBS/ use a spare buff clrb spare1(r1) ; /53/ null terminate it upcase #spare1 ; /BBS/ upper case it calls fparse,<#spare1,#srcnam> ; /BBS/ make sure it's an ok device tst r0 ; /BBS/ is it? bne 90$ ; /BBS/ nope.. calls fixwild ,<#srcnam> ; /BBS/ change "?" to "%" clr index ; first file in directory please call getnxt ; get the first file name tst r0 ; did it work? bne 100$ ; no, getnxt has sent the error pak calls sen.sw ,<#sta.sin> ; ya, send the file(s) br 100$ 90$: call generr ; /BBS/ send an error message 100$: clr r0 ; not done return .sbttl Generic command processor serv.g: clr at$len ; /BBS/ used for local sizes too.. sub #200 ,sp ; /53/ make a temp copy of data mov sp ,r2 ; /53/ point to it copyz #packet ,r2 ,#176 ; /62/ copy, but don't lunch stack! calls bufunp , ; /53/ undo it (with repeats) add #200 ,sp ; /53/ pop buffer movb packet+0,r2 ; first data byte is generic cmd type scan r2 ,#gencom ; find it's command address asl r0 ; word indexing jmp @gendsp(r0) ; /62/ dispatch the command dispat basedsp=gendsp ,baseval=gencom ,default=gen.$ dispat GN$LOGIN ,gen.$ dispat GN$EXIT ,gen.f ; exit server, return to command mode dispat GN$CONNECT ,gen.c ; connect here means to a directory dispat GN$BYE ,gen.l ; bye bye dispat GN$DIRECTORY ,gen.d ; directory (of a disk) dispat GN$DISK ,gen.u ; disk usage dispat GN$DELETE ,gen.e ; delete file dispat GN$SUBMIT ,gen.$ dispat GN$WHO ,gen.$ ; gen.w ; who's on-line dispat GN$SEND ,gen.$ dispat GN$HELP ,gen.h ; help dispat GN$QUERY ,gen.$ dispat GN$RENAME ,gen.r ; rename a file dispat GN$COPY ,gen.k ; copy a file dispat GN$PRINT ,gen.$ dispat GN$PROGRAM ,gen.$ dispat GN$JOURNAL ,gen.$ dispat GN$VARIABLE ,gen.$ dispat GN$TYPE ,gen.t ; type a file dispat .sbttl Kermit generic routines gen.$: strlen #notgen ; no-op for unimplemented generic spack #msg$error,paknum,r0,#notgen ; send an error packet back clr r0 ; not done return gen.f: spack #msg$ack,paknum ; send a simple ACK mov sp ,r0 ; all done, return to command mode jmp clostt ; /62/ close the terminal up and exit gen.l: spack #msg$ack,paknum ; assume we can log out call clostt ; close the terminal please bit #log$op ,trace ; a logfile open now? beq 20$ ; no calls close ,<#lun.lo> ; yes, close it please 20$: jmp logout ; log out of the system .sbttl Generic COPY gen.k: call get2ar ; get pointers to "from" and "to" bcs 90$ ; oops, send an error packet over upcase r1 ; /BBS/ upper case first arg upcase r2 ; /BBS/ upper case second arg calls fparse , ; /62/ get attrs here as lookup is in clr index ; /62/ an adjacent overlay init index calls lookup ,<#srcnam,#spare1> ; /62/ load input file attributes .purge #lun.sr ; /62/ dump lookup channel calls copy , ; copy the file now tst r0 ; did it work? bne 80$ ; no sub #50 ,sp ; yes, formulate a simple ACK mov sp ,r3 ; /BBS/ response telling them how many deccvt r1 ,r3 ,#5 ; /BBS/ blocks that we copied over add #5 ,r3 ; /BBS/ point past the block count strcpy r3 ,#C20$ ; /62/ copy a message and then ACK it strcat r3 ,#filnam ; /BBS/ tag it with create file name mov sp ,r3 ; /BBS/ point back to start of buffer strlen r3 ; /BBS/ get the string length now spack #msg$ack,paknum,r0,r3 ; /BBS/ send the ACK over add #50 ,sp ; pop the local buffer br 100$ 80$: call generr ; error, send RMS error text br 100$ 90$: calls error ,<#1,#invarg> ; invalid arguments 100$: clr r0 ; not done yet return .sbttl Generic CWD gen.c: mov #packet+1,r1 ; get the packet address unchar (r1)+ ,r2 ; get the size of the data bne 31$ ; /BBS/ something is there strcpy #defdir ,#dkname ; /62/ if no dev specified, then home br 55$ ; /BBS/ report what wuz just done 31$: add r1 ,r2 ; /BBS/ point to the end of it all dec r2 ; /BBS/ bump back to last char in buff cmpb (r2)+ ,#': ; /BBS/ last byte a colon? beq 32$ ; /BBS/ ya movb #': ,(r2)+ ; /BBS/ no, but fparse needs one 32$: clrb @r2 ; /BBS/ (re)terminate upcase r1 ; /BBS/ upper case the packet calls fparse, ; /BBS/ use handy buffer to verify tst r0 ; /BBS/ it's an authorized device bne 70$ ; /BBS/ nope, it's not.. strcpy #defdir ,#spare1 ; /62/ modify defdir 55$: sub #40 ,sp ; allocate a buffer mov sp ,r2 ; point to the buffer strcpy r2 ,#C110$ ; /62/ stick "DK --> " in it.. strcat r2 ,#defdir ; add the directory name in strlen r2 ; get the total length spack #msg$ack,paknum,r0,r2 ; and sent the ACK message add #40 ,sp ; pop buffer br 100$ 70$: call generr ; handle error 100$: clr r0 ; not done return .sbttl Generic DELETE gen.e: mov #packet+1,r1 ; get the packet address unchar (r1)+ ,r2 ; get the argument length bne 10$ ; non-zero clrb @r1 ; zero, make the string null 10$: upcase r1 ; /BBS/ upper case the packet calls delete , ; do it tst r0 ; did it work? beq 80$ ; yes call generr ; no, send the RMS error code over br 100$ 80$: ; /BBS/ wildcarding not available under RT-11 strcpy #errtxt ,#srcnam ; /62/ reply for 1 file deleted strcat #errtxt ,#delmsg ; /62/ append " deleted" to file name strlen #errtxt ; get the length spack #msg$ack,paknum,r0,#errtxt ; and send a simple ACK packet 100$: clr r0 ; not done with the server yet return .sbttl Generic DIRECTORY and SPACE gen.u: mov sp ,summary ; /BBS/ flag for a summary only gen.d: mov #packet+1,r1 ; /38/ get the packet address unchar (r1)+ ,r2 ; /38/ get the argument length add r1 ,r2 ; /BBS/ point to the end clrb @r2 ; /BBS/ null terminate upcase r1 ; /BBS/ upper case the packet calls fixwild , ; /BBS/ convert "?" to "%" calls sdirini , ; /38/ init directory lookup and tst r0 ; /38/ preload sdodir's buffer bne 99$ ; /38/ send error packet on any error mov #sdodir ,getcroutine ; /38/ stuff address of get_next_char mov #null ,r0 ; /38/ and flag we're NOT using a file call xreply ; /38/ do the extended reply now tst r0 ; did it work? beq 100$ ; ya 99$: call generr ; /BBS/ send error to the user 100$: clr r0 ; not done yet return .sbttl Generic HELP gen.h: textsrc #htxt ; /38/ use memory resident text mov #null ,r0 ; /38/ flag it's not file I/O.. call xreply ; /38/ send it clr r0 ; /38/ not done yet return .sbttl Generic RENAME gen.r: call get2ar ; get pointers to "from" and "to" bcs 90$ ; oops, send an error packet over upcase r1 ; /BBS/ upper case first arg upcase r2 ; /BBS/ upper case second arg calls rename , ; rename the file now tst r0 ; did it work out ok? bne 80$ ; no strlen #R20$ ; /62/ get the string length spack #msg$ack,paknum,r0,#R20$ ; /62/ send the ACK over br 100$ 80$: call generr ; error, send RMS error text br 100$ 90$: calls error ,<#1,#invarg> ; invalid arguments 100$: clr r0 ; not done yet return .sbttl Generic TYPE gen.t: mov #packet+1,r1 ; get the packet address unchar (r1)+ ,r2 ; get the argument length beq 12$ ; /BBS/ nothing was there add r1 ,r2 ; /BBS/ point to end clrb @r2 ; /BBS/ null terminate upcase r1 ; /BBS/ upper case the packet scan #'. ,r1 ; /BBS/ look for a dot in the name tst r0 ; /BBS/ find one? bne 10$ ; /BBS/ ya.. strcat r1 ,#typdef ; /BBS/ no, add ".LST" to it 10$: calls iswild , ; /BBS/ wildcarded file_spec?? tst r0 ; /BBS/ bne 20$ ; /BBS/ disallow wildcarded file_spec calls fparse, ; /BBS/ be sure it's an auth'd dev.. tst r0 ; /BBS/ is it? beq 30$ ; /BBS/ nope mov #er$dev ,r0 ; /BBS/ bad device br 20$ 12$: mov #er$fnm ,r0 ; /BBS/ bad file name 20$: call generr ; /BBS/ handle the error br 100$ 30$: mov #spare1 ,r0 ; point to file to be typed call xreply ; send it as an extended reply 100$: clr r0 ; not done yet return .sbttl Generic command error handler generr: calls syserr , ; /BBS/ be more informative calls error ,<#1,#errtxt> ; get the error text and send it clr r0 ; not done yet return .sbttl Get pointers for a two argument server command ; input: packet = packet just read as a server, .asciz ; output: r1 = first argument address in packet buffer ; r2 = second argument address.. ; carry = set on missing arg, clear if all is well and good get2ar: save mov #packet+1,r3 ; get the address of our parameters tstb @r3 ; a null here is an error beq 90$ ; exit with carry set unchar (r3)+ ,r4 ; get the length of the first arg beq 90$ ; a null string, exit with error mov r3 ,r1 ; not null, point to the first one add r4 ,r3 ; point to the length field for 2nd tstb @r3 ; must not be null or zero beq 90$ ; null, missing second argument unchar (r3)+ ,r4 ; get the length of the last field beq 90$ ; nothing is there, abort please mov r3 ,r2 ; return a pointer to the second arg clrb -(r3) ; ensure the first argument is .asciz clc ; success at last br 100$ 90$: sec ; failure, to try again someday 100$: unsave return .sbttl FINISH and BYE remfin::clr paknum ; packet_number := 0 call seropn ; get the link line initialized tst r0 ; /BBS/ did it work? bne 99$ ; /62/ no, error msg dumped by ttyini spack #msg$gen,paknum,#1,#B20$ ; /62/ send a generic "F" command rpack r2 ,r3 ,#packet,#maxlng ; /62/ get an ACK for it please clr r0 ; /BBS/ preset with no error cmpb r1 ,#msg$ack ; did the server like it beq 99$ ; yes cmpb r1 ,#msg$err ; /62/ no, what about an error packet? bne 10$ ; /62/ no calls prerrp ,<#packet> ; /62/ yes, print the response 10$: calls printm ,<#2,#B22$,#B23$> ; /62/ no, say so mov sp ,r0 ; /BBS/ flag it didn't happen 99$: jmp clostt ; /62/ close the remote link c$bye:: call ckremote ; /62/ moved front end here bcs 100$ ; /62/ we are remote, abort this movb sentim ,senpar+p.time ; /62/ use send time_out clr paknum ; packet_number := 0 call seropn ; get the link line initialized tst r0 ; /BBS/ did it work? bne 100$ ; /BBS/ no, error msg dumped by ttyini spack #msg$gen,paknum,#1,#B21$ ; /62/ send a generic "L" command rpack r2 ,r3 ,#packet,#maxlng ; /62/ get an ACK for it please cmpb r1 ,#msg$ack ; did the server like it? beq 100$ ; yes cmpb r1 ,#msg$err ; what about an error packet bne 20$ ; no calls prerrp ,<#packet> ; /62/ yes, print the response 20$: calls printm ,<#2,#B22$,#B24$> ; /62/ other error call clostt ; /62/ close the remote link 100$: clr r0 ; /62/ return .sbttl The GET command ; /BBS/ heavily modified c$get:: call ckremote ; /62/ moved c$get here from the root bcs 95$ ; we are remote, abort this clr wasmore ; init multi-args display flag 5$: mov argbuf ,r1 ; address of command line buffer tstb @r1 ; anything there? beq 9$ ; nope, bail out call isitas ; get asname if there tst r0 ; any error in syntax? beq 10$ ; no, it's ok 9$: direrr #er$get ; emit a syntax error message br 95$ ; bail out 10$: tst wasmore ; working with more than 1 file spec? beq 101$ ; no calls printm ,<#3,#A300$,#srcnam,#A301$> ; ya, say which one it is 101$: upcase #asname ; just in case tst locase ; SET FILE NAMING LOWER_CASE? bne 17$ ; ya upcase #srcnam ; no, make it upper case 17$: movb rectim ,senpar+p.time ; /62/ use receive time_out call seropn ; init the link tst r0 ; /BBS/ did it work? bne 310$ ; /BBS/ no, error msg dumped by ttyini call sinfo ; exchange information please clr paknum ; packet_number := 0 strlen #srcnam ; get the length of the file name spack #msg$rcv,paknum,r0,#srcnam ; get the server to send this file calls recsw ,<#sta.rin> ; and call the receiver 310$: call clostt ; /62/ close the remote link tst r0 ; did it work? bne 90$ ; no mov nextone ,r0 ; ya, any more arguments to process? bne 173$ ; ya, go do it calls printm ,<#1,#A200$> ; /62/ no, done br 100$ ; note r0 is clear here too 173$: cmpb (r0) ,#space ; is first byte a blank? bne 177$ ; no inc r0 ; ya, skip past it br 173$ ; and check what is now the first byte 177$: copyz r0 ,argbuf ,#ln$max ; pull up remaining args to top of buf br 5$ ; loop back for more 90$: calls printm ,<#1,#A210$> ; /62/ it failed, say so if local 95$: inc status ; /45/ flag for batch exit 100$: clrb asname ; /36/ ensure no more alternate names jmp clrcns ; /62/ flush TT input, clear r0 .sbttl Misc REMOTE commands remcop::calls doremo ,<#gn$cop,#2,cmdbuf,argbuf> ; /62/ remote copy return remcwd::mov argbuf ,r1 ; check for optional password 10$: tstb @r1 ; end of string? beq 30$ ; yes cmpb (r1)+ ,#space ; look for a space bne 10$ ; nothing tstb @r1 ; null here? beq 30$ ; yes, no password present calls doremo ,<#gn$con,#2,argbuf,r1> ; /62/ ya, insert password too br 100$ 30$: calls doremo ,<#gn$con,#1,argbuf> ; /62/ no password today 100$: return remdel::calls doremo ,<#gn$del,#1,argbuf> ; /62/ remote delete return remdir::calls doremo ,<#gn$dir,#1,argbuf> ; /62/ remote directory return remhlp::calls doremo ,<#gn$hel,#1,#null> ; remote help return remlgi::mov argbuf ,r1 ; check for optional password 10$: tstb @r1 ; end of string? beq 30$ ; yes cmpb (r1)+ ,#space ; look for a space bne 10$ ; nothing tstb @r1 ; null here? beq 30$ ; yes, no password present clrb -1(r1) ; insert null over the calls doremo ,<#gn$log,#2,argbuf,r1> ; /62/ ya, insert password too br 100$ 30$: calls doremo ,<#gn$log,#1,argbuf> ; /62/ no password today 100$: return remren::calls doremo ,<#gn$ren,#2,cmdbuf,argbuf> ; /62/ remote rename return remspa::calls doremo ,<#gn$dis,#1,argbuf> ; /62/ remote space return ; /BBS/ with possible device remtyp::calls doremo ,<#gn$typ,#1,argbuf> ; /62/ remote type return remwho::calls doremo ,<#gn$who,#1,#null> ; remote who return remhos::call seropn ; init the link tst r0 ; /BBS/ did it work? beq 1$ ; /BBS/ ya jmp xit ; /BBS/ no, error msg dumped by ttyini 1$: call sinfo ; exchange information please clr paknum ; packet_number := 0 strlen argbuf ; get the length of the file name spack #msg$com,paknum,r0,argbuf ; get the server to execute clr numtry ; /62/ clear the retry counter please br getres ; /62/ off to common code .sbttl Carry out the REMOTE command please ; DOREMOTE handles most generic commands that may have ; a variable response, such as a simple ACK ("Y") with ; the response in the data packet, an SINIT, or an "X" ; packet. doremo: clr paknum ; start with packet_number := 0 sub #ln$max*2,sp ; /62/ allocate a buffer please mov sp ,r2 ; point to it movb @r5 ,@r2 ; the generic command to execute bicb #40 ,(r2)+ ; ensure command is upper case mov 4(r5) ,r1 ; get the first command argument strlen r1 ; get the length of it please tochar r0 ,(r2)+ ; followed by len of first arg copyz r1 ,r2 ,#ln$max-2 ; /62/ copy the arglist over please cmp 2(r5) ,#1 ; one or two arguments passed? beq 30$ ; only one 10$: tstb (r2)+ ; two, so find the end so far bne 10$ ; not yet strlen 6(r5) ; get the length of the second arg dec r2 ; point back to the null please tochar r0 ,(r2)+ ; and copy the new length over copyz 6(r5) ,r2 ,#ln$max-2 ; /62/ copy the second arg over now 30$: mov sp ,r0 ; point back to the command buffer calls bufpak , ; encoding the data as normal mov r1 ,r5 ; save the encoded packet length add #ln$max*2,sp ; /62/ pop the local buffer call seropn ; initialize the link tst r0 ; /BBS/ did it work? bne xit ; /BBS/ nope, err msg dumped by ttyini mov sp ,inprogress ; /BBS/ packets are being exchanged call sinfo ; exchange things first clr paknum ; start over now clr numtry ; clear the retry counter please spack #msg$gen,paknum,r5,cmdbuf ; send the command over please getres: mov sp ,logini ; /62/ force result msgs to a newline rpack r2 ,r3 ,#packet,#maxlng ; /62/ get the response from remote mov r3 ,paknum ; save the packet number please scan r1 ,#remrsp ; what to do with the response asl r0 ; word indexing jsr pc ,@remdsp(r0) ; and dispatch on the response tst r0 ; try to read again? bne getres ; yes, we must have gotten a NAK xit: clr inprogress ; /BBS/ packets are now done clr logini ; /62/ done with extra newlines now.. clr xmode ; no extended reply stuff now clr xgottn ; we don't have any "X" packets clr r0 ; don't pass error back to caller jmp clostt ; /62/ close the link for now .save .psect $pdata remrsp: .byte msg$err ,msg$nak,msg$snd,msg$ack,msg$tex,timout ,badchk .byte 0 .even remdsp: .word rem.$ .word rem.e ,rem.n ,rem.s ,rem.y ,rem.x ,rem.t ,rem.ck .restore rem.t: inc numtry ; time_out error cmp numtry ,initry ; /62/ been trying too hard? bhi 10$ ; yes, abort please mov sp ,r0 ; /62/ no, loop and do rpack again return 10$: calls printm ,<#1,#rem.01> ; /62/ remote fails to respond br rem.tag ; /62/ rem.n: inc numtry ; got a NAK back from remote cmp numtry ,initry ; been trying too hard? bhi 10$ ; yes, abort please spack #msg$gen,paknum,r5,cmdbuf ; send command again please mov sp ,r0 ; /62/ no, loop and do rpack again return 10$: calls printm ,<#1,#rem.02> ; /62/ too many retries, last a NAK br rem.tag ; /62/ rem.ck: inc numtry ; got a checksum error cmp numtry ,initry ; been trying too hard? bhi 10$ ; yes, abort please spack #msg$gen,paknum,r5,cmdbuf ; send command again please mov sp ,r0 ; /62/ no, loop and do rpack again return 10$: calls printm ,<#1,#rem.03> ; /62/ bad checksum retry abort br rem.tag ; /62/ rem.x: mov sp ,xmode ; set a global flag for this mov sp ,xgottn ; we already have the "X" packet calls rec.sw ,<#sta.fil> ; yes, switch to receive data clr xmode ; no longer want output to TT clr xgottn ; we don't have any "X" packets tst r0 ; did the receive succeed? beq rem.tag ; /62/ yes mov sp ,logini ; /62/ force following msg to newline calls printm ,<#1,#rem.04> ; /62/ receive data failed rem.tag:.newline ; /62/ shared .newline exit clr r0 ; done return rem.s: calls rpar ,<#packet,r2> ; handle the sinit now calls spar ,<#packet> ; and send my init things over spack #msg$ack,paknum,sparsz,#packet incm64 paknum ; bump the packet number up mod 64 calls rec.sw ,<#sta.fil> ; switch to get fileheader state br rem.tag ; /62/ rem.y: strlen #packet ; any data in the field? tst r0 ; if not, just exit bne 10$ ; if so, simply print it out return 10$: calls printm ,<#2,#rem.ak,#packet> ; /62/ print the packet br rem.tag ; /62/ rem.e: calls printm ,<#2,#rem.er,#packet> ; /62/ print error text br rem.tag ; /62/ rem.$: calls printm ,<#1,#rem.01> ; /62/ invalid or no response.. br rem.tag ; /62/ .sbttl Buffil but get data from a buffer ; /62/ moved this here ; input: (r5) = source buffer, .asciz ; output: 2(r5) = destination buffer ; r1 = string length ; ; No 8-bit prefixing, and no repeat counts will be done. ; This routine is used for encoding string to be sent as ; a generic command to a server. bufpak: mov 2(r5) ,r4 ; point to the destination address mov @r5 ,r5 ; the source string clr r3 ; use as a length counter 10$: clr r1 ; avoid PDP-11 sign extension bisb (r5)+ ,r1 ; ch := buffer[i] beq 90$ ; done clr r2 ; avoid sxt bisb r1 ,r2 ; ch0_7 := ch bic #^c177 ,r2 ; ch0_7 := ch0_7 and 177b cmpb r2 ,#space ; if ch0_7 < space blo 20$ ; or cmpb r2 ,#del ; ch0_7 = del beq 20$ ; or cmpb r2 ,senpar+p.qctl ; ch0_7 = quote bne 40$ ; then ; begin 20$: movb senpar+p.qctl,(r4)+ ; buffer[i] := quote inc r3 ; length := succ(length) cmpb r2 ,senpar+p.qctl ; if ch0_7 <> quote beq 30$ ; then begin ctl r1 ,r1 ; ch := ctl(ch) ctl r2 ,r2 ; ch0_7 := ctl(ch0_7) end 30$: ; end 40$: tst image ; if image_mode beq 50$ ; then movb r1 ,(r4)+ ; buffer[i] := ch br 60$ ; else 50$: movb r2 ,(r4)+ ; buffer[i] := ch0_7 60$: inc r3 ; length := succ(length) clr -(sp) bisb conpar+p.spsiz,@sp ; exit if length > spsize-8 bne 80$ ; if spsiz = 0 mov #maxpak ,@sp ; then maxsize := #maxpak 80$: sub #10 ,@sp cmp r3 ,(sp)+ blo 10$ ; end 90$: mov r3 ,r1 ; return the length please return .sbttl Initialize for an extended reply to a generic command ; Here's where we send an "X" packet back to the requesting Kermit ; to say that we are going to send an extended reply to it. This ; reply takes the form of a normal file transfer but we will want ; it to be printed on the user's terminal rather than go to a disk ; file. Thus the use of the "X" packet to start things off. xreply: strcpy #srcnam ,r0 ; /62/ copy the file name to be sent clrb filnam ; /38/ ensure cleared out tstb srcnam ; /38/ is there really a file? beq 20$ ; /38/ no, ignore lookup then clr index ; /62/ wildcard file number := 0 call getnxt ; go do a directory lookup please tst r0 ; well, did the lookup work out? bne 30$ ; /62/ no, getnxt has sent error pak 20$: mov sp ,xmode ; flag this is an extended reply calls sen.sw ,<#sta.fil> ; go send the extended reply text 30$: clr xmode ; no longer extended reply mode clr xgottn ; we don't have any "X" packets clr r0 ; success textsrc ; /38/ reset to normal file I/O return .sbttl Open link and flush NAKs seropn: save call opentt ; open the link for a server command tst r0 ; did it work? bne 11$ ; /BBS/ no, err msg dumped by ttyini call cantyp ; flush any accumulated NAKs 11$: unsave return .sbttl Server init sinfo: save ; save ALL registers please bit #log$pa ,trace ; /62/ logging packets this time? beq 3$ ; /62/ no calls putrec ,<#0,#0,#lun.lo> ; /62/ ya, put newline into log file tst r0 ; /62/ did it work? beq 3$ ; /62/ ya call logerr ; /62/ no, handle the error 3$: clr numtry ; send info packets before any clr paknum ; extended server response please movb #msg$ser,-(sp) ; packet type "I" call .sinit ; do it unsave ; restore ALL registers now return .end