home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
rt11
/
krtser.min
< prev
next >
Wrap
Text File
|
2020-01-01
|
9KB
|
559 lines
.title KRTSER.MIN The server
.ident "V03.62"
; /62/ 31-May-93 Billy Youdelman
.include "IN:KRTMAC.MIN"
.iif ndf KRTINC .error <; .include for IN:KRTMAC.MIN failed>
.include "IN:KRTDEF.MIN"
.iif ndf MSG$DA .error <; .include for IN:KRTDEF.MIN failed>
.mcall .PURGE
.macro dispat val,dsp,baseval,basedsp,default
.list me
.save
.nlist me
.if nb <baseval>
.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 <val>
.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
C20$: .asciz " block(s) copied to "
C110$: .asciz "DK --> "
delmsg: .asciz " deleted"
exitxt: .asciz <cr><lf>"%KRTSER-I-Server stopped"<cr><lf>
htxt: .ascii "The following commands are available on this Kermit-11"<cr><lf>
.ascii "server. To avoid ambiguity with local Kermit commands"<cr><lf>
.ascii "most of these server commands must be prefixed by the"<cr><lf>
.ascii "REMOTE keyword."<cr><lf><lf>
.ascii "REMOTE COPY Copy a file to another"<cr><lf>
.ascii "REMOTE CWD Changes server default"<cr><lf>
.ascii "REMOTE DELETE Erases specified file"<cr><lf>
.ascii "REMOTE DIR Displays a directory"<cr><lf>
.ascii "FINISH Exit server, reconnect"<cr><lf>
.ascii "GET Send file(s) to remote"<cr><lf>
.ascii "REMOTE HELP Prints this help text"<cr><lf>
.ascii "REMOTE RENAME Rename old file to new"<cr><lf>
.ascii "SEND Send file(s) to server"<cr><lf>
.ascii "REMOTE SPACE Shows blocks used/free"<cr><lf>
.ascii "REMOTE TYPE Types a specified file"<cr><lf>
.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"
serpre: .asciz "%KRTSER-I-Server starting"
sertxt: .ascii ". Return to your local machine by typing"<cr><lf>
.ascii "its escape sequence for closing the connection,"
.ascii " then issue further"<cr><lf>
.ascii "commands from there. To shut down the server,"
.ascii " use the BYE command"<cr><lf>
.asciz "to logout, or the FINISH command and then reconnect."
typdef: .asciz ".LST"
.even
.psect $code
.sbttl Call the server
c$serv::tstb @argbuf
beq 1$
mov #er$ser ,r0
br 90$
1$: wrtall #serpre
tst infomsg
beq 30$
wrtall #sertxt
30$: .newline
call seropn
tst r0
bne 99$
call server
wrtall #exitxt
br 99$
90$: direrr r0
99$: clr r0
jmp clostt
.sbttl Server main_loop
server::clr paknum
textsrc
mov #defchk ,chktyp
mov #1 ,chksiz
mov $image ,image
clr summary
clr dirflg
call fixchk
mov serwai ,sertim
bit #log$pa ,trace
beq 3$
calls putrec ,<#0,#0,#lun.lo>
tst r0
beq 3$
call logerr
3$: rpack r2 ,r3 ,#packet,#maxlng
clr sertim
movb sentim ,senpar+p.time
scan r1 ,#sercom
asl r0
jsr pc ,@serdsp(r0)
tst r0
beq server
100$: calls suspend ,<#1>
jmp clrcns
dispat basedsp=serdsp ,baseval=sercom ,default=serv.$
dispat MSG$SND ,serv.s
dispat MSG$RCV ,serv.r
dispat MSG$GENERIC ,serv.g
dispat MSG$SER ,serv.i
dispat TIMOUT ,serv$$
dispat BADCHK ,serchk
dispat MSG$NAK ,serv$$
dispat MSG$ACK ,serv$$
dispat MSG$COMMAND ,serv.$
dispat MSG$ERROR ,sernop
dispat
.sbttl Server routines
serv.$: strlen #notimp
spack #msg$error,paknum,r0,#notimp
clr r0
return
serv$$:
serchk: mov r3 ,paknum
spack #msg$nak,paknum
sernop: clr r0
return
serv.i: mov r3 ,paknum
calls rpar ,<#packet,r2>
calls spar ,<#packet>
spack #msg$ack,paknum,sparsz,#packet
clr r0
jmp inirepeat
serv.s: mov r3 ,paknum
calls rpar ,<#packet,r2>
calls spar ,<#packet>
spack #msg$ack,paknum,sparsz,#packet
call inirepeat
incm64 paknum
calls rec.sw ,<#sta.fil>
clr r0
return
serv.r: calls bufunp ,<#packet,#spare1>
clrb spare1(r1)
upcase #spare1
calls fparse,<#spare1,#srcnam>
tst r0
bne 90$
calls fixwild ,<#srcnam>
clr index
call getnxt
tst r0
bne 100$
calls sen.sw ,<#sta.sin>
br 100$
90$: call generr
100$: clr r0
return
.sbttl Generic command processor
serv.g: clr at$len
sub #200 ,sp
mov sp ,r2
copyz #packet ,r2 ,#176
calls bufunp ,<r2,#packet>
add #200 ,sp
movb packet+0,r2
scan r2 ,#gencom
asl r0
jmp @gendsp(r0)
dispat basedsp=gendsp ,baseval=gencom ,default=gen.$
dispat GN$LOGIN ,gen.$
dispat GN$EXIT ,gen.f
dispat GN$CONNECT ,gen.c
dispat GN$BYE ,gen.l
dispat GN$DIRECTORY ,gen.d
dispat GN$DISK ,gen.u
dispat GN$DELETE ,gen.e
dispat GN$SUBMIT ,gen.$
dispat GN$WHO ,gen.$
dispat GN$SEND ,gen.$
dispat GN$HELP ,gen.h
dispat GN$QUERY ,gen.$
dispat GN$RENAME ,gen.r
dispat GN$COPY ,gen.k
dispat GN$PRINT ,gen.$
dispat GN$PROGRAM ,gen.$
dispat GN$JOURNAL ,gen.$
dispat GN$VARIABLE ,gen.$
dispat GN$TYPE ,gen.t
dispat
.sbttl Kermit generic routines
gen.$: strlen #notgen
spack #msg$error,paknum,r0,#notgen
clr r0
return
gen.f: spack #msg$ack,paknum
mov sp ,r0
jmp clostt
gen.l: spack #msg$ack,paknum
call clostt
bit #log$op ,trace
beq 20$
calls close ,<#lun.lo>
20$: jmp exit
.sbttl Generic COPY
gen.k: call get2ar
bcs 90$
upcase r1
upcase r2
calls fparse ,<r1,#srcnam>
clr index
calls lookup ,<#srcnam,#spare1>
.purge #lun.sr
calls copy ,<r1,r2>
tst r0
bne 80$
sub #50 ,sp
mov sp ,r3
deccvt r1 ,r3 ,#5
add #5 ,r3
strcpy r3 ,#C20$
strcat r3 ,#filnam
mov sp ,r3
strlen r3
spack #msg$ack,paknum,r0,r3
add #50 ,sp
br 100$
80$: call generr
br 100$
90$: calls error ,<#1,#invarg>
100$: clr r0
return
.sbttl Generic CWD
gen.c: mov #packet+1,r1
unchar (r1)+ ,r2
bne 31$
strcpy #defdir ,#dkname
br 55$
31$: add r1 ,r2
dec r2
cmpb (r2)+ ,#':
beq 32$
movb #': ,(r2)+
32$: clrb @r2
upcase r1
calls fparse,<r1,#spare1>
tst r0
bne 70$
strcpy #defdir ,#spare1
55$: sub #40 ,sp
mov sp ,r2
strcpy r2 ,#C110$
strcat r2 ,#defdir
strlen r2
spack #msg$ack,paknum,r0,r2
add #40 ,sp
br 100$
70$: call generr
100$: clr r0
return
.sbttl Generic DELETE
gen.e: mov #packet+1,r1
unchar (r1)+ ,r2
bne 10$
clrb @r1
10$: upcase r1
calls delete ,<r1,#lun.ou>
tst r0
beq 80$
call generr
br 100$
80$: strcpy #errtxt ,#srcnam
strcat #errtxt ,#delmsg
strlen #errtxt
spack #msg$ack,paknum,r0,#errtxt
100$: clr r0
return
.sbttl Generic DIRECTORY and SPACE
gen.u: mov sp ,summary
gen.d: mov #packet+1,r1
unchar (r1)+ ,r2
add r1 ,r2
clrb @r2
upcase r1
calls fixwild ,<r1>
calls sdirini ,<r1>
tst r0
bne 99$
10$: mov #sdodir ,getcroutine
mov #null ,r0
call xreply
tst r0
beq 100$
99$: call generr
100$: clr r0
return
.sbttl Generic HELP
gen.h: textsrc #htxt
mov #null ,r0
call xreply
clr r0
return
.sbttl Generic RENAME
gen.r: call get2ar
bcs 90$
upcase r1
upcase r2
calls rename ,<r1,r2,#-1>
tst r0
bne 80$
strlen #R20$
spack #msg$ack,paknum,r0,#R20$
br 100$
80$: call generr
br 100$
90$: calls error ,<#1,#invarg>
100$: clr r0
return
.sbttl Generic TYPE
gen.t: mov #packet+1,r1
unchar (r1)+ ,r2
beq 12$
add r1 ,r2
clrb @r2
upcase r1
scan #'. ,r1
tst r0
bne 10$
strcat r1 ,#typdef
10$: calls iswild ,<r1>
tst r0
bne 20$
calls fparse,<r1,#spare1>
tst r0
beq 30$
mov #er$dev ,r0
br 20$
12$: mov #er$fnm ,r0
20$: call generr
br 100$
30$: mov #spare1 ,r0
call xreply
100$: clr r0
return
.sbttl Generic command error handler
generr: calls syserr ,<r0,#errtxt>
calls error ,<#1,#errtxt>
clr r0
return
.sbttl Get pointers for a two argument server command
get2ar: save <r3,r4>
mov #packet+1,r3
tstb @r3
beq 90$
unchar (r3)+ ,r4
beq 90$
mov r3 ,r1
add r4 ,r3
tstb @r3
beq 90$
unchar (r3)+ ,r4
beq 90$
mov r3 ,r2
clrb -(r3)
clc
br 100$
90$: sec
100$: unsave <r4,r3>
return
.sbttl Buffil but get data from a buffer
bufpak::mov 2(r5) ,r4
mov @r5 ,r5
clr r3
10$: clr r1
bisb (r5)+ ,r1
beq 90$
clr r2
bisb r1 ,r2
bic #^c177 ,r2
cmpb r2 ,#space
blo 20$
cmpb r2 ,#del
beq 20$
cmpb r2 ,senpar+p.qctl
bne 40$
20$: movb senpar+p.qctl,(r4)+
inc r3
cmpb r2 ,senpar+p.qctl
beq 30$
ctl r1 ,r1
ctl r2 ,r2
30$:
40$: tst image
beq 50$
movb r1 ,(r4)+
br 60$
50$: movb r2 ,(r4)+
60$: inc r3
70$: clr -(sp)
bisb conpar+p.spsiz,@sp
bne 80$
mov #maxpak ,@sp
80$: sub #10 ,@sp
cmp r3 ,(sp)+
blo 10$
90$: mov r3 ,r1
return
.sbttl Initialize for an extended reply to a generic command
xreply: strcpy #srcnam ,r0
clrb filnam
tstb srcnam
beq 20$
clr index
call getnxt
tst r0
bne 30$
20$: mov sp ,xmode
calls sen.sw ,<#sta.fil>
30$: clr xmode
clr xgottn
clr r0
100$: textsrc
return
.sbttl Open link and flush NAKs
seropn: save <r1>
call opentt
tst r0
bne 11$
call cantyp
11$: unsave <r1>
return
.sbttl Server init
sinfo: save
bit #log$pa ,trace
beq 3$
calls putrec ,<#0,#0,#lun.lo>
tst r0
beq 3$
call logerr
3$: clr numtry
clr paknum
movb #msg$ser,-(sp)
call .sinit
unsave
return
.end